Friday, January 30, 2009

Sending mail with multiple attachments from Perl

It always annoys me a whole lot, when I'm writing some Unix/Linux shell script and I need to send an email with attachments - there simply isn't an easy way.

Standard mail doesn't support any attachments whatsoever, in some versions of mailx one attachment is supported and mpack is generally not available at all.

Since I found out, that some of the servers, I need to deploy my script to, don't even have uuencode installed, I decided to write myself a small standalone utility in Perl for sending multi-attachment emails.

There are lots of existing solutions in CPAN for this, but I specifically needed something, that's using only core Perl modules and sendmail - things I can count to find on every server.

#!/usr/bin/perl
use strict;
use MIME::Base64;

if ($#ARGV < 2)
{
        print(STDERR "Not enough parameters\n\n");
        print(STDERR "Usage:\n");
        print(STDERR "\t./send.pl e\@mail \"Subject\" file1 file2 ...\n");
        print(STDERR "\t./send.pl \"e\@mail,a\@ddress\" \"Subject\" file1 file2 ...\n\n");
        exit -1;
}

#Sendmail requires email addresses to be separated by comma AND space
my $to = $ARGV[0];
$to =~ s/,/, /g;

open STDOUT, "|/usr/sbin/sendmail -t";

my $boundary = "_----------=_10167391557129230";

print("Content-Transfer-Encoding: 7bit\n");
print("Content-Type: multipart/mixed; boundary=\"$boundary\"\n");
print("MIME-Version: 1.0\n");
print("Date: ".`date`);
print("To: $to\n");
print("Subject: $ARGV[1]\n\n");

for (my $i = 2; $i <= $#ARGV; $i++)
{
        my $basename = `basename $ARGV[$i]`;
        $basename =~ s/\s//g;
        print("\n--".$boundary."\n");
        print("Content-Transfer-Encoding: base64\n");
        print("Content-Type: application/octet-stream; name=\"$basename\"\n\n");

        local $/=undef;
        open FILE, $ARGV[$i] or die "Couldn't open file $ARGV[$i]";
        binmode FILE;
        my $content = <FILE>;
        close FILE;

        print encode_base64($content)."\n\n";
}

print("--$boundary\n.\n");

The code depends on two things:

  1. sendmail being available in /usr/sbin
  2. Perl core module MIME::Base64 - every standard Perl installation has this.

There is a little issue in the code - the MIME boundary is hard coded and not checked for uniqueness, but since we're using Base64 there is not much possibility of a clash.

0 comments: