#!/usr/bin/perl -w
# This perl script routes postscript printerdata from printerspooler to fax
#
# copy to /usr/lib/cups/backends/ and run this script from the commandline: echo blah | ./netfax
# it will tell if there are any dependancies unsolved: this tool is dependant upon the following:
# perl (we tested with v5.6 and its likely any v5 will do)
# perl modules Getopt-Long-2.32 and Mail-Sendmail-0.78
# sendfax (from the hylafax package)
# ps2ascii ps2pdf pdf2ps (comes with the ghostscript package)
# pdftk http://www.accesspdf.com/pdftk/
# a mask.pdf file that will hide the command parameters sent at the begining of your page by overlaying a white image
#
# After that you can add new printer to cups: lpadmin -p NetFax -E -v netfax.pl:
# Share the printer in samba and, if your fax server joined the domain, run:
# net -S localhost -U administrator rpc rights grant 'administrator' SePrintOperatorPrivilege
# in smb.conf [printers] section add -J %m to print command (tipically: lpr-cups -P %p -J %m -o raw $s)
# or add cups option = "%m" in the same section and make the drivers share [print$] writable
# Now from windows machine browse the fax server printers, right-click NetFax, choose properties,
# say NO when asked to install drivers, go to Advanced tab, and choose "New Driver". Choose
# some plain PS printer line Apple LaserWriter 12/640 PS and push the drivers to server.
# Now your printer can now be install on all workstations by a vbs script or by using printUI.dll.
#
# The accepted commands, placed at the begining of your faxed document are:
# 'Fax-Nr : XXX-XXXXX;(XXX)XXXXX~' the number can contain dashes or paranthesis. multiple numbers are separated by ;
# 'Clientid : AAAAAA AAAA~' the recipient name
# 'Subjectid : AAAA AAAAAAA~' the message subject
# 'E-m@il : AAA@BBBBBBB~' sender's email. if BBBBBBB matches a different windows machine name
# a winpopup message will be sent to that machine instead of originating machine
#
# Please note that every command line ends by a ~ character!
#
# in order to send a winpopup message add the following lines to notify_mail() function in /var/spool/fax/bin/notify
# HST = `echo $2 | sed -e 's/[^>]*@\([^ ]*\).*/\1/' -e '2.$d'`
# echo $1 | /usr/bin/smbclient -M $HST
#
# neXt - sorin@xxxxxxxx.com - June-2010
#
use strict;
use Getopt::Long;
use Mail::Sendmail;
# constants you must check if they are ok
my $ALLOWMULTIFAX = 1; # allow (1) or not (0) multiple faxdestinations
my $EMAILFROMDOC = 1; # get the emailaddress from samba (0) or the doc (1)
my $SENDFAX = "/usr/bin/sendfax"; # the command to send a fax
my $PS2ASCII = "/usr/bin/ps2ascii"; # the command to convert postscript to readable text
my $PS2PDF = "/usr/bin/ps2pdf"; # transform ps to pdf
my $PDFTK = "/usr/bin/pdftk"; # modify pdfs - used to overlay the mask over commands section
my $PDF2PS = "/usr/bin/pdf2ps"; # transform pdf back to ps
my $WATERMARK = "/etc/initsetup/mask.pdf"; # location of the overlay mask
# constants you can alter but should consider not to
my $TMPDIR = "/tmp/"; # the directory to store temporary files
my $MYNAME = "netfax"; # the name of this tool
my $LOGFILE = $TMPDIR . $MYNAME . ".log"; # the name of the logfile - debugging sessions only
my $PSFILE = $TMPDIR . $MYNAME . $$ . ".ps" ; # the name of the postscript temporary file
my $PSTMPFILE = $TMPDIR . $MYNAME . $$ . "work.ps" ; # the name of the postscript temporary file
my $MAILADDRESS = 'faxadmin@hfax'; # the default mailaddress for errormessages
my $MULTISEP = ";"; # if you have more than 1 faxnr on a line, they are seperated by ;
# this character should NOT appear in $DIGITS
my $DEBUG=0;
# constants you really should not touch !!!
my $FAXID = 'Fax-Nr[s]{0,1}\s*:\s*'; # search string for fax-nr
my $FAXIDS = 'Fax-Nrs\s*:\s*'; # search string for fax-nrs ( for multifax }
my $DIGITS = '0123456789+( ),-'; # digits allowed in the faxnr
my $MODEMLIKES = '0123456789+,'; # digits my modem will not reject: ,=wait +=int.access
# this should be a subset of $DIGITS
my $EMAILDOC = 'E-m@il :'; # the string to look for an emailaddress
my $CLIENTID = 'Clientid :'; # this is the recipient name
my $SUBJECTID = 'Subjectid :'; # the line with subject must contain this
########## from here on, leave the code alone, unless you are really sure ############
#variables
my @faxlines; # stores the raw faxlines
my @faxdest; # stores the faxnumbers
my $MultiFax = 0; # determines if ENDuser specified to multifax
my $mailaddress = ""; # how do we treat the errormessages
my $lpuser = ""; # username retrieved from lprng or lpd commandline
my $lphost = ""; # hostname retrieved from lprng or lpd commandline
my $client = " "; # the client name
my $subject = " "; # the message subject
my @emaillines; # stores the documentlines containing EMAILDOC
my @clienthost; # stores the temporary sender hostname
my @clientline; # stores the client name line
my @subjectline; # stores the subject line
#Check for arguments - if none, cups is initialising
if (@ARGV == 0) {
exit 0;
}
# check some dependencies
if ( ! -d $TMPDIR ) {
print("Error: temporary directory not found: ", $TMPDIR );
exit 1;
}
if ( ! -e $SENDFAX ) {
Log("Error: sendfax command not found: ", $SENDFAX );
exit 1;
}
if ( ! -e $PS2ASCII ) {
Log("Error: ghostscript command not found: ", $PS2ASCII );
exit 1;
}
# get usefull parameters
my $cupsfile = $ARGV[5]; # CUPS parses a filename with the printdata as the 6th parameer
# this could be undef (after lpr -d blah) or a filename (after a samba action)
my $cupsuser = $ARGV[1]; # CUPS paresed the username with the printdata as the 2nd parameter
# this is usually a user from localhost
GetOptions( 'h=s' => \$lphost, # LPD and LPRng parse host and user name under the -h and -n parameter
'n=s' => \$lpuser); # the postscript is parsed to it in a pipe - to be found in STDIN
my $fullhost = $ARGV[4]; #hostname is found here because in smb.conf I've added -P %m on print command
# let's extract the hostname in order to be added to email address
@clienthost = split(/\s+/,$fullhost);print $clienthost[0];
my $finalhost = $clienthost[0];
# ok lets find out where we can send the mail to
if ( ( $lphost ) and ( $lpuser ) ) { #if the user and host can be found on the commandline
$mailaddress = $lpuser . '@' . $lphost ;
} elsif ( $cupsuser) {
$mailaddress = $cupsuser . '@' . $finalhost ; # create "email" from user+hostname
} else {
$mailaddress = $MAILADDRESS; # or use the E-m@il defined in doc
}
# where is the printerdata?
if ( ( $cupsfile ) and ( -e $cupsfile ) ) {
$PSFILE = $cupsfile;
} else {
&SavePostscriptdata;
}
if ($DEBUG) {
Log("");
Log("------------------------------------------");
Log("");
}
# ok we have a postscriptfile, now
if ( &RetrieveRawFaxline ) { # we found one ore more lines
if ( &ExtractFaxnumber ) { # we could extract a real faxnumber
$client = &GetClientFromDoc; # get the Client Id
$subject = &GetSubjectFromDoc; # Get the Subject
if ($EMAILFROMDOC) {
$mailaddress = &GetEmailFromDoc; # Get the email from doc
}
if ($DEBUG) {
Log("Debug: email address = ",$mailaddress);
Log("Debug: postscript file = ",$PSFILE);
Log("Debug: cups file = ",$cupsfile);
}
&TrySending; # mask the header and send the fax
} else { # no real faxnumber could be extracted
&SendErrorMail;
Log("No Fax Number extracted");
}
} else { # no lines with faxnr found
&SendErrorMail;
Log("No Fax-Nr found");
}
# delete the temporary printfiles in case DEBUG is off
if (!$DEBUG) {
unlink $PSFILE;
unlink $PSTMPFILE;
unlink $PSTMPFILE . ".pdf";
unlink $PSTMPFILE . "clean.pdf";
}
Log("End of task");
# always exit gracefully.
exit 0;
# sub #################################################
# save the information in the pipe to the ps tmp file
sub SavePostscriptdata {
Log("sub SavePostscriptData");
open PS, ">".$PSFILE or die("Sorry, cannot open temporary postscript file $PSFILE .\n");
while (
print PS $_ ;
}
close PS;
}
# sub #################################################
sub RetrieveRawFaxline {
my $CL = $PS2ASCII . " " . $PSFILE . " |";
my $ret = 0;
open CL, $CL; # carry out ps2ascii on the ps-file and return the output into perl
while (my $line=
chomp $line;
if ($line =~ /$FAXID/i) { # if the rawline matches with fax-nr
push @faxlines, $line ; # add it to the stack of matching lines
$ret++;
}
if ($line =~ /$FAXIDS/i) { # if the rawline matches with fax-nrs
$MultiFax = 1; # the userties to multifax
}
if ($line =~ /$CLIENTID/i) { # if the rawline matches with clientid
push @clientline, $line ; # add it to the stack of matching lines
if ($DEBUG) {
Log("Debug: clientline added - ",$line);
}
}
if ($line =~ /$SUBJECTID/i) { # if the rawline matches with subjectid
push @subjectline, $line ; # add it to the stack of matching lines
if ($DEBUG) {
Log("Debug: subjectline added - ",$line);
}
}
if ($line =~ /$EMAILDOC/i) { # if the rawline matches with "email"
push @emaillines, $line; # add it to the emailstack
if ($DEBUG) {
Log("Debug: emailline added - ",$line);
}
}
}
close CL;
# check the multifax setting
$MultiFax = $ALLOWMULTIFAX if $MultiFax; # ALLOWMULTIFAX overrides Multifax
return $ret;
}
# sub #################################################
sub ExtractFaxnumber {
my $ret = 0; # return value: 0=nothing found, more=ok
if ( $MultiFax ) { # extract all the faxnumbers you can find
for ( my $i=0; $i<@faxlines; $i++) { # for all the rawline push @faxdest, &GetFaxNumbersFrom($faxlines[$i]); #extract the numbers } $ret = @faxdest; } else { # just extract the first faxnumber in the first line my @fns = &GetFaxNumbersFrom($faxlines[0]); # extract the numbers from the first raw line if ( defined $fns[0] ) { # if it exists push @faxdest, $fns[0]; # put it on the return stack $ret++; } } return $ret; } # sub ################################################# sub GetFaxNumbersFrom { my @ret = (); my $rawline = shift; if ( defined $rawline ) { my $ModemRejects = "[^" . $MODEMLIKES . "]"; # regexp with non-modem chars if ( $rawline =~ /$FAXIDS/i ) { #line contains fax-nrs $rawline =~ s/$FAXID/;/gi ; # substitute all the Fax-Nr with an ; my @fnrs = split(/;/, $rawline); # split the line up between non-allowed digits for ( my $i=0; $i<@fnrs; $i++) { # for all the splitups my $f = $fnrs[$i]; my $goodpart = '([' . $DIGITS . ']*)[^' . $DIGITS . ']*.*$'; $f =~ s/$goodpart/$1/ ; # keep the goodpart $f =~ s/$ModemRejects//g; # remove all the non-modem characters if ( $f gt "" ) { # and if anything is left push @ret, $f; # add it to the return stack } } } else { # if we find a faxnr, take special care my $re = '^.*' . $FAXID; # search for fax-nr $re .= "("; $re .= "[" . $DIGITS . "]*"; # followed by allowed digits $re .= ")"; $re .= "[^" . $DIGITS . ']*.*$'; # followed by non-allowed digits $rawline =~ s/$re/$1/i ; # and extract the allowed part from it $rawline =~ s/$ModemRejects//g; # then remove all the non-modem characters if ( $rawline gt "" ) { # and if anything is left push @ret, $rawline; # add it to the return stack } } } return @ret; } # sub ################################################# sub GetEmailFromDoc { my $result = $mailaddress; # the default return is the existing mailaddress if (@emaillines > 0) { # if there are any emailsadresses found
# take the 1st found only, ignore the rest
# anything after the : is the emailaddress
#(undef, my $em) = split(/$EMAILDOC/, $emaillines[0]);
(undef, my $em1) = split(/$EMAILDOC/, $emaillines[0]);
#Log("pre space em1=",$em1);
# remove trailing and leading spaces
$em1 =~ s/^\s+//, $em1 =~ s/\s+$//;
# $em1 =~ s/^\s*(\S*)\s*$/$1/;
if ($DEBUG) {
Log("Debug: post space strip em1=",$em1);
}
# Log(" second split of em1=",$em1);
(my $em, my $em2) = split(/~/,$em1);
if ($DEBUG) {
Log("Debug: final em = ",$em);
}
# if there is a @ in the middle consider the email address valid
if ($em =~ /\w+@\w+/) {
$result = $em;
}
}
return $result;
}
# sub #################################################
sub GetClientFromDoc {
my $result = $client; # the default return is the existing client name
if (@clientline > 0) { # if there are any client lines found
# take the 1st found only, ignore the rest
# anything after the : is the clientname
#(undef, my $em) = split(/$EMAILDOC/, $emaillines[0]);
(undef, my $cl1) = split(/$CLIENTID/, $clientline[0]);
#Log("pre space cl1=",$cl1);
# remove trailing and leading spaces
$cl1 =~ s/^\s+//, $cl1 =~ s/\s+$//;
# $cl1 =~ s/^\s*(\S*)\s*$/$1/;
if ($DEBUG) {
Log("Debug: post space strip cl1=",$cl1);
}
# The line ends at ~
(my $cl, my $cl2) = split(/~/,$cl1);
if ($DEBUG) {
Log("Debug: final cl = ",$cl);
}
$result = $cl;
}
return $result;
}
# sub #################################################
sub GetSubjectFromDoc {
my $result = $subject; # the default return is the existing subject
if (@subjectline > 0) { # if there are any subject lines found
# take the 1st found only, ignore the rest
# anything after the : is the subject
(undef, my $su1) = split(/$SUBJECTID/, $subjectline[0]);
#Log("pre space su1=",$su1);
# remove trailing and leading spaces.
$su1 =~ s/^\s+//, $su1 =~ s/\s+$//;
# $su1 =~ s/^\s*(\S*)\s*$/$1/;
if ($DEBUG) {
Log("Debug: post space strip su1=",$su1);
}
# The line ends at ~
(my $su, my $su2) = split(/~/,$su1);
if ($DEBUG) {
Log("Debug: final su = ",$su);
}
$result = $su;
}
return $result;
}
# sub #################################################
sub TrySending {
for ( my $i=0; $i<@faxdest; $i++ ) { # for every found faxnumber # compile a commandline # check if file exists if (-e $PSFILE) { my $fcp = "cp " . $PSFILE . " " . $PSTMPFILE; system $fcp; } # transform to pdf, my $pspdf = $PS2PDF . " " . $PSTMPFILE . " " . $PSTMPFILE . ".pdf"; system $pspdf; # execute if ($DEBUG) { # and log it Log($pspdf); } # apply mask, my $wmark = $PDFTK . " " . $WATERMARK . " background " . $PSTMPFILE . ".pdf output " . $PSTMPFILE . "clean.pdf"; system $wmark; #execute if ($DEBUG) { # and log it Log($wmark); } # transform back to ps my $pdfps = $PDF2PS . " " . $PSTMPFILE . "clean.pdf " . $PSFILE; system $pdfps; # execute if ($DEBUG) { # and log it Log($pdfps); } # now send the fax my $fc = $SENDFAX . " -n -R -f " . $mailaddress . " -i \"" . $subject . "\" -d \"" . $client . "@" . $faxdest[$i] . "\" " . $PSFILE ; # my $fc = $SENDFAX . " -n -D -f " . $mailaddress . " -d " . $faxdest[$i] . " " . $PSFILE ; system $fc; # execute it if ($DEBUG) { # and log it Log($fc); } } } # sub ################################################# sub SendErrorMail { my $mh = "\n"; $mh .= "The faxnumber is not recognized in your fax of " . localtime() . "\n"; $mh .= "\n"; $mh .= "The faxnumber is recognised via this text:\n"; $mh .= " Fax-Nr :
$mh .= "\n";
if ( $ALLOWMULTIFAX ) {
$mh .= " or\n";
$mh .= " Fax-Nrs :
$mh .= "\n";
}
$mh .= "The 'Fax-Nr' part is not case sensitive.\n";
$mh .= "The characters allowed in the
$mh .= "\n";
$mh .= "Please correct and retry.\n";
sendmail( To => $mailaddress ,
From => 'Your hylafax gateway
Subject => 'Your facsimile request failed.',
Message => $mh
);
Log("sent errormail to $mailaddress");
}
# sub #################################################
sub Log {
open LG, ">>" . $LOGFILE;
print LG join(" ", @_), "\n";
close LG;
}
No comments:
Post a Comment