#!/usr/bin/perl
# @(#) BIPserver.pl	Acquires Brother-Internet-Print jobs from a POP3 server
#			and passes them to designated printer(s).
#			Rev'd: 2007-08-04.
#
# 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 Env qw(PART_DIR);           # Directory where partials are saved
use vars qw($VERSION);
$VERSION = "2.02";
my $partDir=$PART_DIR ?$PART_DIR :"/var/tmp";

# 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, save 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
    my ($brRe,$brNo,$brPa,$brId,$junk,$str,$b64); # "BRO-NOTIFY","base64" and
    foreach my $a (my @array=$pop->Retrieve(1)) { # empty line have been seen 
      if (defined($str))                                       {$str.=$a; next}
      if (defined($b64) && (length($a)<2))                     {$str="" ; next}
      my (@word)=split(/\s+/,$a);
      if (! (defined($word[0])) )                              {          next}
      if ($word[0]=~m/^BRO-NOTIFY/    )    { ($junk,$brNo)=split(/=/,$word[0])}
      if ($word[0]=~m/^BRO-REPLY=/    )    { ($junk,$brRe)=split(/=/,$word[0])}
      if ($word[0]=~m/^BRO-PARTIAL=/  )    { ($junk,$brPa)=split(/=/,$word[0])}
      if ($word[0]=~m/^BRO-UID=/      )    { ($junk,$brId)=split(/=/,$word[0])}
      if (defined($brId)&&defined($word[1])&&($word[1]=~m/^base64$/)) {$b64=""}
    }
    if( defined($str) && ($str=decode_base64($str)) && defined($brPa)
                                                    && defined($brId) )  {
      $brPa=~s%/%.%;
      if ( open(FILE,">".File::Spec->catdir($partDir,$brPa.".".$brId)) ) { 
        binmode FILE; print FILE $str; close FILE # If the string was built, 
      }                                           # write it to a file
      my ($p,$t) = split(/\./,$brPa);
      if( defined($t) ) {
        my (@list, $buffer);                      # Try to add each part to a
        for (my $j=1;$j<=$t;$j++) {               # composite buffer
          if (open(PART,File::Spec->catdir($partDir,$j.".".$t.".".$brId))) { 
            push (@list,File::Spec->catdir($partDir,$j.".".$t.".".$brId));
            $buffer.=do {local $/; <PART>};
            close PART;
            if( $j==$t ) {                        # If we got all the parts,
              my $got=length($buffer);            # try to uncompress the buffer
              if ( defined(uncompress($buffer)) ) {$buffer=uncompress($buffer)}
              my ($fh,$tmp)=tempfile(UNLINK=>1);  # Write the buffer to a
              print $fh $buffer;                  # temporary file and print it
              close $fh;                          # Delete the parts, and if
              my $cups=Net::CUPS->new();          # requested, send email
              my $printer=$cups->getDestination($ARGV[2]);
              my ($index,$uid)=split(/\s+/,$pop->Uidl(1));
              if (my $jobid=$printer->printFile("$tmp","$uid")) {
                print "$uid ",$got," bytes received => ",
                  $ARGV[2]."-".$jobid." .. $t part(s)\n";
                unlink @list;
                if ( (defined($brRe)) && ($brNo!~m/^N/) ) {
                  if ( my $smtp=Net::SMTP->new() ) {
                    $smtp->mail($ENV{USER}); $smtp->to($brRe);
                    $smtp->data("To: ",$brRe,
                                "\nSubject: Job ",$uid," for Printer ",$ARGV[2],
                                "\n\n",$got," bytes received in ",$t," parts!");
                    $smtp->quit();    print $uid,": notification => ",$brRe,"\n"
                  }
                }
              }                                  # If print fails, may be due 
            }                                    # to bad part at mail server
          }                                      # so delete parts there anyway
          else {last}
        }
      } 
    }
  }
  $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

BIPserver - server for Brother-Internet-Print protocol

=head1 README

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

=head1 DESCRIPTION

C<BIPserver> is a simple Brother print-server emulator using
the Brother-Internet-Print protocol. It should be called
periodically (e.g. through 'cron' at 30-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

BIPserver Login Pop3Server Printer [-]Max-Mb

=back

e.g.: BIPserver johnprint@bluebottle.com mail.bluebottle.com HP4350 96

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. The components of multi-part
jobs are saved locally until all parts are available.

Login passwords are extracted using Net::Netrc.
You can force BIPserver to use SSL by negating the
value you use for Max-Mb.

An appropriate Windows client program can be downloaded
from <www.brother.com>.

=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