home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / lib / w3m / cgi-bin / w3mmail.cgi < prev    next >
Encoding:
Text File  |  2006-04-05  |  9.6 KB  |  404 lines
  1. #!/usr/bin/perl
  2.  
  3. $rcsid = q$Id: w3mmail.cgi.in,v 1.13 2003/09/22 21:02:29 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.     print MAIL "Mime-Version: 1.0\n";
  184.     if ($boundary) {
  185.         print MAIL "Content-Type: multipart/form-data;\n";
  186.         print MAIL "    boundary=\"$boundary\"\n";
  187.     } else {
  188.         print MAIL "Content-Type: text/plain; charset=$cs\n";
  189.     }
  190.     print MAIL "Content-Transfer-Encoding: $cte\n";
  191.     print MAIL "User-Agent: $ENV{'SERVER_SOFTWARE'} $prog/$id\n";
  192.     print MAIL "\n";
  193.     print MAIL $body;
  194.     if (close(MAIL)) {
  195.         print "w3m-control: DELETE_PREVBUF\r\n";
  196.         print "w3m-control: BACK\r\n";
  197.         print "\r\n";
  198.     } else {
  199.         print "Content-Type: text/html\r\n";
  200.         print "\r\n";
  201.         print "<html><head><title>W3M Mailer</title></head>\n";
  202.         print "<body><h1>W3M Mailer: close sendmail failed</h1>\n";
  203.         print "<p>", &html_quote($@), "</p>\n";
  204.         print "</body></html>\n";
  205.     }
  206.     }
  207. }
  208.  
  209. sub lang_setup {
  210.     $lang = $ENV{'LC_ALL'} || $ENV{'LC_CTYPE'} || $ENV{'LANG'};
  211.     if ($lang =~ /^ja/i) {
  212.     eval "use NKF;";
  213.     if (! $@) {
  214.         $use_NKF = 1;
  215.     } else {
  216.         $use_NKF = 0;
  217.     }
  218.     $charset = "EUC-JP";
  219.     } else {
  220.     $charset = &guess_charset($lang);
  221.     }
  222. }
  223.  
  224. sub lang_header {
  225.     if ($lang =~ /^ja/i) {
  226.     return &lang_header_ja(@_);
  227.     } else {
  228.     return &lang_header_default(@_);
  229.     }
  230. }
  231.  
  232. sub lang_body {
  233.     if ($lang =~ /^ja/i) {
  234.     return &lang_body_ja(@_);
  235.     } else {
  236.     return &lang_body_default(@_);
  237.     }
  238. }
  239.  
  240. sub lang_html_quote {
  241.     local($_) = @_;
  242.     if ($lang =~ /^ja/i) {
  243.     if (/[\x80-\xFF]/ || /\033[\$\(][BJ@]/) {
  244.         $_ = &conv_nkf("-e", $_);
  245.     }
  246.     }
  247.     return &html_quote($_);
  248. }
  249.  
  250. sub lang_header_default {
  251.     local($h) = @_;
  252.     if ($h =~ s/([=_?\x80-\xFF])/sprintf("=%02x", ord($1))/ge) {
  253.     return "=?$charset?Q?$h?=";
  254.     } else {
  255.     return $h;
  256.     }
  257. }
  258.  
  259. sub lang_body_default { 
  260.     local($body, $_7bit) = @_;
  261.     if ($body =~ /[\x80-\xFF]/) {
  262.     if ($_7bit) {
  263.         $body =~ s/([=\x80-\xFF])/sprintf("=%02x", ord($1))/ge;
  264.         return ($charset, "quoted-printable", $body);
  265.     } else {
  266.         return ($charset, "8bit", $body);
  267.     }
  268.     } else {
  269.     return ("US-ASCII", "7bit", $body);
  270.     }
  271. }
  272.  
  273. sub lang_header_ja {
  274.     local($h) = @_;
  275.     if ($h =~ /[\x80-\xFF]/ || $h =~ /\033[\$\(][BJ@]/) {
  276.     $h = &conv_nkf("-j", $h);
  277.     &conv_nkf("-M", $h);
  278.     } else {
  279.     return $h;
  280.     }
  281. }
  282.  
  283. sub lang_body_ja {
  284.     local($body, $_7bit) = @_;
  285.     if ($body =~ /[\x80-\xFF]/ || $body =~ /\033[\$\(][BJ@]/) {
  286.     if ($_7bit) {
  287.         $body = &conv_nkf("-j", $body);
  288.     }
  289.     return ("ISO-2022-JP", "7bit", $body);
  290.     } else {
  291.     return ("US-ASCII", "7bit", $body);
  292.     }
  293. }
  294.  
  295. sub conv_nkf {
  296.     local(@opt) = @_;
  297.     if ($use_NKF) {
  298.     return nkf(@opt);
  299.     }
  300.     local($body) = pop(@opt);
  301.     $body =~ s/\r+\n/\n/g;
  302.     $| = 1;
  303.     pipe(R, W2);
  304.     pipe(R2, W);
  305.     if (! fork()) {
  306.     close(F);
  307.     close(R);
  308.     close(W);
  309.     open(STDIN, "<&R2");
  310.     open(STDOUT, ">&W2");
  311.     exec "nkf", @opt;
  312.     die;
  313.     }
  314.     close(R2);
  315.     close(W2);
  316.     print W $body;
  317.     close(W);
  318.     $body = '';
  319.     while(<R>) {
  320.     $body .= $_;
  321.     }
  322.     close(R);
  323.     return $body;
  324. };
  325.  
  326.  
  327.  
  328. sub parse_opt {
  329.   local($opt) = @_;
  330.   local(%opt) = ();
  331.   if ($opt) {    
  332.       foreach $o (split('&', $opt)) {
  333.       if ($o =~ /(\w+)=(.*)/) {
  334.           $opt{"\L$1"} = &url_unquote($2);
  335.       }
  336.       }
  337.   }
  338.   return %opt;
  339. }
  340.  
  341. sub html_quote {
  342.   local($_) = @_;
  343.   local(%QUOTE) = (
  344.     '<', '<',
  345.     '>', '>',
  346.     '&', '&',
  347.     '"', '"',
  348.   );
  349.   s/[<>&"]/$QUOTE{$&}/g;
  350.   return $_;
  351. }
  352.  
  353. sub url_unquote {
  354.     local($_) = @_;
  355.     s/\+|%([0-9A-Fa-f][0-9A-Fa-f])/$& eq '+' ? ' ' : pack('c', hex($1))/ge;
  356.     return $_;
  357. }
  358.  
  359. sub guess_charset {
  360.     local(%lang_charset) = (
  361.     'cs', 'iso-8859-2',
  362.     'el', 'iso-8859-7',
  363.     'iw', 'iso-8859-8',
  364.     'ja', 'EUC-JP',
  365.     'ko', 'EUC-KR',
  366.     'hu', 'iso-8859-2',
  367.     'pl', 'iso-8859-2',
  368.     'ro', 'iso-8859-2',
  369.     'ru', 'iso-8859-5',
  370.     'sk', 'iso-8859-2',
  371.     'sl', 'iso-8859-2',
  372.     'tr', 'iso-8859-9',
  373.     'zh', 'GB2312',
  374.     );
  375.     local($_) = @_;
  376.     local($lang);
  377.  
  378.     if (! s/\.(.*)$//) {
  379.         if (/^zh_tw/i) {
  380.         return 'Big5';
  381.     }
  382.     /^(..)/;
  383.     return $lang_charset{$1} || 'iso-8859-1';
  384.     }
  385.     $lang = $_;
  386.     $_ = $1;
  387.     if (/^euc/i) {
  388.     if (/^euc$/i) {
  389.         $lang =~ /^zh_tw/ && return 'EUC-TW';
  390.         $lang =~ /^zh/ && return 'GB2312';
  391.         $lang =~ /^ko/ && return 'EUC-KR';
  392.         return 'EUC-JP';
  393.     }
  394.     /^euccn/i && return 'GB2312';
  395.     s/[\-_]//g;
  396.     s/^euc/EUC-/i;
  397.     tr/a-z/A-Z/;
  398.     } elsif (/^iso8859/i) {
  399.     s/[\-_]//g;
  400.     s/^iso8859/iso-8859-/i;
  401.     }
  402.     return $_;
  403. }
  404.