#!/usr/local/bin/perl -w
# @(#) SEPserver.pl	Acquires Secure-Email-Print files from POP3 server and
#			passes them to designated printer(s). Requires 'gpg'.
#			Intended for invocation via inittab entry.
#
# 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;					# A list of message-uid's is
use File::Basename;				# maintained so we don't need
use Net::POP3;					# Date::Manip module.
use Sys::Syslog qw(:DEFAULT setlogsock);
use vars qw($VERSION);
$VERSION = "1.0";
my $pass="MySecret"; my $tmp="/tmp";		# POP3 login password,
my %uidtime;					# directory for temp'y files.
die "Usage: ", basename($0). " printer1 [ printer2 ..]\n" if ! defined $ARGV[0];
foreach my $j ("HUP","INT","QUIT","ABRT","ALRM","TERM") {$SIG{$j}=sub{exit}}
my $tmp1=tempfile("$tmp"); my $tmp2=tempfile("$tmp"); my $tmp3=tempfile("$tmp");
setlogsock('unix');
openlog(basename($0), 'cons,nowait', 'local7');
syslog ('info',"Using $tmp1, $tmp2, $tmp3 ..");
while (1) {					# Loop forever, processing 
  sleep 30;					# all printers in each pass, and
  foreach my $printer (@ARGV){process($printer)}# sleeping for 30 seconds
  foreach my $r (keys(%uidtime)) {		# between each pass.
    if( (time - $uidtime{$r}) > 172800 ) {delete $uidtime{$r}}
  }						# Orphan purge.
}			

sub process {
  my ($flag,$i,$j,$k,$l,$m,$user,$pop,$u,@field,@part,$count,$top30,
      %slot,%tp,$message,$buffer,$print);
  $user = $_[0];
  $pop = Net::POP3->new();	 		# Login to POP3 server; use apop
  $count = $pop->login($user,$pass) || return;	# instead of login if supported.
  for ($i = 1; $i <= $count; $i++ ) {	
    $u=$user."=".$pop->uidl($i) or next;	# Get message.
    $uidtime{$u} = time if ! exists $uidtime{$u};           
    if((time - $uidtime{$u}) > 86400) {		# If we've seen it before, check
      $pop->delete($i);delete $uidtime{$u};next	# age and expire if necessary.
    }
    $top30=$pop->top($i,30)         || next;	# Get header plus first 30
    undef @part;				# message lines.
    for ($j = 0; $j < 99; $j++ ) {
      defined @$top30[$j]           || last;
      if( defined($part[1]) && (length(@$top30[$j]) < 3) ) {last}
      (@field)=split(/ /,@$top30[$j]); $m=0;	# Extract content-type fields.
      while (defined $field[$m] ) {
        study $field[$m];
        if ( $field[$m] =~ m/^-----BEGIN/){	# PGP Message start
          if(! defined $part[1]) {foreach $m (0,1,2){$part[$m]=1}}
        }				
        elsif( $field[$m] =~ m/^id=/ ) {	# Message/partial .. id
          $part[0]=$field[$m]; $part[0]=~s/id=//; $part[0]=~s/\;//
        }
        elsif( $field[$m] =~ m/^number=/ ){	# Message/partial .. number
          $part[1]=$field[$m]; $part[1]=~s/\D//g
        }
        elsif( $field[$m] =~ m/^total=/ ) {	# Message/partial .. total
          $part[2]=$field[$m]; $part[2]=~s/\D//g
        }
        $m++
      }
      if (defined($part[0]) && defined($part[1])) {
        $slot{$part[0]."=".$part[1]}=$i;	# If we found enough fields,
        if ( defined $part[2]  ) {		# record mail-slot for part.
          $tp{$part[0]} = $part[2] if $part[2] eq $part[1]
        }
      }
      else { next }
      next if ! exists $tp{$part[0]};
      for ($k=1;$k<=$tp{$part[0]};$k++){	# Check if we have all parts.
        goto I if ! defined $slot{$part[0]."=".$k}
      }					
      open (DATA,">$tmp1") || goto I;		# Don't pipe into gpg; if it
      for ($k=1;$k<=$tp{$part[0]};$k++){	# crashes, program will exit!
        $message=$pop->get($slot{$part[0]."=".$k});
        $l=0; $buffer=""; $print="N";		# Assemble parts.
        while ( defined @$message[$l] ) {
          chomp @$message[$l];
          study @$message[$l]; 			# Part 1: start at "-----BEGIN",
          if( $k == 1 ) {			# stop before 2nd blank line.
            if( @$message[$l]=~m/^-----BEGIN/ ) { $m=-2;  $print="Y"}
            if( $print eq "Y" ) {
              if( @$message[$l] eq "" ) { $m++; if( $m >= 0)   {last} } 
              $buffer=$buffer.@$message[$l]."\n"
            }
          }					# Part 2,3,..: skip 1 blank line
          else {				# after "id=", then start; stop
            if( $print eq "Y" ) {		# before next blank line.
              if( @$message[$l] eq "" )                        {last} 
              $buffer=$buffer.@$message[$l]."\n"
            }
            if( @$message[$l]=~m/id=/ )                  {$print="R"}
            if((@$message[$l] eq "") && ($print eq "R")) {$print="Y"}
          }
          $l++;
        }
        print DATA $buffer                   or goto I
      }
      close DATA                             || goto I;
      system "/usr/local/bin/gpg --decrypt --batch <$tmp1 >$tmp3 2>$tmp2"
                                             || goto I;
      system "lpr -P $user $tmp3 >/dev/null";
      open (FILE, $tmp2);
      while (<FILE>) { chomp; syslog('info', $_) }
      close FILE;
      for ($k=1;$k<=$tp{$part[0]};$k++){
        $u=$user."=".$pop->uidl($slot{$part[0]."=".$k});
        syslog('info',
          "Deleting item: $slot{$part[0].\"=\".$k} $part[0]"."="."$k");
        $pop->delete($slot{$part[0]."=".$k});
        delete $uidtime{$u}
      }
      @part=keys(%uidtime); $k=1+$#part;
      syslog('info',"There are now: $k UID-table records");
      goto I
    }
I:}
  $pop->quit()
}

{ my (@tempfiles);		# Subroutine to create a temporary file in
  sub tempfile() {		# designated directory, with automatic cleanup
    use IO::File;		# on exit. Calling program should trap signals
    use File::Spec;		# HUP, INT, QUIT, TERM etc. with an 'exit' call.
    foreach my $j ("A".."Z","a".."z") {
      my $name=File::Spec->catfile($_[0],"TM".$$.$j); push (@tempfiles, $name);
      if(sysopen(FILE,$name,O_WRONLY|O_EXCL|O_CREAT)) {close FILE;return $name}
      $name=pop (@tempfiles)	# Generate and push a name, return if 'create'
    }				# succeeds; otherwise pop it and try another.
    die "Temporary-file creation failure!\n"
  }
  END { foreach my $file (@tempfiles) {unlink $file} }
}

=head1 NAME

SEPserver - Secure Email Print server program (GPG-based).

=head1 README

SEPserver is a Secure Email Print server.
It acquires Secure-Email-Print files from
a POP3 server, and decodes them using GPG.

=head1 DESCRIPTION

C<SEPserver> is a Secure Email Print server program (GPG-based).
It acquires Secure-Email-Print files from a POP3 server, and
aggregates their contents where appropriate (ref: RFC 2046),
then decodes them using GPG; output is fed to designated
printers.

=head1 USAGE

=over 4

=item SEPserver printer1 [ printer2 ..]

=back

You will need to change the POP3 login password declared within
the program. You may also want to change the directory used for
temporary files.

This program should be executed by a user whose home directory
contains GPG public signatures for those clients authorised to
use it.

=head1 PREREQUISITES

This script requires the 'gpg' executable. The C<Net> module
is also required, and the names of the POP3 hosts used
will be taken from the 'libnet.cfg' file included therein.

=head1 SCRIPT CATEGORIES

Mail
Networking

=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