webmail/cgi-bin/getmsg.pl

#!/usr/local/bin/perl

BEGIN { $APP_PATH="/home/httpd/html/webmail/cgi-bin/"; }

# @ ----------------------------------------------------------------------------------------------------------
# @ 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            getmsg.pl
# @ 
# @ Description view messages using POP protocol.
# @ 
# @ Version             1.0
# @ 
# @ ----------------------------------------------------------------------------------------------------------

use Mail::POP3Client;
require $APP_PATH."config.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'};
$i =          $in{'id'};
$cache     =  $in{'cache'};

$browser = $ENV{'HTTP_USER_AGENT'};

#clear the $body variable.
$body ="";

#create a POP connection using the POP3client module by
#creating an object called $pop of type POP3Client. See
#POP3Client.pm documentation.
$pop = new Mail::POP3Client($loginname, $password, $POPserver);

print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>NSC WebMail [Lire Message]";
print "</TITLE>";
if ($cache eq "No") {   print "<META HTTP-EQUIV='Pragma' CONTENT='no-cache'>"; }

if ($browser =~ /Mozilla\/2/) {
        print "<SCRIPT LANGUAGE='JavaScript'><!-- Hide JavaScript from old browsers\n";
        print "function goBack()\n";
        print "{\n";
        print "history.go(-1)\n";
        print "}\n";
        print "//---- End hiding JavaScript --></SCRIPT>\n";
}
print "</HEAD>";
print "<BODY BGCOLOR='FFFFFF'>";

#print "<font size='+2'>Message $i</font>";

#POP the header...
&GetHeader();


#POP the message using POP3Client's body() function
#and add a line return at the end of each line. Otherwise
#the thing will look awful.
foreach ($pop->Body($i)) {
        $body = $body.$_."\n";
}


#Note that $from2 was
#created in &GetHeader.  If an @ was in $from, then
#the electronic address should be found in $from2, else
#it will contain just the first part of the original string.

if ($sub eq "Subject:") {
        $sub = ">>no subject<<";
}

print "<center><TABLE border=0><TR>";

print "<TD><FORM METHOD='POST'  ACTION='".$CGI_PATH_NSWM."inbox.pl' name=inboxForm    >\n";
print "<INPUT TYPE='hidden' NAME='loginname'  VALUE=$loginname   >\n";
print "<INPUT TYPE='hidden' NAME='POPserver'  VALUE=$POPserver   >\n";
print "<INPUT TYPE='hidden' NAME='password'   VALUE=$password    >\n";
print "<INPUT TYPE='hidden' NAME='cache'      VALUE=$cache    >\n";
print "</FORM>";

print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."sendform.pl' name=newMailForm>\n";
print "<INPUT TYPE='hidden'  NAME='loginname'     VALUE=$loginname>\n";
print "<INPUT TYPE='hidden'  NAME='password'      VALUE=$password>\n";
print "<INPUT TYPE='hidden'  NAME='POPserver'     VALUE=$POPserver>\n";
print "<INPUT TYPE='hidden'  NAME='to'            VALUE=\"\">\n";
print "<INPUT TYPE='hidden'  NAME=\"subject\"       VALUE=\"\">\n";
print "<INPUT TYPE='hidden'  NAME='cache'         VALUE=$cache>\n";

print "</FORM></TD>";


# Now create a button which will enable a user to generate a reply.
# As usual, the button is loaded with hidden values to permit a message
# to actually be sent at a later time.

if ($replyto == '') { $replyto = $from2;  }

$bodysend=substr($body,0,1000);
$bodysend=~ s/\"/'/g;

print "<TD WIDTH=100 ALIGN=CENTER>\n";
print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."sendform.pl' name=reMailForm>\n";
print "<INPUT TYPE='submit'                       VALUE='$answertext'>\n";
print "<INPUT TYPE='hidden'  NAME='loginname'     VALUE=$loginname>\n";
print "<INPUT TYPE='hidden'  NAME='password'      VALUE=$password>\n";
print "<INPUT TYPE='hidden'  NAME='POPserver'     VALUE=$POPserver>\n";
print "<INPUT TYPE='hidden'  NAME='to'            VALUE=\"$replyto\">\n";
print "<INPUT TYPE='hidden'  NAME=\"subject\"       VALUE=\"Re: $sub\">\n";
print "<INPUT TYPE='hidden'  NAME='body'          VALUE=\"$bodysend\">\n";
print "<INPUT TYPE='hidden'  NAME='cache'         VALUE=$cache>\n";
print "</FORM></TD>\n";

print "<TD WIDTH=100 ALIGN=CENTER>\n";
print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."sendform.pl' name=fwdMailForm>\n";
print "<INPUT TYPE='submit'                       VALUE='$fwdtext'>\n";
print "<INPUT TYPE='hidden'  NAME='loginname'     VALUE=$loginname>\n";
print "<INPUT TYPE='hidden'  NAME='password'      VALUE=$password>\n";
print "<INPUT TYPE='hidden'  NAME='POPserver'     VALUE=$POPserver>\n";
print "<INPUT TYPE='hidden'  NAME='to'            VALUE=\"\">\n";
print "<INPUT TYPE='hidden'  NAME=\"subject\"       VALUE=\"Fwd: $sub\">\n";
print "<INPUT TYPE='hidden'  NAME='body'          VALUE=\"$bodysend\">\n";
print "<INPUT TYPE='hidden'  NAME='cache'         VALUE=$cache>\n";
print "</FORM></TD>\n";

print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."sentmail.pl' name=sentForm>\n";
print "<INPUT TYPE='hidden'  NAME='loginname'     VALUE=$loginname>\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 "</FORM>";

#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 WIDTH=100 ALIGN=CENTER>\n";
print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."inbox.pl'>\n";
print "<INPUT TYPE='submit'                   VALUE='$deletetext'   >\n";
print "<INPUT TYPE='hidden' NAME='loginname'  VALUE=$loginname >\n";
print "<INPUT TYPE='hidden' NAME='password'   VALUE=$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 "</FORM></TD></TR></TABLE>";

print "</center><table border=0 width=100%><tr bgcolor=lightblue><td><font face=arial><ul>";

print "$totext: $to <br>\n";
print "Cc: $cc <br>\n" if ($cc ne"");
print "$fromtext: <b>$from2</b><br>\n";
print "$subjecttext: <b>$sub</b>  <br>\n";
$date=~ s/.*\,(.*)\+.*/$1/;
print "$datetext: $date \n";

print "</ul></font></td></tr></table>";

print "<br><font face=times size=+1>";

# multipart handling
if ($ctype =~ m/multipart/) {
        print "<font color=red size=-1>$multipartmessage</font><br><br>\n";
        $body=~ s/$bound(.*)$bound.*/$1/;
        @bodylines=split("\n",$body);
        $partone=0;
        $mimeHeader=0;
        foreach $bdy (@bodylines) {
                if (($bdy=~ m/$bound/)&&($partone==1)) {
                        $partone=2;
                }
                if ($partone==1) { $mimeHeader++; }
                if (($partone==1)&&($mimeHeader > 3)    ) {
                        $bdy=decodeHexChars($bdy);
                        print $bdy."<br>\n";
                }
                if (($bdy=~ m/text\/plain/)&&($partone==0.5)) {
                        $partone=1;
                }
                if (($bdy=~ m/$bound/)&&($partone==0)) {
                        $partone=0.5;
                }
        }
}
else {
        $body=decodeHexChars($body);
        print "<pre>$body</pre>\n";
}


#close the POP connection using the close() method
$pop->Close();

#send the ending html code (/body and /head tags)
print "</BODY></HTML>\n";
exit;


#-----------------------------SUBROUTINES------------------------

sub decodeHexChars {
        ($text)=@_;
        for ($t=0; $t<=length($text); $t++) {
                if (substr($text, $t, 1) eq "=") {
                        $char=chr(hex(substr($text,$t+1,2)));
                        substr($text,$t,3,$char);
                }
        }
        return $text;
}

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} .= "\0" if (defined($in{$key}));
                $in{$key} .=$val;
        }
        return length($in);
}


##############################
#  GetHeader Subroutine      #
##############################

sub GetHeader {
        
        #for the message identified by the 'id'
        #passed in the FORM, POP the header to
        #get the 'Subject' and 'From' info. Why? Because if the
        #are passed in the header and one is greater than 256 characters
        #the browser will chop it off.
        #This is unlikely, but we want to cover any
        #eventuality.
        foreach ($pop->Head($i)) {
                
                #parse out the From line from the header.
                #Also, remove any angle brackets
                #since some SMTP servers choke on these, but
                #some POP clients send them anyway.  (Not to mention
                #but browsers tend to ignore them as unknown
                #HTML codes.
                if (/^From:/ ){
                        $from = $_;                             #assign the targeted line to the variable
                        $from =~ s/From:\s+//;  #remove leading "From:" and any following whitespace
                        $from =~s/\"//g;                #remove any quote marks & match contents
                        if ($from =~/\<(.*\@.*)\>/) { #delete angle brackets & match anything inside w/ "@"
                                $from2 = $1;        #use electronic address, if available
                        }
                        else {
                                $from2 = $from;     #else, use the quoted name
                        }
                }# end if From
                
                #parse out the "reply-to" line, if it exists...
                $replyto = '';                  #create the variable, but leave it empty
                if (/^Reply-To:/) {
                        $replyto = $';
                        $replyto =~ s/\s+//;    #remove intervening white space
                        $replyto =~ s/\</&lt\;/;          #make angle brackets browser safe
                                $replyto =~ s/\>/&gt\;/;
                }
                
                
                #parse out the subject line.
                if  (/^Subject:/) {
                        #once the target phrase is found,
                        #capture everything following it with the
                        # $' PERL system function.
                        $sub = $';
                        $sub =~ s/\s+//;   #remove leading white space
                }
                
                #parse out the date line.
                if  (/^Date:/) {
                        #once the target phrase is found,
                        #capture everything following it with the
                        # $' PERL system function.
                        $date = $';
                        $date =~ s/\s+//;   #remove leading white space
                }
                if  (/^Content-Type:/) {
                        #once the target phrase is found,
                        #capture everything following it with the
                        # $' PERL system function.
                        $ctype = $';
                        $ctype =~ s/\s+//;   #remove leading white space
                }
                if  (/boundary=/) {
                        #once the target phrase is found,
                        #capture everything following it with the
                        # $' PERL system function.
                        $bound = $';
                        $bound =~ s/\"(.*)\"/$1/;   #remove leading white space
                }
                #parse out the recipient line.
                if (/^To:/) {
                        #once the target phrase is found,
                        #capture everything following it with the
                        # $' PERL system function.
                        $to = $';
                        $to =~ s/\s+//;           #remove leading white space
                        $to =~ s/\</&lt\;/;       #make angle brackets browser safe
                                $to =~ s/\>/&gt\;/;
                        
                }
                #parse out the recipient line.
                if ((/^CC:/)||(/^Cc:/)) {
                        #once the target phrase is found,
                        #capture everything following it with the
                        # $' PERL system function.
                        $cc = $';
                        $cc =~ s/\s+//;           #remove leading white space
                        $cc =~ s/\</&lt\;/;       #make angle brackets browser safe
                                $to =~ s/\>/&gt\;/;
                        
                }
        }
}
1	dpavlin	1.1	#!/usr/local/bin/perl
2
3	dpavlin	1.2	BEGIN { $APP_PATH="/home/httpd/html/webmail/cgi-bin/"; }
4	dpavlin	1.1
5			# @ ----------------------------------------------------------------------------------------------------------
6			# @ This code is (c) 1999 Alexandre Aufrere and NikoSoft.
7			# @ Published under NPL rights, meaning you have the right
8			# @ to use and modify this code freely, provided it
9			# @ remains available and free. Any modified code should be
10			# @ submitted to Nikopol Software Corp. or Alexandre Aufrere.
11			# @ This code is protected by the French laws on Copyright.
12			# @ Please note that there it comes with NO WARRANTY of any kind,
13			# @ and especially for any damagbe it could cause to your computer
14			# @ or network.
15			# @ Using this code means you agree to this license agreement.
16			# @ Further information at http://aufrere.citeweb.net/nsc/
17			# @ ----------------------------------------------------------------------------------------------------------
18			# @
19			# @ Project NS WebMail
20			# @
21			# @ Filename getmsg.pl
22			# @
23			# @ Description view messages using POP protocol.
24			# @
25			# @ Version 1.0
26			# @
27			# @ ----------------------------------------------------------------------------------------------------------
28
29			use Mail::POP3Client;
30			require $APP_PATH."config.pl";
31
32			#obtain the FORM information that has been passed by using
33			#the param() method of the cgi object.
34			&ReadParse;
35			$loginname = $in{'loginname'};
36			$password = $in{'password'};
37			$POPserver = $in{'POPserver'};
38			$i = $in{'id'};
39			$cache = $in{'cache'};
40
41			$browser = $ENV{'HTTP_USER_AGENT'};
42
43			#clear the $body variable.
44			$body ="";
45
46			#create a POP connection using the POP3client module by
47			#creating an object called $pop of type POP3Client. See
48			#POP3Client.pm documentation.
49			$pop = new Mail::POP3Client($loginname, $password, $POPserver);
50
51			print "Content-type: text/html\n\n";
52			print "<HTML><HEAD><TITLE>NSC WebMail [Lire Message]";
53			print "</TITLE>";
54			if ($cache eq "No") { print "<META HTTP-EQUIV='Pragma' CONTENT='no-cache'>"; }
55
56			if ($browser =~ /Mozilla\/2/) {
57			print "<SCRIPT LANGUAGE='JavaScript'><!-- Hide JavaScript from old browsers\n";
58			print "function goBack()\n";
59			print "{\n";
60			print "history.go(-1)\n";
61			print "}\n";
62			print "//---- End hiding JavaScript --></SCRIPT>\n";
63			}
64			print "</HEAD>";
65			print "<BODY BGCOLOR='FFFFFF'>";
66
67			#print "<font size='+2'>Message $i</font>";
68
69			#POP the header...
70			&GetHeader();
71
72
73			#POP the message using POP3Client's body() function
74			#and add a line return at the end of each line. Otherwise
75			#the thing will look awful.
76			foreach ($pop->Body($i)) {
77			$body = $body.$_."\n";
78			}
79
80
81			#Note that $from2 was
82			#created in &GetHeader. If an @ was in $from, then
83			#the electronic address should be found in $from2, else
84			#it will contain just the first part of the original string.
85
86			if ($sub eq "Subject:") {
87			$sub = ">>no subject<<";
88			}
89
90			print "<center><TABLE border=0><TR>";
91
92			print "<TD><FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."inbox.pl' name=inboxForm >\n";
93			print "<INPUT TYPE='hidden' NAME='loginname' VALUE=$loginname >\n";
94			print "<INPUT TYPE='hidden' NAME='POPserver' VALUE=$POPserver >\n";
95			print "<INPUT TYPE='hidden' NAME='password' VALUE=$password >\n";
96			print "<INPUT TYPE='hidden' NAME='cache' VALUE=$cache >\n";
97			print "</FORM>";
98
99			print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."sendform.pl' name=newMailForm>\n";
100			print "<INPUT TYPE='hidden' NAME='loginname' VALUE=$loginname>\n";
101			print "<INPUT TYPE='hidden' NAME='password' VALUE=$password>\n";
102			print "<INPUT TYPE='hidden' NAME='POPserver' VALUE=$POPserver>\n";
103			print "<INPUT TYPE='hidden' NAME='to' VALUE=\"\">\n";
104			print "<INPUT TYPE='hidden' NAME=\"subject\" VALUE=\"\">\n";
105			print "<INPUT TYPE='hidden' NAME='cache' VALUE=$cache>\n";
106
107			print "</FORM></TD>";
108
109
110
111			# Now create a button which will enable a user to generate a reply.
112			# As usual, the button is loaded with hidden values to permit a message
113			# to actually be sent at a later time.
114
115			if ($replyto == '') { $replyto = $from2; }
116
117			$bodysend=substr($body,0,1000);
118			$bodysend=~ s/\"/'/g;
119
120			print "<TD WIDTH=100 ALIGN=CENTER>\n";
121			print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."sendform.pl' name=reMailForm>\n";
122			print "<INPUT TYPE='submit' VALUE='$answertext'>\n";
123			print "<INPUT TYPE='hidden' NAME='loginname' VALUE=$loginname>\n";
124			print "<INPUT TYPE='hidden' NAME='password' VALUE=$password>\n";
125			print "<INPUT TYPE='hidden' NAME='POPserver' VALUE=$POPserver>\n";
126			print "<INPUT TYPE='hidden' NAME='to' VALUE=\"$replyto\">\n";
127			print "<INPUT TYPE='hidden' NAME=\"subject\" VALUE=\"Re: $sub\">\n";
128			print "<INPUT TYPE='hidden' NAME='body' VALUE=\"$bodysend\">\n";
129			print "<INPUT TYPE='hidden' NAME='cache' VALUE=$cache>\n";
130			print "</FORM></TD>\n";
131
132			print "<TD WIDTH=100 ALIGN=CENTER>\n";
133			print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."sendform.pl' name=fwdMailForm>\n";
134			print "<INPUT TYPE='submit' VALUE='$fwdtext'>\n";
135			print "<INPUT TYPE='hidden' NAME='loginname' VALUE=$loginname>\n";
136			print "<INPUT TYPE='hidden' NAME='password' VALUE=$password>\n";
137			print "<INPUT TYPE='hidden' NAME='POPserver' VALUE=$POPserver>\n";
138			print "<INPUT TYPE='hidden' NAME='to' VALUE=\"\">\n";
139			print "<INPUT TYPE='hidden' NAME=\"subject\" VALUE=\"Fwd: $sub\">\n";
140			print "<INPUT TYPE='hidden' NAME='body' VALUE=\"$bodysend\">\n";
141			print "<INPUT TYPE='hidden' NAME='cache' VALUE=$cache>\n";
142			print "</FORM></TD>\n";
143
144			print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."sentmail.pl' name=sentForm>\n";
145			print "<INPUT TYPE='hidden' NAME='loginname' VALUE=$loginname>\n";
146			print "<INPUT TYPE='hidden' NAME='password' VALUE=$password>\n";
147			print "<INPUT TYPE='hidden' NAME='POPserver' VALUE=$POPserver>\n";
148			print "<INPUT TYPE='hidden' NAME='cache' VALUE=$cache>\n";
149			print "</FORM>";
150
151			#for each message header, also provide a FORM button to
152			#delete using inbox.pl As above, pass in the needed vars
153			#using hidden types.
154			print "<TD WIDTH=100 ALIGN=CENTER>\n";
155			print "<FORM METHOD='POST' ACTION='".$CGI_PATH_NSWM."inbox.pl'>\n";
156			print "<INPUT TYPE='submit' VALUE='$deletetext' >\n";
157			print "<INPUT TYPE='hidden' NAME='loginname' VALUE=$loginname >\n";
158			print "<INPUT TYPE='hidden' NAME='password' VALUE=$password >\n";
159			print "<INPUT TYPE='hidden' NAME='POPserver' VALUE=$POPserver >\n";
160			print "<INPUT TYPE='hidden' NAME='deleteMsg' VALUE=$i >\n";
161			print "<INPUT TYPE='hidden' NAME='cache' VALUE=$cache >\n";
162
163			print "</FORM></TD></TR></TABLE>";
164
165			print "</center><table border=0 width=100%><tr bgcolor=lightblue><td><font face=arial><ul>";
166
167			print "$totext: $to <br>\n";
168			print "Cc: $cc <br>\n" if ($cc ne"");
169			print "$fromtext: <b>$from2</b><br>\n";
170			print "$subjecttext: <b>$sub</b> <br>\n";
171			$date=~ s/.\,(.)\+.*/$1/;
172			print "$datetext: $date \n";
173
174			print "</ul></font></td></tr></table>";
175
176			print "<br><font face=times size=+1>";
177
178			# multipart handling
179			if ($ctype =~ m/multipart/) {
180			print "<font color=red size=-1>$multipartmessage</font><br><br>\n";
181			$body=~ s/$bound(.)$bound./$1/;
182			@bodylines=split("\n",$body);
183			$partone=0;
184			$mimeHeader=0;
185			foreach $bdy (@bodylines) {
186			if (($bdy=~ m/$bound/)&&($partone==1)) {
187			$partone=2;
188			}
189			if ($partone==1) { $mimeHeader++; }
190			if (($partone==1)&&($mimeHeader > 3) ) {
191			$bdy=decodeHexChars($bdy);
192			print $bdy."<br>\n";
193			}
194			if (($bdy=~ m/text\/plain/)&&($partone==0.5)) {
195			$partone=1;
196			}
197			if (($bdy=~ m/$bound/)&&($partone==0)) {
198			$partone=0.5;
199			}
200			}
201			}
202			else {
203			$body=decodeHexChars($body);
204			print "<pre>$body</pre>\n";
205			}
206
207
208			#close the POP connection using the close() method
209			$pop->Close();
210
211			#send the ending html code (/body and /head tags)
212			print "</BODY></HTML>\n";
213			exit;
214
215
216			#-----------------------------SUBROUTINES------------------------
217
218			sub decodeHexChars {
219			($text)=@_;
220			for ($t=0; $t<=length($text); $t++) {
221			if (substr($text, $t, 1) eq "=") {
222			$char=chr(hex(substr($text,$t+1,2)));
223			substr($text,$t,3,$char);
224			}
225			}
226			return $text;
227			}
228
229			sub ReadParse {
230			local(*in)=@_ if @_;
231			local ($i,$key,$val);
232
233			if ($ENV{'REQUEST_METHOD'} eq "GET") {
234			$in=$ENV{'QUERY_STRING'};
235			}
236			elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
237			read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
238			}
239
240			@in=split(/&/,$in);
241
242			foreach $i (0 .. $#in) {
243			$in[$i] =~ s/\+/ /g;
244			($key,$val)=split(/=/,$in[$i],2);
245			$key =~ s/%(..)/pack("c",hex($1))/ge;
246			$val =~ s/%(..)/pack("c",hex($1))/ge;
247			$in{$key} .= "\0" if (defined($in{$key}));
248			$in{$key} .=$val;
249			}
250			return length($in);
251			}
252
253
254
255			##############################
256			# GetHeader Subroutine #
257			##############################
258
259			sub GetHeader {
260
261			#for the message identified by the 'id'
262			#passed in the FORM, POP the header to
263			#get the 'Subject' and 'From' info. Why? Because if the
264			#are passed in the header and one is greater than 256 characters
265			#the browser will chop it off.
266			#This is unlikely, but we want to cover any
267			#eventuality.
268			foreach ($pop->Head($i)) {
269
270			#parse out the From line from the header.
271			#Also, remove any angle brackets
272			#since some SMTP servers choke on these, but
273			#some POP clients send them anyway. (Not to mention
274			#but browsers tend to ignore them as unknown
275			#HTML codes.
276			if (/^From:/ ){
277			$from = $_; #assign the targeted line to the variable
278			$from =~ s/From:\s+//; #remove leading "From:" and any following whitespace
279			$from =~s/\"//g; #remove any quote marks & match contents
280			if ($from =~/\<(.\@.)\>/) { #delete angle brackets & match anything inside w/ "@"
281			$from2 = $1; #use electronic address, if available
282			}
283			else {
284			$from2 = $from; #else, use the quoted name
285			}
286			}# end if From
287
288			#parse out the "reply-to" line, if it exists...
289			$replyto = ''; #create the variable, but leave it empty
290			if (/^Reply-To:/) {
291			$replyto = $';
292			$replyto =~ s/\s+//; #remove intervening white space
293			$replyto =~ s/\</&lt\;/; #make angle brackets browser safe
294			$replyto =~ s/\>/&gt\;/;
295			}
296
297
298
299			#parse out the subject line.
300			if (/^Subject:/) {
301			#once the target phrase is found,
302			#capture everything following it with the
303			# $' PERL system function.
304			$sub = $';
305			$sub =~ s/\s+//; #remove leading white space
306			}
307
308			#parse out the date line.
309			if (/^Date:/) {
310			#once the target phrase is found,
311			#capture everything following it with the
312			# $' PERL system function.
313			$date = $';
314			$date =~ s/\s+//; #remove leading white space
315			}
316			if (/^Content-Type:/) {
317			#once the target phrase is found,
318			#capture everything following it with the
319			# $' PERL system function.
320			$ctype = $';
321			$ctype =~ s/\s+//; #remove leading white space
322			}
323			if (/boundary=/) {
324			#once the target phrase is found,
325			#capture everything following it with the
326			# $' PERL system function.
327			$bound = $';
328			$bound =~ s/\"(.*)\"/$1/; #remove leading white space
329			}
330			#parse out the recipient line.
331			if (/^To:/) {
332			#once the target phrase is found,
333			#capture everything following it with the
334			# $' PERL system function.
335			$to = $';
336			$to =~ s/\s+//; #remove leading white space
337			$to =~ s/\</&lt\;/; #make angle brackets browser safe
338			$to =~ s/\>/&gt\;/;
339
340			}
341			#parse out the recipient line.
342			if ((/^CC:/)\|\|(/^Cc:/)) {
343			#once the target phrase is found,
344			#capture everything following it with the
345			# $' PERL system function.
346			$cc = $';
347			$cc =~ s/\s+//; #remove leading white space
348			$cc =~ s/\</&lt\;/; #make angle brackets browser safe
349			$to =~ s/\>/&gt\;/;
350
351			}
352			}
353			}