#!/usr/bin/perl use utf8; use Encode; use MIME::Words; use MIME::Parser; #use Data::Dumper; use strict; # These are for faxmiil compatibility my %FAXMAIL_ARGS = ( '-s' => 'shift @ARGV;', '-p' => 'shift @ARGV;', '-W' => 'shift @ARGV;', '-n' => '', '-d' => '', ); my @FORMAT_HEADERS = qw(From Subject To Date Message-ID); my %ALTERNATIVE_WEIGHTS = ( 'text/plain' => 100, 'multipart/related' => 10, 'text/html' => 1000, ); my $TMPDIR = "/tmp/mail-$$"; my $TMPDIR = "/tmp/mail-aidan"; system('rm', '-Rf', $TMPDIR); my $FAX = { formattext => "$TMPDIR/format.txt.UTF-8", attachments => [] }; #$FAX->{formattext} = "format.txt"; #unlink "format.txt"; my @SENDFAX_ARGS = qw(-n); sub body_path { return 'internal' unless $1->bodyhandle; return $1->bodyhandle->path; } sub decode_header { my $input = shift; chomp $input; my $output = decode('UTF-8', ''); foreach my $w (MIME::Words::decode_mimewords($input)) { printf STDERR " `-> %s[%s]\n", $w->[0], $w->[1]; $output .= decode($w->[1]||'US-ASCII', $w->[0]); } return $output } sub handle_all { my $fax = shift; print STDERR "HANDLE ALL\n"; my $old_prefix = $fax->{prefix}; $fax->{prefix} = ' ' . $old_prefix; foreach my $p (@_) { printf STDERR "%s`-> %s [%s]\n", $old_prefix, $p->effective_type, ($p->bodyhandle ? $p->bodyhandle->path : 'internal'); if ($p->effective_type eq 'multipart/mixed') { handle_all($fax, $p->parts); } elsif ($p->effective_type eq 'multipart/alternative') { handle_alternative($fax, $p->parts); # handle_all($fax, $p->parts); } elsif ($p->effective_type eq 'text/plain') { handle_text($fax, $p); } elsif ($p->effective_type eq 'message/rfc822') { handle_message($fax, $p); } elsif ($p->is_multipart) { handle_all($fax, $p->parts); } else { handle_part($fax, $p); } } $fax->{prefix} = $old_prefix; } sub handle_part { my ($fax, $entity) = @_; add_docs($fax, $entity->bodyhandle->path); } sub handle_message { my ($fax,$entity) = @_; print STDERR "HANDLE MESSAGE\n"; open FORMAT, ">>:utf8", $fax->{formattext}; FORMAT->autoflush(1); for my $h (@FORMAT_HEADERS) { #Headers are \n terminated my $value = decode_header($entity->head->get($h)); printf FORMAT "%s: %s\n", $h, $value; printf STDOUT "%s: %s\n", $h, $value; } printf FORMAT "\n"; close FORMAT; if ($entity->is_multipart) { handle_all($fax, $entity->parts); } else { handle_all($fax, $entity); } } sub handle_text { my ($fax, $entity) = @_; printf STDERR "HANDLE TEXT: %s\n", $entity->bodyhandle->path; printf STDERR " `-> TYPE %s\n", $entity->head->mime_type; printf STDERR " `-> ENCODING %s\n", $entity->head->mime_encoding; printf STDERR " `-> CHARSET %s\n", $entity->head->mime_attr('content-type.charset'); my $charset = $entity->head->mime_attr('content-type.charset') || 'us-ascii'; my $body = $entity->bodyhandle; my $IO = $body->open("r") || die "Couldn't open: $!"; if ($fax->{formattext}) { open FORMAT, ">>:utf8", $fax->{formattext}; } else { open FORMAT, ">>:utf8", $body->path . ".UTF-8"; add_docs($fax, $body->path . "UTF-8"); } open RAW1 , ">:utf8", $body->path . ".raw1"; open RAW2 , "> ". $body->path . ".raw2"; FORMAT->autoflush(1); RAW1->autoflush(1); RAW2->autoflush(1); while (defined($_ = $IO->getline)) { my $output = decode($charset, $_); printf STDERR "[%s:%s]%s", (utf8::is_utf8($output) ? "UTF8" : "DATA"), (utf8::valid($output) ? "VALID" : "INVLD"), $_; print FORMAT $output; print RAW1 $output; print RAW2 $output; } $IO->close; close FORMAT; close RAW1; close RAW2; } sub handle_alternative { my $fax = shift; print STDERR "HANDLE ALTERNATIVE\n"; sub by_alternative { $ALTERNATIVE_WEIGHTS{$b->effective_type} <=> $ALTERNATIVE_WEIGHTS{$a->effective_type}; } print STDERR "CHOICE: " . join (',', map({$_->mime_type} @_)) . "\n"; my @parts = sort by_alternative (@_); printf STDERR "PICKED %s\n", $parts[0]->effective_type; handle_all($fax, $parts[0]); } sub add_docs { my $fax = shift; foreach my $file (@_) { printf "%s`-> *FILE %s\n", $fax->{prefix}, $file; push @{$fax->{attachments}}, $file; } } while ($ARGV[0] =~ m/-/) { if (defined $FAXMAIL_ARGS{$ARGV[0]}) { eval "$FAXMAIL_ARGS{$ARGV[0]}"; } else { die "Unknown argument: $ARGV[0]\n"; } shift @ARGV; } mkdir ($TMPDIR, 0700) || die "Can't create unique private directory: $!"; my $number = $ARGV[0]; my $owner = $ARGV[1]; my $parser = new MIME::Parser; $parser->decode_headers(0); $parser->extract_uuencode(1); $parser->ignore_errors(1); $parser->output_dir($TMPDIR); my $mail = $parser->parse(\*STDIN); print STDERR "===============================================\n"; $mail->dump_skeleton(\*STDERR); print STDERR "===============================================\n"; my $from = $mail->head->get('From'); chomp $from; STDOUT->autoflush(1); if ($owner) { push @SENDFAX_ARGS, "-o", $owner } handle_message($FAX, $mail); #Should we check if it's empty? unshift (@{$FAX->{attachments}}, $FAX->{formattext}); system('/usr/bin/sendfax', @SENDFAX_ARGS, '-f', $from, '-d', $number, @{$FAX->{attachments}} ); #system("/bin/rm", "-rf", $TMPDIR);