>>>>> "Brian" == Brian May <[EMAIL PROTECTED]> 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 <[EMAIL PROTECTED]>. # 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 <[EMAIL PROTECTED]>