WEB邮件程序

开发平台：
Perl

inbox.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://aufrere.citeweb.net/nsc/
# @ ----------------------------------------------------------------------------------------------------------
# @ 
# @ Project		NS WebMail
# @ 
# @ Filename		inbox.pl
# @ 
# @ Description	inbox manager for NS WebMail
# @ 
# @ Version		1.0
# @ 
# @ ----------------------------------------------------------------------------------------------------------
use Mail::POP3Client;
require $APP_PATH."config.pl";
require $APP_PATH."common.pl";
#use the $cgi object method param() to
#acquire the FORM variables passed by
#the client browser.
&ReadParse;
$loginname = $in{'loginname'};
$password  = decryptit($in{'password'});
$POPserver = $in{'POPserver'};
$lastMsg   = $in{'lastMsg'};
$deleteMsg = $in{'deleteMsg'};
$cache     = $in{'cache'};
$|=1;
#if deleteMsg is not null, then this script has been called by the
#Delete Message button.  We will open a POP client object, delete
#the indicated message, then close the POP object to actually force
#the POP server to make the deletion.  The rest of the script will
#then play out and re-open the POP object.  By closing and reopening
#we will obtain an updated count that correctly does not include the
#recently deleted message.
if ($deleteMsg) {
	$pop = new Mail::POP3Client( USER=>$loginname, 
			PASSWORD=>$password, 
			HOST=>$POPserver,
			AUTH_MODE=>$POPauth
			);
	$pop->Delete($deleteMsg);
	$pop->Close();
	$deleteMsg = "";
	$pop = "";
	sleep(1);	# Gives the POP time to close and be ready for another
				# open attempt.
	}
#Begin production of HTML code.
print "Content-type: text/htmlnn";
print "<HTML><HEAD><TITLE>NS WM Message Retrieval</TITLE>";
if ($cache eq "No") { print "<META HTTP-EQUIV='Pragma' CONTENT='no-cache'>"; 
			print "</HEAD>n<BODY BGCOLOR='#FFFFFF' LINK=$linkcolor
VLINK=$linkcolor ALINK=$linkcolor>";
					}
else                { print "</HEAD>n<BODY BGCOLOR='FF8F8F'>";
					}
#print "<b><font size='+2'>NikoSoft WebMail</font></b><hr>";
print "<center>n";
#Create a (possibly new) POP connection with the POP3Client object.
$pop = new Mail::POP3Client( USER=>$loginname, 
			PASSWORD=>$password, 
			HOST=>$POPserver,
			AUTH_MODE=>$POPauth
			);
#How many messages are there in the inbox provided by the $pop object?
$MessageCount = $pop->Count;
#gather additional size info
@MessageSize = $pop->ListArray;
print "<table><tr><td>";
#if $pop->count is -1, then the POP connection failed.
if ($MessageCount == -1) {
	print "</table><font size=+1>$POPserver: $loginname, $incorrectlogin";
	print "</body></html>";
	exit;
	}
#if $pop->count is 0, there are no messages in the POP account		
elsif ($MessageCount == 0) {
        print "<b> $nomailon <i>$POPserver</i> </b>";
	}
#if $pop->count is >0, then that is the number of messages in the
#POP account inbox.
else {  print "<img src=$MAIL_IMG valign=middle>&nbsp;&nbsp;";
	print "<b>$MessageCount $messagesininbox (",$pop->Size," $bytestotaltext).</b>n";
}
print "</td></tr></table>n";
if ($MessageCount != -1) {	#equivalent to knowing a valid POP account was used...
	#Parse the message headers to output a list of message
	#header info including SUBJECT,FROM,DATE,and TO.
	#each message will have a read & delete button as well
	#and these three elements will be organized in a table
		
	if ($MessageCount > 0) {
		print "<table border=0 cellpadding=2 cellspacing=0 width=90% align=center>";
		print "<tr bgcolor=darkblue><td><b><font color=white>$fromtext</b></td><td><b><font color=white>$subjecttext</b></td><td><b><font color=white>$datetext</b></td><td><font color=white>$sizetext</font></td><td>&nbsp;</td>";
        &ParseHeaders();
		print "</table>";
		}
	
}
#close the POP connection smoothly.
$pop->Close;
#send the ending html code (/body and /head tags)
print "</BODY></HTML>";
exit;
#----------------------------------SUBROUTINES-------------------------
# Decode quoted strings (in From: and Subject)
sub DecodeQuoted {
  my $tmp = $_[0];
  if ($tmp =~ m/=?ISO-dddd-d?.?/i) {
    $tmp =~ s/=([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $tmp =~ s/=?ISO-dddd-d?.?(.*)?=/$1/i;
    $tmp =~ s/_/ /g;
  }
  return $tmp;
}
#-----------------------------Sub ParseHeaders-----------------------------
#Subroutine to parse the headers on each message to exctract the TO:, FROM:,
# DATE:, and SUBJECT: information.
#--------------------------------------------------------------------------
sub ParseHeaders {
  #loop through the messages in the POP account space
  
  #loop backwards, displaying most recent messages first
  #Also note that only the most recent 100 messages will be displayed from
  #
  
  if ($lastMsg == "") { $lastMsg = $MessageCount };
  
  for ($i=$lastMsg; $i >= 1 && $i> $lastMsg-100; $i--) {
    
    
    #for each message header, provide a FORM button to
    #invoke getmessage.pl and hand that routine the message
    #number. Pass the login,pass,server info again since
    #the web protocol does not provide for continued connections.
    if ( (($i)/2) == int(($i)/2) ) {
      print "<tr>n";
    } else {
      print "<tr bgcolor=$lightbgcolor>n";
    }
    
    $sub = $nosubject;
    $from = '';
    $to = '';
    $date = '';
    $replyto = '';
    
    #obtain each header with the head() method in POP3Client.
    
    foreach ($pop->Head($i)){
      #for each line within the message header retrieved, parse
      #the From,To,Date,Subject fields by finding
      #the appropriate strings at the beginning
      #of each line
      if (/^From:/ ){
	$from = $';		#Get string following the succesful match.
	$from = DecodeQuoted($from);
	$fromtmp=$from;
	$fromtmp=~ s/<[^ ]>//g;
	$fromtmp=~ s/(.*)s*/$1/;
	$from =~ s/</&lt;/;	#Strip out angled brackets to prevent browsers
	$from =~ s/>/&gt;/;	#from interpreting them as unknown HTML codes.
	$from=$fromtmp if ($fromtmp);
      }
      elsif (/^To:/) {
	$to = $';
      }
      elsif (/^Subject:/) {
	$sub = $';
	$sub = DecodeQuoted($sub);
      }
      elsif (/^Date:/) {
	$date = $';
      }
    }
    $date=~ s/.*,(.*)+.*/$1/;
    
    $date="<small>$date</small>";
    
    $size=$MessageSize[$i];
    $size="<small>".int(($size+512)/1024)."k</small>";
    print "<td>$from&nbsp;</td><td>";
	print "<a
href="getmsg.pl?id=$i&loginname=$loginname&POPserver=$POPserver&cache=$cache&password=".cryptit($password).""><b>$sub</b></a>";
	print "</td><td>$date&nbsp;</td><td>$size</td>";
  
    #for each message header, also provide a FORM button to
    #delete using inbox.pl As above, pass in the needed vars
    #using hidden types.
    print "<td><FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."inbox.pl'     >n";
    print     "<INPUT TYPE='hidden' NAME='loginname'  VALUE=$loginname >n";
    print     "<INPUT TYPE='hidden' NAME='password'   VALUE="".cryptit($password)."" >n";
    print     "<INPUT TYPE='hidden' NAME='POPserver'  VALUE=$POPserver >n";
    print     "<INPUT TYPE='hidden' NAME='deleteMsg'  VALUE=$i  >n";
    print     "<INPUT TYPE='hidden' NAME='cache'      VALUE=$cache >n";
    print     "<INPUT TYPE='submit'                   VALUE='$deletetext'  OnClick="return confirm('$deleteconfirmtext');">n";
    print     "</td></FORM></tr>n";
  }
}
###############################################################################
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);
}

						