/[webmail]/cgi-bin/getmsg.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /cgi-bin/getmsg.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Fri Apr 28 08:20:44 2000 UTC (21 years, 3 months ago) by dpavlin
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +3 -3 lines
File MIME type: text/plain
don't eat first line of text/plain mime attachement

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 }

  ViewVC Help
Powered by ViewVC 1.1.26