#!/usr/bin/perl -w
# @(#) bsdprint.pl			BSD print client (Ref: RFC 1179).
#					Feeds jobs to remote print server
#					without generating spool files.
#
# Copyright (c) 2002 Graham Jenkins <grahjenk@au1.ibm.com>. 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 IO::Socket;
use File::Basename;
use Sys::Hostname;
use vars qw($VERSION);
$VERSION = "1.0";
my ($debug,$sock,$buffer,$hostname,$sequence,$bytes,$file,$fileno,$user,$cfl);

for (my $j=0;$j<=3;$j++) {		# Untaint the arguments.
  if (defined $ARGV[$j]) {
    if ($ARGV[$j] =~ /^([-\@\w.]+)$/) { $ARGV[$j]=$1 }
    else                              { die "Bad data in $ARGV[$j]\n" }
  }
}
				
$0 = "bsdprint.pl" if $0 =~ m%^/dev/%;	# Perform usage check.
if( defined $ARGV[2] ) { if( $ARGV[2]=~/^-/ ) { $debug=1; $ARGV[2]=~s/^-//} }
die "Usage: ".basename($0)." server printer size [user]\n"
  ."Where: 'size' is the maximum size (kb) of a data file and may be\n"
  ."       negated for debug purposes. Up to 3276 data files will be created.\n"
  ."e.g.:  ".basename($0)." pserver1 lp1 500\n"
  if( ($#ARGV<2) or ($#ARGV>3) or ($ARGV[2]!~/^\d+$/) or ($ARGV[2]<1) );

for (my $try=1;$try<=30;$try++) {	# Open a priveleged port, then send a
  for (my $port=721;$port<=731;$port++){# Receive-print-job directive.
    print STDERR "Opening LocalPort: $port\n" if $debug;
    $sock = new IO::Socket::INET (LocalPort => $port,
                                  PeerAddr  => $ARGV[0],
                                  PeerPort  => 515,
                                  Reuse     => 1         ) or next;
    send_ack("\002".$ARGV[1]."\n", "Receive-print-job");
    $hostname=hostname() or $hostname="myhost";
    ($hostname, my $j)=split(/\./,$hostname); $hostname=substr($hostname,0,31);
    $sequence=get_seq(1000);
    while (length($sequence)<3) {$sequence="0".$sequence}
    $sequence=$sequence.$hostname;
    $fileno=-1; $cfl=0;
    while ( read(STDIN, $buffer, $ARGV[2]*1024) >0 ) {
      $bytes=length($buffer);		# Fill buffer, generate data-file name,
      $file=get_name($fileno);		# send "receive-data-file" directive,
      print STDERR "Sending data file: $file  $bytes bytes\n" if $debug;
      send_ack("\003".$bytes." ".$file."\n", "Receive-data-file");
      send_chk($buffer, "Data-file");	# Send data-file.
      send_ack("\000","Date-file-end");	# Get acknowledgement.
      $cfl+=3*(length($file)+2)
    }
    $user="daemon"; $user=$ARGV[3] if defined($ARGV[3]);
    print STDERR "Sending control file: cfA$sequence  user: $user\n" if $debug;
    $buffer=$buffer."H".$hostname."\nP".$user."\n";
    send_ack("\002".(length($buffer)+$cfl)." cfA$sequence\n","Recv-cntl-file");
    $j=-1;
    while ($j<$fileno) {		# Send control-file.
      $file=get_name($j);
      foreach my $k ("l","U","N") {$buffer=$buffer.$k.$file."\n"}
      send_chk($buffer,"Control-file");	# Construct and send records relating
      $buffer=""			# to each data-file individually so that
    }					# buffer length is never too large.
    send_ack("\000","Control-file-end");# Get acknowledgement.
    print STDERR "Closing LocalPort: $port!\n" if $debug;
    close $sock;
    exit
  }
  sleep 7
}

sub get_seq {				# Usage: get_seq($j);
  use File::Spec;			# Returns next in sequence of $j
  use Fcntl qw(:DEFAULT :flock);	# numbers starting at 0.
  use Env qw(TEMP TMP);
  foreach my $dir ( $TEMP, $TMP, "/var/tmp", "/tmp") {
    if ( (defined $dir) && (-d $dir) ) {
      my $file=File::Spec->catfile($dir,basename($0).".seq");
      for (my $try=0;$try<=2;$try++) {
        close FH; sleep $try;
        sysopen(FH, $file, O_RDWR|O_CREAT) or next;
        eval {flock(FH, LOCK_EX)}; next if ! $@ =~ /unimplemented/;
        my $seq = <FH>                     || 0;
        chomp($seq);
        seek(FH, 0, 0)                     or next;
        truncate(FH, 0)                    or next;
        print FH ($seq+1)%$_[0], "\n"      or next;
        close FH                           or last;
        return $seq
      }
    }
  }
  die "Could not open sequence file!\n"
}

sub get_name {				# Usage: get_name($j);
  my @alpha=("","A".."Z","a".."z","0".."9","-");
  return my $file="df".$alpha[1+$_[0]%52].$sequence.$alpha[$_[0]/52]
    if $_[0]++ <= 3274;			# Increments $j and returns filename. 
  die "Input too large!\n"
}

sub send_ack {				# Usage: send_ack($string, $comment);
  my $stat;
  return if ( (send($sock,$_[0],0) == length($_[0])) &&
              (defined recv($sock,$stat,1,0))        &&
              ($stat eq "\000")                         );
  die "Failed whilst doing: $_[1]\n"
}

sub send_chk {				# Usage: send_chk($string, $comment);
  my $start=0;
  my $j;
  while ( $start < length($_[0]) ) {
    $j=length($_[0])-$start; $j=1024 if $j >1024;
    die "Failed whilst doing: $_[1]\n"
      if send($sock,substr($_[0],$start,$j),0) != $j;
    $start=$start+$j
  }
}
__END__

=head1 NAME

bsdprint - BSD print client (Ref: RFC 1179)

=head1 README

bsdprint is a BSD print client which 
feeds jobs to a remote print server
without generating spool files.

=head1 DESCRIPTION

C<bsdprint> is a BSD print client which feeds jobs to a
remote print server without generating spool files. This
is accomplished through the use of multiple data files
per job, with the size of these being such that each can
be accomodated in memory.

C<bsdprint> can be invoked via an input filter on BSD-based
systems, or called in place of 'netpr' or similar programs
on Solaris or other System V platforms.

=head1 USAGE

=over 4

=item bsdprint server printer size [user]

=back

The 'size' parameter gives the maximum data file size in kb;
a typical value is about 20% of available swap space. Up to
3276 data files will be constructed as necessary. Some servers
will not accept this many data files.

If a negative value is given for 'size', the absolute value
will be used, and progress messages will be written to STDERR.

=head1 PREREQUISITES

C<bsdprint> should be executed with root priveleges so
that it can use source ports 721 through 731 as
specified in RFC 1179.

=head1 SCRIPT CATEGORIES

Networking
UNIX/System_administration

=head1 AUTHOR

Graham Jenkins <grahjenk@au1.ibm.com>

=head1 COPYRIGHT

Copyright (c) 2002 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