#!/usr/bin/perl
###########################################################################
#
# (C)1998 GorskiSoft http://www.gorskisoft.com/
#
# mailer.pl - send MIME file attachments via SMTP
#
#
# revisions
#
# 10-Feb-1998   dgorski         Initial coding. Got UNIX to work fine.
#                               now to move on to Win32 (yuk)
# 25-Feb-1998   dgorski         Can't get system() to work with LIST under
#                               Win32, only likes a scalar arg list. Not
#                               sure if this is a perl32 limit, or Win32
#				Also seem to hit DOS' 127 byte command line
#				limit when calling blat. What to do...
# 11-Mar-1998	dgorski		fix bug in message body processing
#
###########################################################################
#
# Global Variables

# path to sendmail (or BLAT for Windows)
$sendmail = "/usr/lib/sendmail";
#$sendmail = "c:/blat/blat.exe";

# below is only required if running under Windows
$tempfile = "c:/test/$$.out";

###########################################################################
#
# Subroutines

sub determine_OS {
	my $OS;
	if ( open(NULL,">/dev/null") ) {
		$OS = 'unix';
	}
	if ( open(NULL,">c:/nul") ) {
		$OS = 'win';
	}
	$OS = 'unix' unless $OS;
	return($OS);
}

sub encode64 {

# BASE64 encoding routine. If you use this routine please give some credit.
# It took me a long time to get right. - Darrin <darrin@gorski.net>

	local($len) = length($_[0]);		# store length for padding
	if ( $len > 45 ) {			# encode 45 at a time
		local($x) = $_[0];
		$x =~ s/(.{1,45})/&encode64($1,$_[1])/ges;
		return($x);			# return encoded data
	} else {
		$_ = pack('u',$_[0]);		# uuencode the data
		chop;				# remove the resultant newline
		s/^.//;				# remove the length byte
		tr/` -_/AA-Za-z0-9\+\//;	# convert to base64
		$pad = ( 3 - $len % 3) % 3;	# calculate padding
		if ($pad) {			# apply padding, if needed
			substr($_,length($_)-$pad,$pad) = '=' x $pad;
		}
		return("$_$_[1]");		# return encoded data
	}
}

sub boundary {
	$t = time;
	srand($t|$$);
	$r = int(rand($t * length($t))) * 7;
	srand($r);
	$s = int(rand($t * length($t))) * 7;
	return("$t\%$r\%$s\%$$");
}

sub send_files {
	my ($To, $From, $Subject, $body, @files) = @_;
	my $boundary = &boundary;

	if ($OS eq 'win') {
		open(SENDMAIL, ">$tempfile") ||
			die "Can\'t open $tempfile for write: $!\n";
		binmode(SENDMAIL);
	} else {
		open(SENDMAIL, "|$sendmail -t") ||
			die "Can\'t open $sendmail: $!\n";
		print SENDMAIL "To: $To\r\n";
		print SENDMAIL "From: $From\r\n";
		print SENDMAIL "Subject: $Subject\r\n";
	}
	my $select = select(SENDMAIL);

	print "MIME-Version: 1.0\r\n";
	print "Content-type: Multipart/Mixed; boundary=\"$boundary\"\r\n\r\n";
	print "--$boundary\r\n";
	print "Content-type: text/plain\r\n";
	print "\r\n$body\r\n--$boundary";

	my ($buf, $ext, $stub);
	foreach (@files) {
                if(!open(FILE, "<$_")) {
                        warn "Can\'t open $_: $!\n";
                        next;
                }
                binmode(FILE);
		print "\r\nContent-type: ";
		if ($MIME_types{$ext}) {
			print "$MIME_types{$ext}";
		} else {
			print "Application/octet-stream";
		}
		($stub) = (/([^\/\\]+)$/);
                print "; name=\"$stub\"\r\n";
		print "Content-transfer-encoding: BASE64\r\n\r\n";
		while (read(FILE, $buf, 540)) {
			print &encode64($buf, "\r\n");
		}
		print "--$boundary";
	}
	print "--\r\n";
	select($select);
	close(SENDMAIL);
	if ($OS eq 'win') {
                $sendmail =~ s/\//\\/g;
                $tempfile =~ s/\//\\/g;
                my $args = "-t $To -s \"$Subject\" -f $From -penguin";# -q";
                system("$sendmail $tempfile $args");
                unlink($tempfile);
	}
}

sub parse_arguments {

        my ($to, $From, $Subject, $body, @files, @hold);

        while ($_=shift(@ARGV)) {
                if (/^-h/) {
                        &usage;
                } elsif (/^-t/) {
                        $To = shift(@ARGV);
                } elsif (/^-f/) {
                        $From = shift(@ARGV);
                } elsif (/^-s/) {
                        $Subject = shift(@ARGV);
                } elsif (/^-b/) {
                        $body = shift(@ARGV);
                        open(BODY, "$body") ||
                                die "Can\'t open message body $body: $!\n";
                        @hold = <BODY>;
                        foreach (@hold) { s/\r?\n?$//; }
                        close(BODY);
                        $body = join("\r\n", @hold);
                } else {
                        push(@files,$_);
                }
        }
        die "Recipient required. Try $0 -h\n" unless $To;
        die "Sender required. Try $0 -h\n" unless $From && ($OS = 'win');
        $Subject = 'Files' unless $Subject;
        die "No files!\n" unless @files;
        warn "No body being sent.\n" unless $body;
        return($To, $From, $Subject, $body, @files);
}

sub usage {
	print "\nUsage:\n\n";
	print "$0 -f <sender> -t <recipient> [-s \"<subject>\"] [-b <bodyfile>] files...\n\n";
	print "\t-f <sender>\n";
	print "\t-t <recipient>\n";
	print "\t-s \"<subject>\"\n";
	print "\t-b <bodyfile>\n\n";
	print "\t-h will get you this help message.\n\n";
	exit;
}

##
# main()

$OS = &determine_OS;

&send_files(&parse_arguments);
__END__