1#!/usr/bin/perl 2eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' 3 if $running_under_some_shell; 4 # this emulates #! processing on NIH machines. 5 # (remove #! line above if indigestible) 6 7 8use strict; 9use English; 10use Socket; 11use LPRng; 12use Getopt::Std; 13use Sys::Hostname; 14 15my($Printer, $Pc_value, $Debug ); 16my($pr, $remote, $port, @files, $file, $f, $hostname, $username); 17my($cf, $df, $idn, $cfn, @dfn, $fn, $filecount, $i, $v, $SOCK, $sendcf,%Args); 18my($options) = "Z:O:"; 19 20$| = 1; 21 22$Debug = 0; 23Set_Debug($Debug); 24getopts( $options . "P:", \%Args ); 25Setup_LPRng( %Args ); 26 27# get the printer name 28$Printer = Get_printer_name( %Args ); 29if( not $Printer ){ 30 die "missing printer name"; 31} 32 33print "Printer '$Printer'\n" if $Debug; 34 35$Pc_value = Setup_pc_entry( $Printer ); 36 37($pr, $remote, $port ) = Get_remote_pr_host( $Printer, $Pc_value ); 38print "pr '$pr', remote '$remote', port '$port'\n" if $Debug; 39 40if( !(@files = @ARGV) ){ 41 $f = "/tmp/lpr$$"; 42 @files = $f; 43 open TEMP, ">$f" or die "cannot open $f - $!\n"; 44 while( defined( $i = <> ) ){ 45 print TEMP $i or die "cannot write $f - $!\n"; 46 } 47 close TEMP or die "cannot close $f - $!\n"; 48} 49 50print "files " . join(",",@files) . "\n" if $Debug; 51 52 53$hostname = hostname(); 54$username = getpwuid($UID); 55 56$cf = "H$hostname\n" 57 . "P$pr\n" 58 . "L$username\n" ; 59 60foreach $i ( split //, $options ){ 61 print "option $i\n" if $Debug; 62 $v = $Args{$i}; 63 if( $i ne ":" and $v ){ 64 print "option $i='$v'\n" if $Debug; 65 $cf .= "$i$v\n"; 66 } 67} 68 69$idn = $$ % 100; 70$cfn = sprintf( "cfA%03d%s", $idn, $hostname ); 71print "cfn='$cfn'\n" if $Debug; 72$fn = "A"; 73$filecount = 0; 74for( $i = 0; $i < @files; ++$i ){ 75 $file = $files[$i]; 76 if( ! -f $file || ! -r _ || ! -s _ ){ 77 print "not a readable, nonzero length file - $file\n"; 78 } else { 79 $df = sprintf( "df%s%03d%s", $fn, $idn, $hostname ); 80 $dfn[$i] = $df; 81 $cf .= "N$file\n" . "f$df\n" . "U$df\n"; 82 ++$filecount; 83 ++$fn; 84 if( $filecount == 26 ){ $fn = "a"; } 85 } 86} 87 88if( $filecount > 52 ){ 89 print STDERR "too many files\n"; 90 exit 2; 91} 92 93if( $filecount == 0 ){ 94 print "nothing to print\n"; 95 exit( 1 ); 96} 97 98if( $Debug ){ 99 print "cf contents = '$cf'\n"; 100 print "cf len " . length( $cf ) . "\n"; 101} 102 103$SOCK = getconnection( $remote, $port ); 104sendit( $SOCK, sprintf( "\002%s\n", $pr ));; 105 106$sendcf = "\002" . length( $cf ) . " $cfn\n"; 107sendbuffer( $SOCK, $sendcf, $cf ); 108 109print "sending files '@files'\n" if $Debug; 110for( $i = 0; $i < @files; ++$i ){ 111 if( $dfn[$i] ){ 112 sendfile( $SOCK, $dfn[$i], $files[$i] ); 113 } 114} 115 116close ($SOCK) or die "close: $!"; 117exit 0; 118