1#!/usr/bin/perl -w 2# 3# mail2fax glue logic - read mail from stdin, extract phone number 4# from e-mail address (12345@fax), call faxspool 5# to be run from sendmail, qmail, ... 6# 7# $Id: mail2fax.pl,v 1.4 2007/04/05 08:45:58 gert Exp $ 8# 9# $Log: mail2fax.pl,v $ 10# Revision 1.4 2007/04/05 08:45:58 gert 11# skip empty text/plain MIME parts 12# 13# Revision 1.3 2006/10/19 10:29:56 gert 14# path change: use /usr/bin/perl 15# bugfix: if "-f" isn't specified, don't pass empty "-f" to faxspool 16# 17# Revision 1.2 2006/09/26 14:29:05 gert 18# skip parts that are .p7s or application/x-pkcs7-signature 19# 20# Revision 1.1 2006/09/22 22:02:18 gert 21# initial draft 22# 23# 24use strict; 25use Getopt::Std; 26use File::Temp qw/ tempfile tempdir /; 27use MIME::Parser; 28 29# configuration section 30my $logfile = "/var/log/mgetty/mail2fax.log"; 31my $workdir = "/var/spool/fax/tmp"; 32my $faxspool = "/usr/local/bin/faxspool"; 33 34# get arguments 35# calling convention from sendmail is: A=mail2fax -h $h -f $f $u 36 37use vars qw /$opt_f $opt_h $opt_d $opt_v/; 38$opt_h = ''; # fax relay host (currently unused) 39$opt_f = ''; # sender's e-mail address (envelope-from) 40$opt_d = 0; # debug 41$opt_v = 0; # verbose output 42 43unless( getopts('f:h:dv') ) 44{ 45 print STDERR "ERROR: invalid option\n"; 46 exit 64; # EX_USAGE 47} 48if ( $#ARGV != 0 ) # exactly one argument needed 49{ 50 print STDERR "ERROR: call syntax: exactly one argument (faxnr) needed\n"; 51 exit 64; # EX_USAGE 52} 53 54my $fax_to = shift @ARGV; 55$fax_to =~ s/@.*$//; 56 57if ( $fax_to !~ /^\d+$/ ) 58{ 59 print STDERR "ERROR: invalid character found in fax number: only digits 0-9 allowed\n"; 60 exit 64; # EX_USAGE 61} 62 63unless( open LOG, ">>$logfile" ) 64{ 65 print STDERR "ERROR: can't open logfile '$logfile': $!\n"; 66 exit 73; # EX_CANTCREAT 67} 68 69unless( chdir($workdir) && -w '.' ) 70{ 71 print STDERR "ERROR: workdir '$workdir' does not exist or is not writeable\n"; 72 exit 73; 73} 74&logmsg( "--- from=$opt_f, to=$fax_to" ); 75 76# create temporary directory for input files, below workdir 77my $dir = tempdir( DIR => '.', CLEANUP => 1 ); 78 79unless( defined $dir && -d $dir && -w $dir ) 80 { print STDERR "ERROR: can't create tempdir: $!\n"; exit 73; } 81 82&logmsg( "dir=$dir" ); 83 84# now parse mail on stdin... 85my $parser = new MIME::Parser; 86$parser->output_dir($dir); 87 88my $entity = $parser->parse(\*STDIN); 89 90# flatten 0- or 1-part multipart into singlepart structure 91$entity->make_singlepart; 92 93# dump structure to log file 94$entity->dump_skeleton(\*LOG); 95 96# we could/should do authentication here (sender / from: / ... vs. fax number) 97# **TODO**! 98 99# generate command line for faxspool 100my @pages = (); 101 102my @parts = $entity->parts_DFS; 103foreach my $part (@parts) 104{ 105my $type = $part->effective_type; 106 107 print LOG "part: effective_type=$type\n"; 108 print LOG "part: is_multipart=TRUE\n" if( $part->is_multipart); 109 if ( defined( $part->bodyhandle ) ) 110 { 111 my $path = $part->bodyhandle->path; 112 print LOG "part: pathname=$path\n"; 113 114 # everything that has a file name (- is not metadata) and doesn't 115 # match an exclude list of unconvertable content is passed to faxspool 116 117 if ( $type eq 'text/html' || $path =~ /\.html?$/ || 118 $type eq 'application/x-pkcs7-signature' || $path =~ /\.p7s/ 119 ) 120 { 121 print LOG "-> skip part, unconvertable body\n"; 122 next; 123 } 124 125 # some e-mail clients produce empty text/plain parts when sending 126 # "just attachment" mails (e.g. sending a PDF) -> skip these 127 if ( $type eq 'text/plain' && -z $path ) 128 { 129 print LOG "-> skip part, empty file $path\n"; 130 next; 131 } 132 133 push @pages, $path; 134 } 135} 136 137# we're called from sendmail as uid=root, euid=fax -> make this uid=fax 138$<=$>; 139 140my $cmd="$faxspool"; 141 142$cmd .= " -f $opt_f" if ( $opt_f ne '' ); 143$cmd .= " $fax_to \"". join('" "', @pages) . "\" 2>&1"; 144 145&logmsg( "$cmd" ); 146 147my $out=`$cmd`; 148my $rc = $?; 149print LOG $out; 150&logmsg( "faxspool return code=$rc" ); 151 152close LOG; 153 154if ( $rc == 0 ) { exit 0; } 155 else { print STDERR $out; exit 65; } # EX_DATAERR 156 157# 158# ------------------------------------------------------------------------- 159# 160sub logmsg 161{ 162 print LOG localtime() .' '. join( ' ', @_ ) ."\n"; 163} 164