WEB邮件程序

开发平台：
Perl

sendform.pl：源码内容
							#! /usr/local/bin/perl
BEGIN { $APP_PATH=$0; $APP_PATH=~s/(/*)[^/]+$/$1/g; }
# @ ----------------------------------------------------------------------------------------------------------
# @ This code is (c) 1999 Alexandre Aufrere and NikoSoft.
# @ Published under NPL rights, meaning you have the right
# @ to use and modify this code freely, provided it 
# @ remains available and free. Any modified code should be
# @ submitted to Nikopol Software Corp. or Alexandre Aufrere.
# @ This code is protected by the French laws on Copyright.
# @ Please note that there it comes with NO WARRANTY of any kind,
# @ and especially for any damagbe it could cause to your computer
# @ or network.
# @ Using this code means you agree to this license agreement.
# @ Further information at http://nikosoft.free.fr
# @ ----------------------------------------------------------------------------------------------------------
# @ 
# @ Project		NS WebMail
# @ 
# @ Filename		sendform.pl
# @ 
# @ Description	build a form for sending mail
# @ 
# @ Version		1.0
# @ 
# @ ----------------------------------------------------------------------------------------------------------
use Socket;
require $APP_PATH."config.pl";
require $APP_PATH."common.pl";
#obtain the FORM information that has been passed by using
#the param() method of the cgi object.
&ReadParse;
$loginname  = $in{'loginname'};
$password   = $in{'password'};
$POPserver  = $in{'POPserver'};
$to         = $in{'to'};
$subject    = $in{'subject'} or "";
$body       = $in{'body'} or "";
$cache      = $in{'cache'};
# Put the ">" befor the quoted body
@bodylines=split("n",$body);
$body="";
foreach (@bodylines) {
  $body.="> ".$_."n";
}
$sender = $loginname."@".$POPserver;
$addrvrfyed=$sender;
if ($verifysmtp==1) {
  $addrvrfyed=sendmailvrfy($sender,$SMTPserver);
  if ($addrvrfyed=~ m/^-[0-9]/) { $addrvrfyed=$sender; }
  
       $addrvrfyed=~s/^2.1.5 //g;    # nuke sendmail 8.10.x vrfy feature
  if (defined($masquarade) && $addrvrfyed =~ /$masquarade/) {
    $addrvrfyed=~s/@([^>^ ]+)/@$masquarade/;
  }
  $from_html=$addrvrfyed;
  $from_html =~ s/</&lt;/;
  $from_html =~ s/>/&gt;/;
}
print "Content-type: text/htmlnn";
print "<HTML><HEAD><TITLE>NSWM";
if ($cache eq "No") { print "<META HTTP-EQUIV='Pragma' CONTENT='no-cache,no-store'>"; }
print "</TITLE></HEAD>";
print "<BODY BGCOLOR='FFFFFF'>n";
#This calculation determines the width of the text entry boxes.
#The minimum length will either be 36 spaces or 20% larger than the
#largest of the three field entries which are already known.
#Note that depending on how this routine is called, not all
#of the fields are known in advance.
$width = 30;
$width = ($width>length($sender) ? $width : length($sender));
$width = ($width>length($to)     ? $width : length($to));
$width = ($width>length($subject)? $width : length($subject));
$width *= 1.2;		#fudge factor to avoid visual cramping.
print "<FORM METHOD="POST" ACTION="".$CGI_PATH_NSWM."send.pl" enctype="multipart/form-data">n";
print "<TABLE BORDER=0 BGCOLOR=$lightbgcolor><TR><TD>n";
print "";
if ($fake_from) {
	print "$fromtext: </td><td> <INPUT TYPE='text'   NAME='sender'     VALUE='$addrvrfyed'    SIZE=$width>n";
} else {
	print "$fromtext: </td><td> <INPUT TYPE='hidden'   NAME='sender'     VALUE='$addrvrfyed'> <tt>$from_html</tt>n";
}
print "</TD><TD WIDTH=100  valign='middle' rowspan=3>n";
print "</td></tr>n";
print "<tr><td>";
print "$totext: </td><td> <INPUT TYPE='text'   NAME='to'         VALUE="$to"        SIZE=$width></td></tr>n";
print "<tr><td>Cc: </td><td> <INPUT TYPE='text'   NAME='cc'         VALUE=""        SIZE=$width></td></tr>n";
print "<tr><td>";
print "$subjecttext: </td><td> <INPUT TYPE='text'   NAME='subject'    VALUE="$subject"   SIZE=$width>n";
print "       <INPUT TYPE='hidden' NAME='loginname'  VALUE='$loginname' SIZE=$width>n";
print "       <INPUT TYPE='hidden' NAME='password'   VALUE='$password'             >n";
print "       <INPUT TYPE='hidden' NAME='POPserver'  VALUE='$POPserver'            >n";
print "       <INPUT TYPE='hidden' NAME='cache'      VALUE='$cache'                >n";
print "</TD></TR></TABLE>n";
print "$messagetext<br>n";
print "<textarea rows=14 cols=75 name='message' wrap='virtual'>n";
print $body;
print "</textarea><br>";
$attachtext=~ s/([^ ])//g;
print "$attachtext: <input type=file name=file><br>";
print "<ul><ul><ul><INPUT TYPE=submit value='$sendtext'></ul></ul></ul>";
print "</FORM>";
#send the ending html code (/body and /head tags)
print "</BODY></HTML>n";
exit;
#-----------------------------SUBROUTINES------------------------
sub ReadParse {
  local(*in)=@_ if @_;
  local ($i,$key,$val);
  if ($ENV{'REQUEST_METHOD'} eq "GET") {
    $in=$ENV{'QUERY_STRING'};
  }
  elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  }
  
  @in=split(/&/,$in);
  
  foreach $i (0 .. $#in) {
    $in[$i] =~ s/+/ /g;
    ($key,$val)=split(/=/,$in[$i],2);
    $key =~ s/%(..)/pack("c",hex($1))/ge;
    $val =~ s/%(..)/pack("c",hex($1))/ge;
    $in{$key} .= "" if (defined($in{$key}));
    $in{$key} .=$val;
  }
  return length($in);
}
################################################################
### sendmailvrfy ###############################################
################################################################
sub sendmailvrfy {
my ($addr,$smtp) = @_;
$addr =~ s/[ t]+/ /g; # pack spaces
$smtp =~ s/^s+//g; # remove spaces around $smtp
$smtp =~ s/s+$//g;
my $addrresolved="";
if (!$addr) { return -8; }
my($proto) = (getprotobyname('tcp'))[2];
my($port) = (getservbyname('smtp', 'tcp'))[2];
my($smtpaddr) = ($smtp =~
/^(d{1,3}).(d{1,3}).(d{1,3}).(d{1,3})$/)
? pack('C4',$1,$2,$3,$4)
: (gethostbyname($smtp))[4];
if (!defined($smtpaddr)) { return -1; }
if (!socket(S, AF_INET, SOCK_STREAM, $proto)) { return -2; }
if (!connect(S, pack('Sna4x8', AF_INET, $port, $smtpaddr))) { return -3; }
my($oldfh) = select(S); $| = 1; select($oldfh);
$_ = <S>; if (/^[45]/) { close S; return -4; }
print S "helo localhostrn";
$_ = <S>; if (/^[45]/) { close S; return -5; }
print S "vrfy $addrrn";
$_ = <S>;
if (/^[45]/) { close S; return -5; }
else { $addrresolved=$_; }
print S "quitrn";
$_ = <S>;
close S;
$addrresolved=~ s/^[0-9]*s(.*)/$1/;
return $addrresolved;
}

						