PERL写的WEBMAIL

PERL写的WEBMAIL【编辑】

#!/usr/bin/perl


use CGI;
use Mail::POP3Client;
#use MIME::Words qw(:all);
use MIME::Parser;


my $parser = new MIME::Parser;
#$parser->output_dir("/tmp");
my $output_path = "/home/www/sites/PUBLIC/private/Secretary/MAIL-MSGS";
$parser->output_under($output_path);
#$parser->output_to_core(1);


my $query = new CGI;

my $user = $query->param("user");
my $pass = $query->param("pass");
my $host = $query->param("host");
my $msgid = $query->param("msgid");


my $min_uid = "500";
my $esc_user = "root|www|sybase";

my $uid = getpwnam($user);

if (($uid<$min_uid) || ($user=~m/$esc_user/)) {
print "您的系统邮箱尚未设定\n";
exit();
}


my $pop = new Mail::POP3Client(USER=>"$user",PASSWORD=>"$pass",HOST=>"$host");

my $msg = $pop->Retrieve($msgid);

my $entity = $parser->parse_data($msg);

my $head = $entity->head();

$head->decode();

my $subject = htmlspecialchars($head->get("Subject"));
if ($subject eq "") { $subject = "（无标题）"; }

my $from = htmlspecialchars($head->get("From"));
my $to = htmlspecialchars($head->get("To"));
my $date = htmlspecialchars($head->get("Date"));

$from = makemailto($from);
$to = makemailto($to);

my $size = $pop->List($msgid);
$size =~ m/(\d+) (\d+)/;
$size = $2;
$size = int($size/1024) + 1;
$size = $size . "k";

print "

";

print "邮件标题： $subject

";

print "来自：     $from

";

print "发到：     $to

";

print "日期：     $date

";

print "字节数：   $size



";



print "邮件内容： 

";

print "----------------------------------------------------

";



my $numparts = $entity->parts;



if (!$numparts) {



#$entity->print_body();

my $body = $entity->bodyhandle();

my $content = join("", $body->as_lines);

$content = htmlspecialchars($content);

print $content;

print "----------------------------------------------------

";

$body->purge;



}

else {

my $part_ent = $entity->parts(0);

if ($part_ent->parts) {

$part_ent = $part_ent->parts(0);

}

my $body     = $part_ent->bodyhandle();

my $content  = join("", $body->as_lines);

my $path     = $body->path();

$content = htmlspecialchars($content);

print $content;

print "----------------------------------------------------



";

#$body->purge;



$path =~ s/(.*)\/.*/$1/;

opendir(DIR, $path);

my @attach = readdir(DIR);

closedir(DIR);



print "邮件附件： 请单击右键，选择另存到您的硬盘。



";



my $apath = $path;

$apath =~ s/$output_path/MAIL-MSGS/;



foreach (@attach) {

next if m/^(\.|\.\.)$/;

$i++;

my $asize = (stat("$path/$_"))[7];

$asize = int($asize/1024) + 1;

$asize = $asize . "k";

print "  附件$i：$_ ($asize)

";

}

#for ($i=1;$i<$numparts;$i++) {

#    $part_ent = $entity->parts($i);

#    $body     = $part_ent->bodyhandle();

#    $path     = $body->path();

#    $path     =~ s/$output_path/mail-msgs/;

# 

#	print "  附件$i：$path

";

#	#$body->purge;

#}



undef $part_ent;

}



print "

";


undef $entity;
undef $parser;
$pop->Close();



sub htmlspecialchars {
my($s) = @_;

my $amp = "&";
my $quot = """;
my $lt = "<";
my $gt = ">";

$s =~ s/&/$amp/g;
$s =~ s/"/$quot/g;
$s =~ s/ $s =~ s/>/$gt/g;

#$s =~ s/(\w[a-zA-Z0-9\-._]+@[a-zA-Z0-9\-._]+\w)/$1<\/a>/g;

return $s;
}

sub makemailto {
my($s) = @_;

$s =~ s/(\w[a-zA-Z0-9\-._]+@[a-zA-Z0-9\-._]+\w)/$1<\/a>/g;

return $s;
}