用perl寫的指令行的sendmail程序
some update :增加了一些註釋，應該容易讀懂了，重寫和移除了部分多餘的語句
OS： 在 英文win2k3 下測試通過。 原始的perl指令碼應該也可以在linux執行。
win9x 也應該沒有問題。
特點：
指令行界面，適合自動化和批次處理的工作，檔案名字以UTF8編碼傳送。
僅僅需要 指明收信者位址，自動進行dns mx 查詢smtp，不需要指明smtp的位址 ，
可以傳送目錄和文件的混合列表。
和explorer整合，修改mailall.inf中的最後一行， 寫上收信者的位址，然後滑鼠右鍵安裝，
就可以通過在explorer中在目錄上點右鍵，選項mialall，就可以傳送該目錄的所有文件了 。
用法：
mailall -t
xxx@gmail.com test目錄 aaa文件
把 test目錄 和 aaa文件 傳送到
xxx@gmail.com 中
mailall -t
xxx@gmail.com <photolist.m3u
把 文件photolist.m3u中所列出的文件和目錄傳送到
xxx@gmail.com 中 ，
每一個目錄名字和檔案名字在photolist.m3u中獨佔一行。
mailall -t
xxx@gmail.com
交互式的輸入要送到
xxx@gmail.com 中檔案名字和目錄名字
-s smtp_server
指定使用某個smtp server ，不使用DNS MX查詢
-v -d
顯示詳細的偵錯資訊
-f
mailfrom@mail.com
指名發件人的位址，預設使用sender@example.com
局限：目前不支持esmtp，因為主要對象GMAIL，而gmail的smtp不需要認證，無需輸入用戶名和密碼。
exe文件：用perlapp編譯，單獨一個程序，不需要額外的庫，所以體積比較大。
源碼：
需要active perl 5.8以上，從cpan下載MIME-Lite-2.117.tar.gz Net-DNS-0.47_01.tar.gz
程式碼:
#!/usr/bin/perl -w
# mailall- send files as attachments
use Getopt::Std;
use File::Find;
use Encode qw(decode encode_utf8);
use MIME::Base64;
#the following 2 packet from CPAN
use MIME::Lite;
use Net:
NS;
use strict;
my $SMTP_SERVER ;
my $_sender = 'sender@example.com';
my $_recipient;
my %option; #the command line options
my @Sendlist; #the files and dirs to send
my $cp; #current codepage
#get current codepage
sub getansicp{
use locale;
use POSIX qw(locale_h);
setlocale(LC_ALL,"");
my $ctype=setlocale(LC_CTYPE);
return $ctype if ($ctype !~ /\./) ;
if ($ctype=~/\.\d+$/){
$ctype =~s/.*\./cp/;
return $ctype ;
}
$ctype =~s/.*\.//;
return $ctype ;
}
# find mx exchangers for a host
sub getmxhost{
my ($host,$verbose)= @_;
my ($res, @mx);
print "finding MX records for $host\n" ;#if ($verbose);
$res = Net:
NS::Resolver->new( );
my @counter=(1,2,3,4);
foreach (@counter){
last if (@mx = mx($res, $host)) ;
die "Can't find MX records for $host (".$res->errorstring.")\n" if ($_>3);
sleep 10;
print "try find MX records for $host again \n";
}
if ( $verbose) {
foreach my $record (@mx) {
print "DNS MX ",$record->preference, " ", $record->exchange, "\n" ;
}
}
@mx=(sort {$b->preference <=>$a->preference} @mx);
return $mx[0]->exchange;
}
# Lookup table:
my %TypeFor = qw(
txt text/plain
nfo text/plain
sh text/x-sh
csh text/x-csh
pm text/x-perl
pl text/x-perl
jpg image/jpeg
jpeg image/jpeg
gif image/gif
png image/png
ppm image/ppm
bmp image/bmp
tif image/tiff
tiff image/tiff
xbm image/xbm
);
#get mime type of filename from file ext
sub type_for {
my ($path) = @_;
my ($ext) = ($path =~ /\.([a-z0-9]+)\Z/i);
($ext and $TypeFor{lc($ext)})
or 'application/octet-stream';
}
use constant HEAD => '=?UTF-8?';
use constant TAIL => '?=';
# the mime header of mail ,base64 coded
sub my_mime_encode{
my ($temp,$acp)= @_;
return HEAD . 'B?' . encode_base64(encode_utf8(Encode::decode( $acp,$temp)) , '') . TAIL;
}
#send a file to recipient
sub sendafile{
my ( $subjects,$filename)= @_;
my $mimetype;
my $msg;
my $fullname= $subjects;
$mimetype=type_for($filename);
if ($option{v} ){
MIME::Lite->send('smtp', $SMTP_SERVER, Timeout=>60,Debug => 1);
}
else{
MIME::Lite->send('smtp', $SMTP_SERVER, Timeout=>60);
}
# construct and send email
$msg = new MIME::Lite(
From => $_sender,
To => $_recipient,
Subject => my_mime_encode($subjects,$cp) ,
Type => "multipart/mixed"
);
$msg->attach(Type =>'text/plain;charset="UTF-8"',
Data => encode_utf8(Encode::decode($cp, $subjects) ));
$msg->attach('Type' => $mimetype,
'Encoding' => 'base64',
'Path' => $filename,
'Filename' => my_mime_encode($filename,$cp) ,
'Disposition' => 'attachment');
$msg->print(\*STDOUT) if ($option{d});
sleep 3;
eval {$msg->send( )} if (!$option{n});
if ($@) {
print "Error: Failed Send File $fullname \n";
print "$@\n" if ($option{v});
}
else {
print "Send File Success: $fullname \n" ;
}
}
#send a dir to recipient
sub sendadir{
if (@_) {
find(sub {
if (! -d _) {
sendafile($File::Find::name, $_) if ( -f $_) ;
}
},
@_);
}
}
#send the file and dir to recipient
sub send_dir_file{
if ( -f $_) {
sendafile( $_, $_) ;
}
elsif ( -d $_) {
sendadir(($_));
}
else {
print "Error: Not a Valid FileName $_ \n";
}
}
sub main {
print " \n\t Mailall by lyh728 Ver 1.0 --send files as attachments\n";
$cp=getansicp();
# process options
getopts("ht:f:s:l:nvd", \%option);
if ($option{h} or !$option{t}) {
die "usage:\n\t$0 [-h] [-s smtp] [-v] [-f from] [-d] -t to [file1 [dir2 ...]] \n";#[-n]
}
@Sendlist= @ARGV; # the other command parameter is file list
$_sender||= $option{f} ; # from address of mailer
$_recipient = $option{t} ;# to addrss of mailer
if ($option{s}){
$SMTP_SERVER =$option{s}; # smtp from command parameter
}
else
{
$SMTP_SERVER =$option{t};
$SMTP_SERVER =~ s/^.*@// ; # get domian of mail address
$SMTP_SERVER=getmxhost( $SMTP_SERVER,$option{v}); # mx lookup
}
print "Sender : $_sender\n";
print "Recipinent : $_recipient\n";
print "SMTP Server : $SMTP_SERVER\n";
print "To Send : @Sendlist\n" if ( @Sendlist );
foreach (@Sendlist) {
chomp;
send_dir_file($_);
}
# if no file list parameter ,then check stdin for file list
if ( ! @Sendlist ){
print "Input File and Dir name to Send .(^Z for end)\n" ;
while (<STDIN>)
{
chomp;
send_dir_file($_) if ($_);
}
}
print "\n\tFinished\n";
}
main();