#!/usr/bin/perl
# @(#) CIPserver.pl	Acquires Castelle-Internet-Print jobs from a POP3 server
#			and passes them to a designated printer.
#			Rev'd: 2007-06-16.
#
# Copyright (c) 2007 Graham Jenkins <grahjenk@cpan.org>. 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::Temp qw/tempfile/;
use Mail::POP3Client;
use Net::Netrc;
use Net::SMTP;
use Net::CUPS::Destination;
use MIME::Base64;
use Proc::ProcessTable;
use Compress::Zlib;
use vars qw($VERSION);
$VERSION = "1.06";

# Usage check, duplicate process check
if ($#ARGV != 3) {die "Usage: ",basename($0)." User Pop3Server Printer MaxMb\n"}
if ( ($ARGV[3] !~ m/^\d+$/) && ($ARGV[3] !~ m/^-\d+$/) ) {
  die "MaxMb must be integer, with optional preceding '-' for SSL connection\n"}
my $table=new Proc::ProcessTable;
my $procCount=0;
foreach my $proc (@{$table->table}) {
  my (@f)=split(/\s+/,$proc->cmndline);
  if ( ($#f>3)                 && (basename($f[$#f-4]) eq basename($0)) &&
       ($f[$#f-3] eq $ARGV[0]) && ($f[$#f-2] eq $ARGV[1]) ) {$procCount++}
}
if ($procCount > 1) { die "Duplicate Process Found\n" }

# Login to POP3 server, get and delete one job, then repeat 
while (1) {
  my ($ssl, $mach, $pass, $pop);
  if ($ARGV[3]>0) {$ssl=0} elsif ($ARGV[3]<0) {$ssl=1} else {die "MaxMB=0 ??\n"}
  $mach=Net::Netrc->lookup($ARGV[1],$ARGV[0]) or die ".netrc entry not found\n";
  $pass=$mach->password()                     or die "Password not found\n";
  $pop=new Mail::POP3Client(USER=>$ARGV[0], PASSWORD=>$pass, HOST=>$ARGV[1],
                            USESSL=>$ssl);
  if ($pop->Count()<0)                          {die "Connection failed\n"}
  if ($pop->Count()<1)                          {exit 0}
  my ($msgn,$size) = split(/\s+/,$pop->List(1));
  if ($size < abs($ARGV[3])*1024*1024) {# Append line to string if "Notify",
    my ($retu, $noti, $junk, $str,$b64);# "base64" and empty line have been seen
    foreach my $a (my @array=$pop->Retrieve(1)) { 
      if (defined($str))                                       {$str.=$a; next}
      if (defined($b64) && (length($a)<2))                     {$str="" ; next}
      my (@word)=split(/\s+/,$a);
      if (defined($word[1]) && ($word[0]=~m/^From:$/        )) {$retu=$word[1]}
      if (defined($word[1]) && ($word[0]=~m/^Notify:$/      )) {$noti=$word[1]}
      if (defined($word[0]) && ($word[0]=~m/^BRO-NOTIFY=/   )) {$noti="Y"     }
      if (defined($word[0]) && ($word[0]=~m/^BRO-NOTIFY=N/  )) {$noti="N"     }
      if (defined($word[0]) && ($word[0]=~m/^BRO-REPLY=/    )) {
                                             ($junk,$retu)=split(/=/,$word[0])}
      if (defined($noti)&&defined($word[1])&&($word[1]=~m/^base64$/)) {$b64=""}
    }
    if( ! (defined($retu)) )                              {$retu=""; $noti="N"}
    if(defined($str)) {
      if ( $str=decode_base64($str) ) {
        if ( defined(uncompress($str)) ) {$str=uncompress($str)}
        my ($fh,$tmp)=tempfile(UNLINK=>1);
        print $fh $str;                 # Decode the string, check for (non-
        close $fh;                      # standard) compression, print to
        my $cups=Net::CUPS->new();      # temporary file, then print the file
        my $printer=$cups->getDestination($ARGV[2]);
        my ($index,$uid)=split(/\s+/,$pop->Uidl(1));
        if (my $jobid=$printer->printFile("$tmp","$uid")) {print $uid,": ",
                 $retu," ",length($str), " bytes => ",$ARGV[2]."-".$jobid,"\n"}
        if ( $noti=~m/^Y/ ) {		# If notification requested, email it
          if (my $smtp=Net::SMTP->new() ) {
            $smtp->mail($ENV{USER}); $smtp->to($retu);
            $smtp->data("To: ",$retu,"\nSubject: Job ",$uid," for Printer ",
                               $ARGV[2],"\n\n",length($str)," bytes printed!");
            $smtp->quit();           print $uid,": notification => ",$retu,"\n"
          }
        }
      }
    }
  }
  $pop->Delete(1); $pop->Close()	# Close as soon as we've processed each
}					# job, so a break can only effect 1 job

__END__

=head1 NAME

CIPserver - Castelle/Kingston print-server emulator

=head1 README

CIPserver acquires Castelle-Internet-Print jobs from
a POP3 server and passes them to a designated printer.

=head1 DESCRIPTION

C<CIPserver> is a simple Castelle print-server emulator using
the Castelle-Internet-Print protocol. It should be called
periodically (e.g. through 'cron' at 10-minute intervals).

At each invocation, it retrieves jobs sent to a
designated address on a POP3 server, and passes
them to a corresponding printer.

=head1 USAGE

=over 6

CIPserver Login Pop3Server Printer [-]Max-Mb

=back

e.g.: CIPserver graham pop.google.com HP4350 -5

Accesses the designated POP3 server using the supplied
login identity, and sends jobs found there to the
nominated printer. Incoming messages whose length
exceeds Max-Mb are dropped.

Login passwords are extracted using Net::Netrc.
You can force CIPserver to use SSL by specifying a
negative value for Max-Mb.

An appropriate Windows client program can be downloaded
from <www.castelle.com>. CIPserver is also able to
process single-part Brother-Internet-Print jobs and jobs
intended for Kingston print-servers.

=head1 SCRIPT CATEGORIES

Networking
UNIX/System_administration

=head1 AUTHOR

Graham Jenkins <grahjenk@cpan.org>

=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