Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/perl -w
- # Small program to process a tiff file into a PDF and email it via gmail.
- #
- # Distributed under the terms of the GNU General Public License (GPL) Version 2
- # Copyright 2005 by Rob Thomas (xrobau@gmail.com)
- # Additions:
- # 2009 Sept 10: Modified to use Gmail (Daniel Parker <daniel@behindlogic.com>)
- use Net::SMTP::SSL;
- use MIME::Base64;
- # Default paramaters
- my $to = "jonny\@gmail.com";
- my $from = "fax\@";
- my $subject = "Fax received";
- my $ct = "application/x-pdf";
- my $file = undef;
- my $attachment = undef;
- our $username = 'johnny@gmail.com';
- our $password = 'MySecretGmailPassword';
- # 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: $!";
- my $smtp;
- # Create the SSL SMTP object
- unless($smtp = Net::SMTP::SSL->new('smtp.gmail.com', Port => 465, Debug => 1)) {
- die "Could not connect to server\n";
- }
- # Authenticate
- $smtp->auth($username, $password) || die "Authentication failed!\n";
- # Send the mail!
- $smtp-> mail($from);
- $smtp-> recipient($to);
- $smtp-> data();
- $smtp-> datasend($msg);
- $smtp-> dataend();
- $smtp->quit;
Add Comment
Please, Sign In to add comment