#!/opt/local/bin/perl -w
# @(#) SEPserver.pl	Acquires Secure-Email-Print files from POP3 server and
#			passes them to designated printer(s). Rev'd: 2002-12-19.
#
# 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 File::Basename;
use Net::POP3;
use Sys::Syslog;
use Crypt::GPG;
use Printer;
use Env qw(GPGBIN MAXMESS MAXJOB EXPIRE SLEEP);
use vars qw($VERSION);
$VERSION = "1.01";
my $gpgbin=$GPGBIN?$GPGBIN:"/usr/local/bin/gpg";# Name of GPG executable.
my $maxmess=$MAXMESS?$MAXMESS:23000000;		# Maximum message-size (bytes),
my $maxjob =$MAXJOB ?$MAXJOB :33554432;		# encrypted-job-size (bytes),
my $expire =$EXPIRE ?$EXPIRE :10800;		# expire-time(secs) and
my $sleep  =$SLEEP  ?$SLEEP  :30;		# sleep-time (secs).
my %uidtime;
defined($ARGV[0]) || die "Usage: ", basename($0). " printer1 [printer2 ..]\n";
syslog ('local7|info',basename($0)." start .. $maxmess/$maxjob/$expire/$sleep");

while (1) {					# Loop forever, processing
  foreach my $user (@ARGV) {			# print-queues in turn.
    my (%slot,%tp); sleep $sleep;
    my $pop=Net::POP3->new() or next;		# Login to POP3 server and get
    my $count=$pop->login($user) or next;	# header plus 1st 30 lines of
  I:for (my $i=1;$i<=$count;$i++) {		# each message. Mark old and
      my $s=$pop->list($i) or next;		# over-size messages for
      my $u=$user."=".$pop->uidl($i) or next;	# deletion.
      $uidtime{$u}=time if ! exists $uidtime{$u};
      if ((time-$uidtime{$u})>$expire) {$uidtime{$u}=0}
      if (($s>$maxmess) or ($uidtime{$u}<1)) {	# Delete marked messages; this
        $pop->delete($i);			# mechanism picks up messages
        syslog('local7|info',"$u expired!");next# which didn't get deleted due
      }						# to server connection failure.
      my $top30=$pop->top($i,30) or next;
      my @part;
      for (my $j=0;$j<99;$j++) {		# Extract content-type fields.
        if (! defined(@$top30[$j])) {last}
        if (defined($part[1]) && (length(@$top30[$j]) < 3)) {last}
        (my @field)=split(/ /,@$top30[$j]); my $m=0;
        while (defined $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 (my $k=1;$k<=$tp{$part[0]};$k++){	# Check if we have all parts.
          next I if ! defined $slot{$part[0]."=".$k}
        }
        my $buffer="";
        for (my $k=1;$k<=$tp{$part[0]};$k++){
          my $message=$pop->get($slot{$part[0]."=".$k}) or next I;
          my $l=0; my $print="N";		# Assemble parts.
          while ( defined @$message[$l] ) {
            chomp @$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.=@$message[$l]."\n";
                if (length($buffer) > $maxjob) {$uidtime{$u}=0; next I}
              }
            }					# 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.=@$message[$l]."\n";
                if (length($buffer) > $maxjob) {$uidtime{$u}=0; next I}
              }
              if (@$message[$l]=~m/id=/)                    {$print="R"}
              if ((@$message[$l] eq "") && ($print eq "R")) {$print="Y"}
            }
            $l++
          }
        } #$k
        my $gpg=new Crypt::GPG; $gpg->gpgbin($gpgbin);
        ($buffer,my $sig)=$gpg->verify($buffer);# If all-part decrypt succeeded,
        if (length($buffer)>0) {		# mark one part for deletion,
          $uidtime{$u}=0;  	 		# then print decrypted string.
          my $prn=new Printer($^O=>"$user"); $prn->print($buffer);
          syslog('local7|info',"$part[0] $tp{$part[0]} => $user")
        }
        next I
      } #$j
    } #$i
    if (defined $count) {			# If a server mailbox is empty
      $pop->quit();				# clean out all records relating
      if ($count<1) {				# to it.
        foreach my $r (keys(%uidtime)) {delete $uidtime{$r} if $r=~m#^$user=#}
      }
    }
  } #$user
}

__END__

=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

This program should be executed by a user whose home directory
contains GPG public signatures for those clients authorised to
use it. Environment variables can be set to modify the defaults
assigned for GPG-executable location and message-size limits as
shown near the start of the program.

=head1 PREREQUISITES

This script requires the C<Crypt::GPG>, C<Net::POP3>
and C<Printer> modules.  The POP3 server is determined using
C<Net::Config>, and login passwords are extracted using C<Net::Netrc>.

=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