# papwrap.pl: wrapper for CUPS to use a PAP printer (AppleTalk/EtherTalk) to
# send jobs to.

# The URL should be in one of the following forms:
# pap://printer
# pap://ZONE/printer
# PAP doesn't know about users or queues, just printers. Characters that aren't
# pretty much standard (A-Za-z0-9\-_.) should be URL encoded.

# Install this script as [CUPS_INSTALL_BASE]/lib/cups/backend/pap and make
# sure it's executable (and readable) by the root user. It should just
# magically work - it will even detect printers in the local zone. Make sure
# you have the netatalk userspace tools installed also. This script depends
# on the 'pap' command in particular, but also the 'nbplkup' command to get
# printers in the current zone (when called with no args).

use strict;
use IPC::Open2;

sub instructions {
print STDERR << '__EOF__';
ERROR: pap job-id user title copies options [file]

DEVICE_URI must contain a pap:// URI like one of the following:


The names must be URL encoded if anything other than A-Z, a-z, 0-9, a
period (.), a hyphen (-) or an underscore (_) appears in them.

sub url_decode ($) {
my ($url_coded) = @_;
$url_coded =~ s/\%([0-9a-f]{2})/chr(hex($1))/eig;

sub url_encode ($) {
my ($string) = @_;
$string =~ s/([^a-z0-9\.\-_])/sprintf('%%%02x', ord($1))/eig;

# Really, a better way to do this would be to do the NBP lookup directly. But
# since no one has made a module for doing AppleTalk natively in Linux, and
# I don't feel like going to all the work to do it... just use 'nbplkup',
# and parse its output (not too hard to do, a nice one-line regexp does a
# treat on it). undef for the name or type will be replaced with '=', aka
# "match anything". undef for the zone will be replaced with '*', aka "local
# zone".
sub nbp_lookup {
my ($szone, $stype, $sname) = @_;

# Assemble the NBP name search path. We can only search one zone at a
# time. I don't know why.
my $pattern = join('', ($sname eq '' ? '=' : $sname), ':',
($stype eq '' ? '=' : $stype), '@',
($szone eq '' ? '*' : $szone));
my @records = ();

my @pathparts = split(/:/, $ENV{'PATH'});
my $found = 0;

# Check to see if the executable we want is in the PATH
foreach my $dir (@pathparts) {
($found = 1) if -x $dir . '/nbplkup';
if ($found == 1) {
my ($rdfh, $wrfh);
# Call nbplkup with the search pattern we assembled before.
my $pid = open2($rdfh, $wrfh, 'nbplkup', $pattern);

while (my $line = <$rdfh>) {
my ($name, $type, $addr) = $line =~ /^\s*([^:]+):(.*?)\s+(\d+\.\d+:\d+)$/;
push(@records, {'name' => $name, 'type' => $type, 'addr' => $addr});
return @records;

# Figure out what printers are in the local zone, if any, then specify the
# default so that a user can enter their own printer name if it's not in the
# local zone, or whatever.
if (scalar(@ARGV) == 0) {
my @printers = nbp_lookup(undef, 'LaserWriter');

foreach my $dev (@printers) {
my $url = 'pap://' . url_encode($$dev{'name'});
print "network $url \"Unknown\" \"PAP Printer '", $$dev{'name'}, "'\"\n";
print "network pap \"Unknown\" \"Macintosh-compatible Printer via PAP\"\n";

# Parse the URI if possible. If not, then give the generic complaint.
my $print_uri = $ENV{'DEVICE_URI'};
my ($zone, $name);
unless (($zone, $name) = $print_uri =~ /^pap:\/\/(?:([^\/]+)\/)?([^\/]+)\/?$/) {

# Check the argument count. If it's wrong, then give the generic complaint.
if (scalar(@ARGV) < 5 || scalar(@ARGV) > 6) { instructions(); }

my ($job_id, $user, $title, $copies, $options, $file) = @ARGV;

# At the moment, $user, $title and $options don't do anything. The backends
# included with CUPS don't seem to do anything with those args either, so I'm
# not going to worry about them.

($copies = 1) unless defined $file;

# Remove the URL encoding from the device and zone names.
$name = url_decode($name);
$zone = url_decode($zone);

# Attach the zone to the NBP name, if one was given.
if ($zone ne "") {
$name .= '@' . $zone;

# Specify the file arg to pap as many times as the number of copies we were
# given, if a file was specified at all. If not, it'll just take stdin.
my @pap_cmdline = ('pap', '-e', '-p', $name);
if (defined $file) {
for (my $i = 0; $i < $copies; $i++) { push(@pap_cmdline, $file); }

# Call pap with the arguments specified above.
my $rv = system @pap_cmdline;

unless ($rv == 0) {
print STDERR "ERROR: Unable to open connection to printer \"", $name, "\"\n";