scripts/w3mmail.cgi.in

   1 #!@PERL@
   2
   3 $rcsid = q$Id: w3mmail.cgi.in,v 1.14 2004/08/30 16:32:24 ukai Exp $;
   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     '<', '&lt;',
 346     '>', '&gt;',
 347     '&', '&amp;',
 348     '"', '&quot;',
 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 }