The klpr CUPS Backend in Perl with some extra comments.


#!/usr/bin/perl -w
## Strict perl
use strict;
## need this perl module
use Sys::Hostname;

## path to the command line print tool
my $cmd = "/usr/bin/klprng";
## path to the script running application
my $ihook = "/Applications/iHook.app";
## Or to keep it more secure in a lab environment consider.
## my $ihook = "/System/Library/CoreServices/iHook.app";


#
# Inquiry call
#
## have to have this for CUPS api so when type ./klpr it returns this info
## this is what shows up in PrintCenter Advanced dialog as a printer type, etc.

if ($#ARGV < 0) {
print "network klpr \"Unknown\" \"Kerberized LPD/LPR Host or Printer\"\n";
exit 0;
}

#
# Check arguments and environment
# Usage: $0 job-id user title copies options [file]
#
## CUPS API says there must be an exact number of args

exit 1 if ($#ARGV < 4 || $#ARGV > 5);

## pass on a job name that can be traced back
my $job = $ARGV[0] . "-" . hostname;
## need the uid and gid to set owner, etc on script and spool file
my ($uid, $gid) = (getpwnam($ARGV[1]))[2,3];

## get the uri CUPS has
my $device_uri = $ENV{DEVICE_URI};
exit 1 if (!defined $device_uri);

## set up some environment stuff
my $rootdir = $ENV{CUPS_SERVERROOT};
exit 1 if (! defined $rootdir);

#
## Digest the device URI
# lpr://server.domain.edu/printer-queue-name
#
my $server = "print.ncsu.edu"; #init here is NC State specific
my $printer = "unknown";
if ($device_uri =~ /^klpr:\/\/([\w\.]+)\/([\w\-]+)$/) {
$server = $1;
$printer = $2;
}
else {
exit 1;
}

## name the script, and spool files and setup the rm command
my $script = "/tmp/scr" . $ARGV[0];
my $spoolfile = "/tmp/spl" . $ARGV[0];
my $removecmd = "/bin/rm -f " . $spoolfile;
my $mycopies = 1;

## if we have the processed print file on standard in then copies have already been made
## otherwise we have to handle it from the args passed to us by cupsd
if ($#ARGV == 5) {
$removecmd = "";
$spoolfile = $ARGV[5];
$mycopies = $ARGV[3];
}
else {
unlink($spoolfile) if (-e "$spoolfile");
open(SPOOL, "> $spoolfile") || exit 1;
while (<STDIN>) { print SPOOL; }
close(SPOOL) || exit 1;
chmod 0644, $spoolfile;
chown $uid, $gid, $spoolfile;
my $mycopies = 1;
}

my $spoolme = " $spoolfile" x $mycopies;
## set a title and rip out any special characters which might weird out the shell
my $title = $ARGV[2];
$title=~ s/'/\\'/g;
#
# Now write out the shell script file to be run to tmp
## We use several iHook directives to display the title
## open a drawer to show error messsages etc
## then we clean up after ourselves by removing the print file and the script we just wrote  
#
open(MYFILE, "> $script") || exit 1;
print MYFILE <<DONE;
#!/bin/sh
failure=0
echo "%TITLE $title"
echo "%OPENDRAWER"
echo "Printing job..."
echo "%0"
$cmd -P$printer\@$server -J $job $spoolme
if [ \$? != 0 ]; then
echo "%33"
failure=1
echo "Failed to print job."
sleep 5
else
echo "%33"
fi
echo "%CLOSEDRAWER"
echo "Removing spool files..."
$removecmd
echo "%66"
echo "Removing spool script..."
/bin/rm -f $script
echo "%100"
if [ \$failure != 0 ]; then
echo "Printing failed."
else
echo "Printing succeeded."
fi
sleep 1
exit 0
DONE
close(MYFILE) || exit 1;
#
# that is all of the shell script
# make sure it can be executed and removed
#
chmod 0755, $script;
chown $uid, $gid, $script;

## use the Apple open command to run the script with the application iHook
## test for errors as best we can  
my @args = ("open", "-a", $ihook, $script);
exit 1 if (system(@args) != 0);
exit 0;