w3mmail.cgi.in (9840B)
1 #!@PERL@ 2 3 $rcsid = q$Id$; 4 ($id = $rcsid) =~ s/^.*,v ([\d\.]*).*/$1/; 5 ($prog=$0) =~ s/.*\///; 6 7 $query = $ENV{'QUERY_STRING'}; 8 $cookie_file = $ENV{'LOCAL_COOKIE_FILE'}; 9 $local_cookie = ''; 10 $SENDMAIL = '/usr/lib/sendmail'; 11 $SENDMAIL = '/usr/sbin/sendmail' if -x '/usr/sbin/sendmail'; 12 $SENDMAIL_OPT = '-oi -t'; 13 14 if (-f $cookie_file) { 15 open(F, "< $cookie_file"); 16 $local_cookie = <F>; 17 close(F); 18 } 19 if ($query =~ s/^\w+://) { 20 $url = $query; 21 $qurl = &html_quote($url); 22 $to = $query; 23 $opt = ''; 24 if ($to =~ /^([^?]*)\?(.*)$/) { 25 $to = $1; 26 $opt = $2; 27 } 28 $to = &url_unquote($to); 29 %opt = &parse_opt($opt); 30 31 @to = ($to); 32 push(@to, $opt{'to'}) if ($opt{'to'}); 33 $opt{'to'} = join(',', @to); 34 if ($ENV{'REQUEST_METHOD'} eq 'POST') { 35 sysread(STDIN, $body, $ENV{'CONTENT_LENGTH'}); 36 $content_type = $ENV{'CONTENT_TYPE'}; 37 if ($content_type =~ /^multipart\/form-data;\s+boundary=(.*)$/) { 38 $boundary = $1; 39 } 40 } else { 41 $body = $opt{'body'}; 42 delete $opt{'body'}; 43 } 44 &lang_setup; 45 46 print "Content-Type: text/html; charset=$charset\r\n"; 47 print "w3m-control: END\r\n"; 48 print "w3m-control: PREV_LINK\r\n"; 49 print "\r\n"; 50 print "<html><head><title>W3M Mailer: $qurl</title></head>\n"; 51 print "<body><h1>W3M Mailer: $qurl</h1>\n"; 52 print "<form action=\"file://$0\" method='POST'>\n"; 53 $local_cookie = &html_quote($local_cookie); 54 print "<input type='hidden' name='cookie' value=\"$local_cookie\">\n"; 55 print "<table>\n"; 56 foreach $h ('from', 'to', 'cc', 'bcc', 'subject') { 57 $v = &lang_html_quote($opt{$h}); 58 print "<tr><td>\u$h:<td><input type='text' name=\"$h\" value=\"$v\">\n"; 59 delete $opt{$h}; 60 } 61 if ($boundary) { 62 $boundary = &html_quote($boundary); 63 print "<tr><td>Content-Type:<td>multipart/form-data; boundary=\"$boundary\"\n"; 64 print "<input type='hidden' name='boundary' value=\"$boundary\">\n"; 65 } 66 foreach $h (keys %opt) { 67 $qh = &html_quote($h); 68 $v = &lang_html_quote($opt{$h}); 69 print "<tr><td>\u$h:<td>$v\n"; 70 print "<input type='hidden' name=\"$qh\" value=\"$v\">\n"; 71 } 72 print "<tr><td colspan=2>\n"; 73 print "<textarea cols=40 rows=10 name='body'>\n"; 74 if ($body) { 75 print &lang_html_quote($body); 76 } 77 print "</textarea>\n"; 78 print "</table>\n"; 79 print "<input type='submit' name='action' value='Preview'>\n"; 80 print "</form>\n"; 81 print "</body></html>\n"; 82 exit(0); 83 } else { 84 sysread(STDIN, $req, $ENV{'CONTENT_LENGTH'}); 85 %opt = &parse_opt($req); 86 if ($local_cookie ne $opt{'cookie'}) { 87 print "Content-Type: text/plain\r\n"; 88 print "\r\n"; 89 print "Local cookie doesn't match: It may be an illegal execution\n"; 90 exit 1; 91 } 92 delete $opt{'cookie'}; 93 $body = $opt{'body'}; 94 delete $opt{'body'}; 95 $act = $opt{'action'}; 96 delete $opt{'action'}; 97 $boundary = $opt{'boundary'}; 98 delete $opt{'boundary'}; 99 &lang_setup; 100 101 if ($act eq "Preview") { 102 print "Content-Type: text/html; charset=$charset\r\n"; 103 print "w3m-control: DELETE_PREVBUF\r\n"; 104 print "w3m-control: NEXT_LINK\r\n"; 105 print "\r\n"; 106 print "<html><head><title>W3M Mailer</title></head>\n"; 107 print "<body>\n"; 108 print "<h1>W3M Mailer: preview</h1>\n"; 109 print "<form action=\"file://$0\" method='POST'>\n"; 110 $local_cookie = &html_quote($local_cookie); 111 print "<input type='hidden' name='cookie' value=\"$local_cookie\">\n"; 112 print "<hr>\n"; 113 print "<pre>\n"; 114 foreach $h (keys %opt) { 115 $qh = &html_quote($h); 116 $v{$h} = &lang_html_quote($opt{$h}); 117 if ($v{$h}) { 118 print "\u$qh: $v{$h}\n"; 119 } 120 } 121 ($cs,$cte,$body) = &lang_body(&lang_html_quote($body), 0); 122 print "Mime-Version: 1.0\n"; 123 if ($boundary) { 124 $boundary = &html_quote($boundary); 125 print "Content-Type: multipart/form-data;\n"; 126 print " boundary=\"$boundary\"\n"; 127 } else { 128 print "Content-Type: text/plain; charset=$cs\n"; 129 } 130 # print "Content-Transfer-Encoding: $cte\n"; 131 print "User-Agent: ", &html_quote("$ENV{'SERVER_SOFTWARE'} $prog/$id"), 132 "\n"; 133 print "\n"; 134 print $body; 135 print "\n" if ($body !~ /\n$/); 136 print "</pre>\n"; 137 print "<input type='submit' name='action' value='Send'>\n"; 138 print "<hr>\n"; 139 print "<table>\n"; 140 foreach $h ('from', 'to', 'cc', 'bcc', 'subject') { 141 print "<tr><td>\u$h:<td><input type='text' name=\"$h\" value=\"$v{$h}\">\n"; 142 delete $opt{$h}; 143 } 144 if ($boundary) { 145 print "<tr><td>Content-Type:<td>Content-Type: multipart/form-data; boundary=\"$boundary\"\n"; 146 print "<input type='hidden' name=\"boundary\" value=\"$boundary\">\n"; 147 } 148 foreach $h (keys %opt) { 149 $qh = &html_quote($h); 150 print "<tr><td>\u$qh:<td>$v{$h}\n"; 151 print "<input type='hidden' name=\"$qh\" value=\"$v{$h}\">\n"; 152 } 153 print "<tr><td colspan=2>\n"; 154 print "<textarea cols=40 rows=10 name=body>\n"; 155 if ($body) { 156 print $body; 157 } 158 print "</textarea>\n"; 159 print "</table>\n"; 160 print "<input type='submit' name='action' value='Preview'><br>\n"; 161 print "</body></html>\n"; 162 } else { 163 # XXX: quote? 164 # if ($opt{'from'}) { 165 # $sendmail_fromopt = '-f' . $opt{'from'}; 166 # } 167 unless (open(MAIL, "|$SENDMAIL $SENDMAIL_OPT")) { 168 print "Content-Type: text/html\r\n"; 169 print "\r\n"; 170 print "<html><head><title>W3M Mailer</title></head>\n"; 171 print "<body><h1>W3M Mailer: open sendmail failed</h1>\n"; 172 print "<p>", &html_quote($@), "</p>\n"; 173 print "</body></html>\n"; 174 exit(0); 175 } 176 foreach $h (keys %opt) { 177 $v = &lang_header($opt{$h}); 178 if ($v) { 179 print MAIL "\u$h: $v\n"; 180 } 181 } 182 ($cs,$cte,$body) = &lang_body($body, 1); 183 $body =~ s/\r//g; 184 print MAIL "Mime-Version: 1.0\n"; 185 if ($boundary) { 186 print MAIL "Content-Type: multipart/form-data;\n"; 187 print MAIL " boundary=\"$boundary\"\n"; 188 } else { 189 print MAIL "Content-Type: text/plain; charset=$cs\n"; 190 } 191 print MAIL "Content-Transfer-Encoding: $cte\n"; 192 print MAIL "User-Agent: $ENV{'SERVER_SOFTWARE'} $prog/$id\n"; 193 print MAIL "\n"; 194 print MAIL $body; 195 if (close(MAIL)) { 196 print "w3m-control: DELETE_PREVBUF\r\n"; 197 print "w3m-control: BACK\r\n"; 198 print "\r\n"; 199 } else { 200 print "Content-Type: text/html\r\n"; 201 print "\r\n"; 202 print "<html><head><title>W3M Mailer</title></head>\n"; 203 print "<body><h1>W3M Mailer: close sendmail failed</h1>\n"; 204 print "<p>", &html_quote($@), "</p>\n"; 205 print "</body></html>\n"; 206 } 207 } 208 } 209 210 sub lang_setup { 211 $lang = $ENV{'LC_ALL'} || $ENV{'LC_CTYPE'} || $ENV{'LANG'}; 212 if ($lang =~ /^ja/i) { 213 eval "use NKF;"; 214 if (! $@) { 215 $use_NKF = 1; 216 } else { 217 $use_NKF = 0; 218 } 219 $charset = "EUC-JP"; 220 } else { 221 $charset = &guess_charset($lang); 222 } 223 } 224 225 sub lang_header { 226 if ($lang =~ /^ja/i) { 227 return &lang_header_ja(@_); 228 } else { 229 return &lang_header_default(@_); 230 } 231 } 232 233 sub lang_body { 234 if ($lang =~ /^ja/i) { 235 return &lang_body_ja(@_); 236 } else { 237 return &lang_body_default(@_); 238 } 239 } 240 241 sub lang_html_quote { 242 local($_) = @_; 243 if ($lang =~ /^ja/i) { 244 if (/[\x80-\xFF]/ || /\033[\$\(][BJ@]/) { 245 $_ = &conv_nkf("-e", $_); 246 } 247 } 248 return &html_quote($_); 249 } 250 251 sub lang_header_default { 252 local($h) = @_; 253 if ($h =~ s/([=_?\x80-\xFF])/sprintf("=%02x", ord($1))/ge) { 254 return "=?$charset?Q?$h?="; 255 } else { 256 return $h; 257 } 258 } 259 260 sub lang_body_default { 261 local($body, $_7bit) = @_; 262 if ($body =~ /[\x80-\xFF]/) { 263 if ($_7bit) { 264 $body =~ s/([=\x80-\xFF])/sprintf("=%02x", ord($1))/ge; 265 return ($charset, "quoted-printable", $body); 266 } else { 267 return ($charset, "8bit", $body); 268 } 269 } else { 270 return ("US-ASCII", "7bit", $body); 271 } 272 } 273 274 sub lang_header_ja { 275 local($h) = @_; 276 if ($h =~ /[\x80-\xFF]/ || $h =~ /\033[\$\(][BJ@]/) { 277 $h = &conv_nkf("-j", $h); 278 &conv_nkf("-M", $h); 279 } else { 280 return $h; 281 } 282 } 283 284 sub lang_body_ja { 285 local($body, $_7bit) = @_; 286 if ($body =~ /[\x80-\xFF]/ || $body =~ /\033[\$\(][BJ@]/) { 287 if ($_7bit) { 288 $body = &conv_nkf("-j", $body); 289 } 290 return ("ISO-2022-JP", "7bit", $body); 291 } else { 292 return ("US-ASCII", "7bit", $body); 293 } 294 } 295 296 sub conv_nkf { 297 local(@opt) = @_; 298 if ($use_NKF) { 299 return nkf(@opt); 300 } 301 local($body) = pop(@opt); 302 $body =~ s/\r+\n/\n/g; 303 $| = 1; 304 pipe(R, W2); 305 pipe(R2, W); 306 if (! fork()) { 307 close(F); 308 close(R); 309 close(W); 310 open(STDIN, "<&R2"); 311 open(STDOUT, ">&W2"); 312 exec "nkf", @opt; 313 die; 314 } 315 close(R2); 316 close(W2); 317 print W $body; 318 close(W); 319 $body = ''; 320 while(<R>) { 321 $body .= $_; 322 } 323 close(R); 324 return $body; 325 }; 326 327 328 329 sub parse_opt { 330 local($opt) = @_; 331 local(%opt) = (); 332 if ($opt) { 333 foreach $o (split('&', $opt)) { 334 if ($o =~ /(\w+)=(.*)/) { 335 $opt{"\L$1"} = &url_unquote($2); 336 } 337 } 338 } 339 return %opt; 340 } 341 342 sub html_quote { 343 local($_) = @_; 344 local(%QUOTE) = ( 345 '<', '<', 346 '>', '>', 347 '&', '&', 348 '"', '"', 349 ); 350 s/[<>&"]/$QUOTE{$&}/g; 351 return $_; 352 } 353 354 sub url_unquote { 355 local($_) = @_; 356 s/\+|%([0-9A-Fa-f][0-9A-Fa-f])/$& eq '+' ? ' ' : pack('c', hex($1))/ge; 357 return $_; 358 } 359 360 sub guess_charset { 361 local(%lang_charset) = ( 362 'cs', 'iso-8859-2', 363 'el', 'iso-8859-7', 364 'iw', 'iso-8859-8', 365 'ja', 'EUC-JP', 366 'ko', 'EUC-KR', 367 'hu', 'iso-8859-2', 368 'pl', 'iso-8859-2', 369 'ro', 'iso-8859-2', 370 'ru', 'iso-8859-5', 371 'sk', 'iso-8859-2', 372 'sl', 'iso-8859-2', 373 'tr', 'iso-8859-9', 374 'zh', 'GB2312', 375 ); 376 local($_) = @_; 377 local($lang); 378 379 if (! s/\.(.*)$//) { 380 if (/^zh_tw/i) { 381 return 'Big5'; 382 } 383 /^(..)/; 384 return $lang_charset{$1} || 'iso-8859-1'; 385 } 386 $lang = $_; 387 $_ = $1; 388 if (/^euc/i) { 389 if (/^euc$/i) { 390 $lang =~ /^zh_tw/ && return 'EUC-TW'; 391 $lang =~ /^zh/ && return 'GB2312'; 392 $lang =~ /^ko/ && return 'EUC-KR'; 393 return 'EUC-JP'; 394 } 395 /^euccn/i && return 'GB2312'; 396 s/[\-_]//g; 397 s/^euc/EUC-/i; 398 tr/a-z/A-Z/; 399 } elsif (/^iso8859/i) { 400 s/[\-_]//g; 401 s/^iso8859/iso-8859-/i; 402 } 403 return $_; 404 }