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

# Usage check
if ($#ARGV != 2) {die "Usage: ",basename($0)." Pop3Server Printer MaxMb\n"}
if ( ($ARGV[2] !~ m/^\d+$/) && ($ARGV[2] !~ m/^-\d+$/) ) {
  die "MaxMb must be integer, with optional preceding '-' for SSL connection\n"}

# If an old PID file exists, kill the stale process; then write new PID
my $pidfile=File::Spec->catdir(File::Spec->rootdir,"var","tmp",
                               basename($0)."=".$ARGV[0]); 
if (open(FILE,$pidfile)) {my $p=<FILE>; close FILE; unlink($pidfile); kill 9,$p}

open(FILE,'>',$pidfile) or die "Can't open PID file";
print FILE $$           or die "Can't write to PID file";
close FILE;

# Login to POP3 server, get and delete one job, then repeat 
while (1) {
  my ($ssl, $mach, $login, $pass, $acc, $pop);
  if ($ARGV[2]>0) {$ssl=0} elsif ($ARGV[2]<0) {$ssl=1} else {die "MaxMB=0 ??\n"}
  $mach=Net::Netrc->lookup($ARGV[0])   or die ".netrc entry not found\n";
  ($login, $pass, $acc) = $mach->lpa   or die "Login or password not found\n";
  $pop=new Mail::POP3Client(USER=>$login, PASSWORD=>$pass, HOST=>$ARGV[0],
                            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[2])*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[1]);
              my ($index,$uid)=split(/\s+/,$pop->Uidl(1));
              if (my $jobid=$printer->printFile("$tmp","$uid")) {
                print "$uid ",$got," bytes received => ",
                  $ARGV[1]."-".$jobid." .. $t part(s)\n";
                unlink @list;
                if ( (defined($brRe)) && ($brNo!~m/^N/) ) {
                  my $printed=length($buffer);
                  if (my $smtp=Net::SMTP->new() ) {
                    my @host=gethostbyaddr(inet_aton(hostname),AF_INET);
                    my $logname=$ENV{LOGNAME} || $ENV{USER} || "root";
                    $smtp->mail($logname."\@".$host[0]); $smtp->to($brRe);
                    $smtp->data("To: ",$brRe,
                                "\nSubject: Job ",$uid," for Printer ",$ARGV[1],
                                "\n\n",$got," bytes received in ",$t," parts;",
                                "\n"  ,$printed," bytes printed.");
                    $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 Pop3Server Printer [-]Max-Mb

=back

e.g.: BIPserver pop.google.com HP4350 96

Accesses the designated POP3 server 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 names and 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