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=1;  # on header?
        foreach $bdy (@bodylines) {
                if (($bdy=~ m/$bound/)&&($partone==1)) {
                        $partone=2;
                }
                if (($partone==1)&&(!$mimeHeader)) {
                        $bdy=decodeHexChars($bdy);
                        print $bdy."<br>\n";
                }
                if ($partone==1 && $bdy=~m/^$/) { $mimeHeader=0; }
                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.
        my @headers=$pop->Head($i);
        while ($_ = shift @headers) {
                
                #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
                        #support for multi-line To:
                        while ($headers[0] =~ m/^ +/) {
                                my $tmp = shift @headers;
                                $tmp =~ s/\s+//;
                                $to .= $tmp;
                        }
                        $to =~ s/\</&lt\;/g;      #make angle brackets browser safe
                        $to =~ s/\>/&gt\;/g;
                        
                }
                #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
                        $cc =~ s/\>/&gt\;/;
                        
                }
        }
}
1	#!/usr/local/bin/perl
2
3	BEGIN { $APP_PATH="/home/httpd/html/webmail/cgi-bin/"; }
4
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=1; # on header?
185	foreach $bdy (@bodylines) {
186	if (($bdy=~ m/$bound/)&&($partone==1)) {
187	$partone=2;
188	}
189	if (($partone==1)&&(!$mimeHeader)) {
190	$bdy=decodeHexChars($bdy);
191	print $bdy."<br>\n";
192	}
193	if ($partone==1 && $bdy=~m/^$/) { $mimeHeader=0; }
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	my @headers=$pop->Head($i);
269	while ($_ = shift @headers) {
270
271	#parse out the From line from the header.
272	#Also, remove any angle brackets
273	#since some SMTP servers choke on these, but
274	#some POP clients send them anyway. (Not to mention
275	#but browsers tend to ignore them as unknown
276	#HTML codes.
277	if (/^From:/ ){
278	$from = $_; #assign the targeted line to the variable
279	$from =~ s/From:\s+//; #remove leading "From:" and any following whitespace
280	$from =~s/\"//g; #remove any quote marks & match contents
281	if ($from =~/\<(.\@.)\>/) { #delete angle brackets & match anything inside w/ "@"
282	$from2 = $1; #use electronic address, if available
283	}
284	else {
285	$from2 = $from; #else, use the quoted name
286	}
287	}# end if From
288
289	#parse out the "reply-to" line, if it exists...
290	$replyto = ''; #create the variable, but leave it empty
291	if (/^Reply-To:/) {
292	$replyto = $';
293	$replyto =~ s/\s+//; #remove intervening white space
294	$replyto =~ s/\</&lt\;/; #make angle brackets browser safe
295	$replyto =~ s/\>/&gt\;/;
296	}
297
298
299
300	#parse out the subject line.
301	if (/^Subject:/) {
302	#once the target phrase is found,
303	#capture everything following it with the
304	# $' PERL system function.
305	$sub = $';
306	$sub =~ s/\s+//; #remove leading white space
307	}
308
309	#parse out the date line.
310	if (/^Date:/) {
311	#once the target phrase is found,
312	#capture everything following it with the
313	# $' PERL system function.
314	$date = $';
315	$date =~ s/\s+//; #remove leading white space
316	}
317	if (/^Content-Type:/) {
318	#once the target phrase is found,
319	#capture everything following it with the
320	# $' PERL system function.
321	$ctype = $';
322	$ctype =~ s/\s+//; #remove leading white space
323	}
324	if (/boundary=/) {
325	#once the target phrase is found,
326	#capture everything following it with the
327	# $' PERL system function.
328	$bound = $';
329	$bound =~ s/\"(.*)\"/$1/; #remove leading white space
330	}
331	#parse out the recipient line.
332	if (/^To:/) {
333	#once the target phrase is found,
334	#capture everything following it with the
335	# $' PERL system function.
336	$to = $';
337	$to =~ s/\s+//; #remove leading white space
338	#support for multi-line To:
339	while ($headers[0] =~ m/^ +/) {
340	my $tmp = shift @headers;
341	$tmp =~ s/\s+//;
342	$to .= $tmp;
343	}
344	$to =~ s/\</&lt\;/g; #make angle brackets browser safe
345	$to =~ s/\>/&gt\;/g;
346
347	}
348	#parse out the recipient line.
349	if ((/^CC:/)\|\|(/^Cc:/)) {
350	#once the target phrase is found,
351	#capture everything following it with the
352	# $' PERL system function.
353	$cc = $';
354	$cc =~ s/\s+//; #remove leading white space
355	$cc =~ s/\</&lt\;/; #make angle brackets browser safe
356	$cc =~ s/\>/&gt\;/;
357
358	}
359	}
360	}