Skip to content

Instantly share code, notes, and snippets.

@jonmagic
Created September 10, 2009 16:24
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save jonmagic/184641 to your computer and use it in GitHub Desktop.
Save jonmagic/184641 to your computer and use it in GitHub Desktop.
#!/usr/bin/perl -w
# Small program to process a tiff file into a PDF and email it.
#
# Distributed under the terms of the GNU General Public License (GPL) Version 2
# Copyright 2005 by Rob Thomas (xrobau@gmail.com)
use MIME::Base64;
use Net::SMTP;
# Default paramaters
my $to = "xrobau\@gmail.com";
my $from = "fax\@";
my $subject = "Fax received";
my $ct = "application/x-pdf";
my $file = undef;
my $attachment = undef;
# Care about the hostname.
my $hostname = `/bin/hostname`;
chomp ($hostname);
if ($hostname =~ /localhost/) {
$hostname = "set.your.hostname.com";
}
$from .= $hostname;
# Usage:
my $usage="Usage: --file filename [--attachment filename] [--to email_address] [--from email_address] [--type content/type] [--subject \"Subject Of Email\"]";
# Parse command line..
while (my $cmd = shift @ARGV) {
chomp $cmd;
# My kingdom for a 'switch'
if ($cmd eq "--to") {
my $tmp = shift @ARGV;
$to = $tmp if (defined $tmp);
} elsif ($cmd eq "--subject") {
my $tmp = shift @ARGV;
if ($tmp =~ /\^(\")|^(\')/) {
# It's a quoted string
my $delim = $+; # $+ is 'last match', which is ' or "
$tmp =~ s/\Q$delim\E//; # Strip out ' or "
$subject = $tmp;
while ($tmp = shift @ARGV) {
if ($tmp =~ /\Q$delim\E/) {
$tmp =~ s/\Q$delim\E//;
last;
}
$subject .= $tmp;
}
} else {
# It's a single word
$subject = $tmp;
}
# Convert %2x to proper characters, leave anything else alone.
$subject =~ s/\%20/ /g;
$subject =~ s/\%21/\!/g;
$subject =~ s/\%22/\"/g;
$subject =~ s/\%23/\#/g;
$subject =~ s/\%24/\$/g;
$subject =~ s/\%25/\%/g;
$subject =~ s/\%26/\&/g;
$subject =~ s/\%27/\'/g;
$subject =~ s/\%28/\(/g;
$subject =~ s/\%29/\)/g;
$subject =~ s/\%2a/\*/g;
$subject =~ s/\%2A/\*/g;
$subject =~ s/\%2b/\+/g;
$subject =~ s/\%2B/\+/g;
$subject =~ s/\%2c/\,/g;
$subject =~ s/\%2C/\,/g;
$subject =~ s/\%2d/\-/g;
$subject =~ s/\%2D/\-/g;
$subject =~ s/\%2e/\./g;
$subject =~ s/\%2E/\./g;
$subject =~ s/\%2f/\//g;
$subject =~ s/\%2F/\//g;
} elsif ($cmd eq "--type") {
my $tmp = shift @ARGV;
$ct = $tmp if (defined $tmp);
} elsif ($cmd eq "--from") {
my $tmp = shift @ARGV;
$from = $tmp if (defined $tmp);
} elsif ($cmd eq "--file") {
my $tmp = shift @ARGV;
$file = $tmp if (defined $tmp);
} elsif ($cmd eq "--attachment") {
my $tmp = shift @ARGV;
$attachment = $tmp if (defined $tmp);
} else {
die "$cmd not understood\n$usage\n";
}
}
# OK. All our variables are set up.
# Lets make sure that we know about a file...
die $usage unless $file;
# and that the file exists...
open( FILE, $file ) or die "Error opening $file: $!";
# Oh, did we possibly not specify an attachment name?
$attachment = $file unless ($attachment);
my $encoded="";
my $buf="";
# First, lets find out if it's a TIFF file
read(FILE, $buf, 4);
if ($buf eq "MM\x00\x2a" || $buf eq "II\x2a\x00") {
# Tiff magic - We need to convert it to pdf first
# Need to do some error testing here - what happens if tiff2pdf
# doesn't exist?
open PDF, "tiff2pdf $file|";
$buf = "";
while (read(PDF, $buf, 60*57)) {
$encoded .= encode_base64($buf);
}
close PDF;
} else {
# It's a PDF already
# Go back to the start of the file, and start again
seek(FILE, 0, 0);
while (read(FILE, $buf, 60*57)) {
$encoded .= encode_base64($buf);
}
}
close FILE;
# Now we have the file, we should ensure that there's no paths on the
# filename..
$attachment =~ s/^.+\///;
# And that's pretty much all the hard work done. Now we just create the
# headers for the MIME encapsulation:
my $boundary = '------FREEPBX_FAX_MAIL:';
my $dtime = `date -R`;
chomp $dtime;
my @chrs = ('0' .. '9', 'A' .. 'Z', 'a' .. 'z');
foreach (0..16) { $boundary .= $chrs[rand (scalar @chrs)]; }
my $len = length $encoded;
# message body..
my $msg ="Content-Class: urn:content-classes:message
Content-Transfer-Encoding: 7bit
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary=\"$boundary\"
From: $from
Date: $dtime
Reply-To: $from
X-Mailer: dofaxmail.pl
To: $to
Subject: $subject
This is a multi-part message in MIME format.
--$boundary
Content-Type: text/plain; charset=\"us-ascii\"
Content-Transfer-Encoding: quoted-printable
A Fax has been recieved by the fax gateway, and is attached to this message.
--$boundary
Content-Type: $ct; name=\"$attachment\"
Content-Transfer-Encoding: base64
Content-Disposition: attachment; filename=\"$attachment\"
$encoded
--$boundary--
";
#print "$msg";
# Now we just send it.
my $smtp = Net::SMTP-> new("127.0.0.1", Debug => 0) or
die "Net::SMTP::new: $!";
$smtp-> mail($from);
$smtp-> recipient($to);
$smtp-> data();
$smtp-> datasend($msg);
$smtp-> dataend();
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment