#!/opt/local/bin/perl -w # @(#) BIPserver.pl Acquires Brother-Internet-Print jobs from a POP3 server # and passes them to designated printer(s). Intended # for invocation via inittab entry. Rev'd: 2002-12-12. # # 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. use strict; use File::Basename; # For security, you may wish to use Net::Config; # authenticate each job-request use Net::Netrc; # by using a one-time or other use Net::POP3; # code in the REPLY field as a use Net::SMTP; # password to look-up a real use Sys::Syslog; # REPLY address. use MIME::Base64; use Printer; use vars qw($VERSION); $VERSION = "1.01"; my $maxmess=1000000; # Maximum message-size (bytes). my $maxjob=10000000; # Maximum job-size (bytes). my $expire=3; # Expiration time (hours). my %uidtime; defined($ARGV[0]) || die "Usage: ", basename($0). " printer1 [printer2 ..]\n"; syslog ('local7|info',basename($0)." starting .."); while (1) { # Loop forever, processing foreach my $user (@ARGV) { # print-queues in turn. my (@field,@part,%slot,$fh,%tp); sleep 30; my @hosts=@{$NetConfig{pop3_hosts}} or next;# Use 1st specified POP3 server. my $machi=Net::Netrc->lookup($hosts[0],$user) or next; my $passw=$machi->password or next; # Get passwd from .netrc file. my $pop=Net::POP3->new() or next; # Login to POP3 server and get my $count=$pop->login($user,$passw) or next;# header plus 1st 15 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*3600)) {$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 $top15=$pop->top($i,15) or next; my $parsdate; my $notify="None"; my $reply=""; for (my $j=0;$j<99;$j++) { if (@$top15[$j]) { (@field)=split(/=/,@$top15[$j]); if (defined($field[0])) { if ($field[0] eq "BRO-NOTIFY"){chomp $field[1];$notify=$field[1];} if ($field[0] eq "BRO-REPLY") {chomp $field[1];$reply =$field[1];} if ($field[0] eq "BRO-PARTIAL") { # Success is notified if (@part)=split("/",$field[1]); # REPLY address is supplied chomp $part[1] # and NOTIFY is not "None". } if ($field[0] eq "BRO-UID") { # Determine print-job and part chomp $field[1]; # thereof contained in message. $slot{$field[1]."=".$part[0]}=$i; $tp{$field[1]}=$part[1] if $part[1] eq $part[0]; next I if ! defined ($tp{$field[1]}); for (my $k=1;$k<=$tp{$field[1]};$k++){ next I if ! defined($slot{$field[1]."=".$k}) } # All parts are on server? my $dec=""; # If so, get and decode them! for (my $k=1;$k<=$tp{$field[1]};$k++){ my $buf=$pop->get($slot{$field[1]."=".$k}) or next I; my $f=0; my $l=0; my $enc=""; while ( defined (@$buf[$l]) ) { if (($f==0)&&(@$buf[$l]=~m/^Content-Transfer-E.+64$/)) {$f=1} elsif (($f==1)&&(length(@$buf[$l])<2)) {$f=2} elsif (($f==2)&&(length(@$buf[$l])>1)) {$enc.=@$buf[$l]} elsif ( $f==2 ) { if (($maxjob-length($dec))>0) { $dec.=substr(decode_base64($enc),0, $maxjob-length($dec) ) or next I } # We could save memory here by last # decoding parts to array } # elements - but Printer $l++ # routines currently recombine } # elements to single scalar. } #$k # If we got and decoded all if (length($dec)>0) { # parts, mark one for deletion, $uidtime{$u}=0; # then print decoded string. my $prn=new Printer($^O=>"$user"); $prn->print($dec); syslog('local7|info',"$field[1] $tp{$field[1]} => $user"); if (($notify ne "None") && ($reply ne "")) { my $smtp=Net::SMTP->new(); $smtp->mail(); $smtp->to($reply); $smtp->data("Subject: Job $field[1] for Printer $user", length($dec)." bytes printed from $tp{$field[1]} parts!"); $smtp->quit } } } } } } #$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 BIPserver - server for Brother-Internet-Print protocol =head1 README BIPserver acquires Brother-Internet-Print jobs from a POP3 server and passes them to designated printers. =head1 DESCRIPTION C is a simple server program for the Brother-Internet-Print protocol. It should be started during system boot-up, and will run continually thereafter, acquiring jobs which have been sent to designated addresses on a POP3 server, and passing them to corresponding printers. The program has been designed to handle multi-part jobs, and to accomodate unreliable connections to its associated POP3 server. All job parts are left on the POP3 server until a full set is available; they are then assembled for printing and marked for deletion. No local filespace is used. Automatic expiration of orphan parts is also performed. If security is an issue, the program can be extended so as to perform user authentication based on a one-time or other password supplied in the reply-address field of each job. =head1 USAGE =over 4 =item BIPserver printer1 [printer2] .. =back Mailboxes having the names of each printer designated on the command line are accessed in turn, and job-parts residing therein are extracted and assembled for printing. An appropriate Windows client program can be downloaded from ; a Unix/Linux version is available from the author. =head1 SCRIPT CATEGORIES Networking UNIX/System_administration =head1 AUTHOR Graham Jenkins =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