#!/usr/bin/perl # @(#) CIPclient.pl CUPS backend filter which emails print jobs to a # Castelle print-server whose address matches the # printer name. Rev'd: 2010-01-17. # # Copyright (c) 2007 Graham Jenkins . All rights reserved. # This program is free software; you can redistribute it and/or modify it under # the same terms as Perl itself. use strict; use warnings; use File::Basename; use File::Spec; use Net::CUPS::Destination; use MIME::Lite; use Compress::Raw::Lzma; use vars qw($VERSION); $VERSION = "1.07"; # Compress subroutine; accepts string as parameter, compresses it if possible sub compress { my ($z,$o); $z=new Compress::Raw::Lzma::EasyEncoder(AppendOutput=>1,Preset=>9,Extreme=>1); if ( ($z->code($_[0],$o) ==LZMA_OK ) && ($z->flush($o,LZMA_FINISH)==LZMA_STREAM_END) ) { $_[0]=$o } } # Check Usage, open input-file name if ($#ARGV<0) { # With no arguments, must supply backend info for: lpinfo -l -v print 'direct '.basename($0).' "Unknown" "Castelle Print-Server"'."\n";exit 0 } die "Usage: ", basename($0)." Job User Title Copies Options [Filename]\n" if(($#ARGV<4) || ($#ARGV>5) || ($ARGV[0]!~m/\d+$/) || ($ARGV[3]!~m/\d+$/)); my $infi="-";$infi=$ARGV[5] if defined($ARGV[5]); die "Can't read: $infi\n" if ! open (INFILE, "$infi"); # Get printer-name from job-number my $name; my $cups = Net::CUPS->new(); L:foreach my $printer (my @destinations=$cups->getDestinations()) { foreach my $job (my @jobs=$printer->getJobs(0,0)) { if ($job==$ARGV[0]) {$name=$printer->getName(); last L} } } die "Can't identify printer for SeqNo: $ARGV[0]\n" if ! defined ($name); # Check if there is a sendmail alias for this printer-name if ( open(ALIASES,File::Spec->catdir(File::Spec->rootdir,"etc","aliases")) ) { while() { my @r=split; if ( ($#r>0) && ($r[0] eq $name.":") ) {$name=$r[1];last} } } # Read reply-address and compress-option from ~/.CIPclient.cf my $addr=$ARGV[1]; my $noti="No"; my $compress; if ( my @p=getpwnam($ARGV[1]) ) { if ( open(CF,File::Spec->catdir($p[7],".CIPclient.cf"))) { while () { my @l=split; if ( ($#l==0)&&($l[0]=~m/\@/)&&($l[0]!~m/^#/) ) {$addr=$l[0];$noti="Yes"} if ( ($#l==0)&&($l[0] eq "Compress") ) {$compress="Y" } } } } # Slurp from input file, compress if required undef $/; my $data=; compress($data) if defined ($compress); # Compose and send the message for (my $copy=1;$copy<=$ARGV[3];$copy++) { my $msg=MIME::Lite->new(From =>$addr, To =>$name, Subject =>'printing data from remote', Type =>'multipart/mixed' ); $msg->attach( Encoding=>'7bit', Data =>"PrintServerPD:\nNotify: ".$noti."\n" ); $msg->attach( Type =>'application/remote-printing', Encoding=>'base64', Data =>$data ); # MIME::Lite->send( 'smtp', Timeout=>60 ); $msg->send } __END__ =head1 NAME CIPclient - Castelle/Kingston print-server backend filter for CUPS =head1 README CIPclient is a CUPS backend filter for the Castelle-Internet-Print protocol. =head1 DESCRIPTION C is a CUPS backend filter which sends Castelle-Internet-Print jobs to an email address that matches the printer name. It should be installed in the CUPS backend directory and made execute-and-readable only by root. The line containing 'smtp' should be uncommented if an SMTP gateway (as defined by Net::Config) is to be used. =head1 USAGE =over 6 CIPclient Job User Title Copies Options [Filename] =back CIPclient will normally be invoked with the appropriate parameters through CUPS. After installing CIPclient as indicated above, you need to restart CUPS so that it is recognised. You can then add a printer with a name which matches the the destination email address used by your CIP print-server; CIPclient understands sendmail address aliases in this context. When a job is sent to that printer, CIPclient will package and send the job to the corresponding address. A file named ".CIPclient.cf" can be placed in a user's home directory to supply a notification address and/or a (non-standard) compression directive thus: janedoe@hotmail.com Compress =head1 SCRIPT CATEGORIES Networking UNIX/System_administration =head1 AUTHOR Graham Jenkins =head1 COPYRIGHT Copyright (c) 2007 Graham Jenkins. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut