<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/env perl
# @(#) CIPserver.pl	Acquires Castelle-Internet-Print jobs from a POP3 server
#			and passes them to a designated printer.
#			Rev'd: 2011-11-04.
#
# Copyright (c) 2007 Graham Jenkins &lt;grahjenk@cpan.org&gt;. 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;        # Note: IO::Socket::SSL must be installed
use Net::Netrc;              # if SSL connections are to be made!
use Net::SMTP;
use Net::CUPS::Destination;
use MIME::Base64;
use Compress::Zlib;
use Compress::Raw::Lzma;
use Sys::Hostname;
use Socket;
use vars qw($VERSION);
$VERSION = "1.14";

# Un_compress subroutine; accepts string as parameter, uncompresses if possible
sub un_compress {
  my ($z,$o);
  if ( defined(uncompress($_[0])) ) { $_[0]=uncompress$_[0]; return } 
  $z=new Compress::Raw::Lzma::AutoDecoder;
  if( $z-&gt;code($_[0],$o)==LZMA_STREAM_END ) { $_[0]=$o }
}

# Usage check
if ($#ARGV != 2) {die "Usage: ",basename($0)." Pop3Server Printer MaxMb\n"}
if ( ($ARGV[2] !~ m/^\d+$/) &amp;&amp; ($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-&gt;catdir(File::Spec-&gt;rootdir,"var","tmp",
                               basename($0)."=".$ARGV[0]); 
if (open(FILE,$pidfile)) {my $p=&lt;FILE&gt;; close FILE; unlink($pidfile); kill 9,$p}

open(FILE,'&gt;',$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]&gt;0) {$ssl=0} elsif ($ARGV[2]&lt;0) {$ssl=1} else {die "MaxMB=0 ??\n"}
  $mach=Net::Netrc-&gt;lookup($ARGV[0])   or die ".netrc entry not found\n";
  ($login, $pass, $acc) = $mach-&gt;lpa   or die "Login or password not found\n";
  $pop=new Mail::POP3Client(USER=&gt;$login, PASSWORD=&gt;$pass, HOST=&gt;$ARGV[0],
                            USESSL=&gt;$ssl);
  if ($pop-&gt;Count()&lt;0)                          {die "Connection failed\n"}
  if ($pop-&gt;Count()&lt;1)                          {exit 0}
  my ($msgn,$size) = split(/\s+/,$pop-&gt;List(1));
  if ($size &lt; abs($ARGV[2])*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-&gt;Retrieve(1)) { 
      if (defined($str))                                       {$str.=$a; next}
      if (defined($b64) &amp;&amp; (length($a)&lt;2))                     {$str="" ; next}
      my (@word)=split(/\s+/,$a);
      if (defined($word[1]) &amp;&amp; ($word[0]=~m/^From:$/        )) {$retu=$word[1]}
      if (defined($word[1]) &amp;&amp; ($word[0]=~m/^Notify:$/      )) {$noti=$word[1]}
      if (defined($word[0]) &amp;&amp; ($word[0]=~m/^BRO-NOTIFY=/   )) {$noti="Y"     }
      if (defined($word[0]) &amp;&amp; ($word[0]=~m/^BRO-NOTIFY=N/  )) {$noti="N"     }
      if (defined($word[0]) &amp;&amp; ($word[0]=~m/^BRO-REPLY=/    )) {
                                             ($junk,$retu)=split(/=/,$word[0])}
      if (defined($noti)&amp;&amp;defined($word[1])&amp;&amp;($word[1]=~m/^base64$/)) {$b64=""}
    }
    if( ! (defined($retu)) )                              {$retu=""; $noti="N"}
    if(defined($str)) {
      if ( $str=decode_base64($str) ) {
        my $got=length($str);
        un_compress($str);
        my ($fh,$tmp)=tempfile(UNLINK=&gt;1);
        print $fh $str;                 # Decode the string, check for (non-
        close $fh;                      # standard) compression, print to
        my $cups=Net::CUPS-&gt;new();      # temporary file, then print the file
        my $printer=$cups-&gt;getDestination($ARGV[1]);
        my ($index,$uid)=split(/\s+/,$pop-&gt;Uidl(1));
        if (my $jobid=$printer-&gt;printFile("$tmp","$uid")) {print $uid,": ",
                 $retu, " ", $got, " bytes =&gt; ", $ARGV[1]."-".$jobid, "\n"}
        if ( $noti=~m/^Y/ ) {		# If notification requested, email it
          if (my $smtp=Net::SMTP-&gt;new() ) {
            my @host=gethostbyaddr(inet_aton(hostname),AF_INET);
            my $logname=$ENV{LOGNAME} || $ENV{USER} || "root";
            $smtp-&gt;mail($logname."\@".$host[0]); $smtp-&gt;to($retu);
            $smtp-&gt;data("To: ",$retu,"\nSubject: Job ",$uid," for Printer ",
                               $ARGV[1], "\n\n", $got,     " bytes received;",
                                         "\n", length($str)," bytes printed.");
            $smtp-&gt;quit();           print $uid,": notification =&gt; ",$retu,"\n"
          }
        }
      }
    }
  }
  $pop-&gt;Delete(1); $pop-&gt;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&lt;CIPserver&gt; is a simple Castelle print-server emulator using
the Castelle-Internet-Print protocol. It should be called
periodically (e.g. through 'cron' at 15-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 Pop3Server Printer [-]Max-Mb

=back

e.g.: CIPserver lavabit.com HP4350 -64

Accesses the designated POP3 server and sends jobs
found there to the nominated printer. Incoming messages
whose length exceeds Max-Mb are dropped. Messages whose
contents have been compressed by a software client are
automatically uncompressed.

Login names and 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 &lt;www.castelle.com&gt;. 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 &lt;grahjenk@cpan.org&gt;

=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
</pre></body></html>