[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

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: