Re: email to fax
>>>>> "Brian" == Brian May <bam@debian.org> writes:
Brian> Sorry, it is ages since I last looked at this (it worked
Brian> last time I checked!):
Sorry, I somehow missed the attachment (perhaps gnus is
still buggy :-( here). Sending as plain text:
#!/usr/bin/perl -w
use strict;
use MIME::Parser;
use POSIX;
# (C)opyright 2000 Brian May <bam@snoopy.apana.org.au>.
# May be freely distributed and modified provided copyright stays intact.
# Requires:
# MIME-tools-4.124
# Mail-tools-1.13
# IO-stringy-1.207
# in addition to packages provided with Perl, Debian Potato.
# these can be found at CPAN sites.
my $tmpdir = POSIX::tmpnam();
mkdir($tmpdir,0700) or die "Cannot create $tmpdir";
END {
system("rm","-rf",$tmpdir);
}
# Parse command line parameters
my $phone = shift;
die "No phone number given" if (!defined($phone));
my $parser = new MIME::Parser;
$parser->output_dir($tmpdir);
my $entity = $parser->read(\*STDIN) or die "couldn't parse MIME stream";
my $head = $entity->head;
my $subject = $head->get('Subject',0); chomp($subject);
error("Invalid Password") if ($subject ne "obvious");
process($entity);
process_all();
exit 0;
my @files = ();
my $level =0;
sub process($) {
my $entity = shift;
$level++;
if ($entity->effective_type eq "multipart/mixed") {
process_multipart_mixed($entity);
} elsif ($entity->effective_type eq "text/plain") {
process_part($entity);
} else { error("Unknown MIME type: ".$entity->effective_type); }
$level--;
}
sub process_multipart_mixed() {
my $entity = shift;
my $num_parts = $entity->parts;
for (my $i=0; $i<$num_parts; $i++) {
my $part = $entity->parts($i);
process($part);
}
}
sub process_part() {
my $entity = shift;
my $body = $entity->bodyhandle();
if (!defined($body->path)) {
error("file not written to disk");
} else {
push @files,$body->path;
}
}
sub process_all() {
if (open(PIPE, "-|")) {
my $oldsep = $/;
undef($/);
my $msg = <PIPE>;
$/ = $oldsep;
close(PIPE);
if ($? != 0) {
my $exit_value = $? >> 8;
my $signal_num = $? & 127;
my $dumped_core = $? & 128;
error("system faxspool $phone failed: exit=$exit_value, ".
"signal=$signal_num, core=$dumped_core\n\n$msg");
}
else {
success("Output from faxspool:\n\n$msg");
}
}
else {
my $rc = open(STDERR, ">&STDOUT");
if (!$rc) {
print("Can't dup stdout");
die("Can't dup stdout");
}
exec("faxspool","-F","postmaster",$phone,@files);
}
}
sub error() {
my $error = shift;
my $message =
"Sorry - your fax could not be sent as the following error occured:\n".
"\n".
"$error\n".
"\n";
sendmail("Sending fax to $phone failed",$message);
exit(0);
}
sub success() {
my $error = shift;
my $message =
"Your fax has been spooled and should be sent shortly.\n".
"\n".
"$error\n".
"\n";
sendmail("Fax spooled for $phone",$message);
exit(0);
}
sub sendmail() {
my $subject =shift;
my $message =shift;
local $SIG{PIPE} = sub { die "Pipe to sendmail broke" };
open(PIPE,"| formail -rkb -I'Subject: $subject' | /usr/sbin/sendmail -t")
or die "Cannot open pipe to send mail: $!\n";
print(PIPE $head->as_string) or die "Cannot print message to pipe: $!\n";
print(PIPE "\n") or die "Cannot print message to pipe: $!\n";
print(PIPE $message) or die "Cannot print message to pipe: $!\n";
close(PIPE) or die "Cannot close pipe to send mail: $!\n";
exit(0);
}
--
Brian May <bam@debian.org>
Reply to: