diff options
author | Tatsuya Kinoshita <tats@vega.ocn.ne.jp> | 2011-05-04 07:18:09 +0000 |
---|---|---|
committer | Tatsuya Kinoshita <tats@vega.ocn.ne.jp> | 2011-05-04 07:18:09 +0000 |
commit | 5f8e0f8ef9a422691dd72e8a953a42a41478fcb4 (patch) | |
tree | 4b2df4796a534793648b3c4fc532fc36bd0cd525 /scripts/w3mmail.cgi.in | |
parent | Releasing debian version 0.3-2.4 (diff) | |
download | w3m-7867af0e1dc0477b9fdc08cf6e3aee68f03ae9f1.tar.gz w3m-7867af0e1dc0477b9fdc08cf6e3aee68f03ae9f1.zip |
Releasing debian version 0.5.1-1debian/0.5.1-1
Diffstat (limited to 'scripts/w3mmail.cgi.in')
-rwxr-xr-x | scripts/w3mmail.cgi.in | 403 |
1 files changed, 403 insertions, 0 deletions
diff --git a/scripts/w3mmail.cgi.in b/scripts/w3mmail.cgi.in new file mode 100755 index 0000000..670f26c --- /dev/null +++ b/scripts/w3mmail.cgi.in @@ -0,0 +1,403 @@ +#!@PERL@ + +$rcsid = q$Id: w3mmail.cgi.in,v 1.13 2003/09/22 21:02:29 ukai Exp $; +($id = $rcsid) =~ s/^.*,v ([\d\.]*).*/$1/; +($prog=$0) =~ s/.*\///; + +$query = $ENV{'QUERY_STRING'}; +$cookie_file = $ENV{'LOCAL_COOKIE_FILE'}; +$local_cookie = ''; +$SENDMAIL = '/usr/lib/sendmail'; +$SENDMAIL = '/usr/sbin/sendmail' if -x '/usr/sbin/sendmail'; +$SENDMAIL_OPT = '-oi -t'; + +if (-f $cookie_file) { + open(F, "< $cookie_file"); + $local_cookie = <F>; + close(F); +} +if ($query =~ s/^\w+://) { + $url = $query; + $qurl = &html_quote($url); + $to = $query; + $opt = ''; + if ($to =~ /^([^?]*)\?(.*)$/) { + $to = $1; + $opt = $2; + } + $to = &url_unquote($to); + %opt = &parse_opt($opt); + + @to = ($to); + push(@to, $opt{'to'}) if ($opt{'to'}); + $opt{'to'} = join(',', @to); + if ($ENV{'REQUEST_METHOD'} eq 'POST') { + sysread(STDIN, $body, $ENV{'CONTENT_LENGTH'}); + $content_type = $ENV{'CONTENT_TYPE'}; + if ($content_type =~ /^multipart\/form-data;\s+boundary=(.*)$/) { + $boundary = $1; + } + } else { + $body = $opt{'body'}; + delete $opt{'body'}; + } + &lang_setup; + + print "Content-Type: text/html; charset=$charset\r\n"; + print "w3m-control: END\r\n"; + print "w3m-control: PREV_LINK\r\n"; + print "\r\n"; + print "<html><head><title>W3M Mailer: $qurl</title></head>\n"; + print "<body><h1>W3M Mailer: $qurl</h1>\n"; + print "<form action=\"file://$0\" method='POST'>\n"; + $local_cookie = &html_quote($local_cookie); + print "<input type='hidden' name='cookie' value=\"$local_cookie\">\n"; + print "<table>\n"; + foreach $h ('from', 'to', 'cc', 'bcc', 'subject') { + $v = &lang_html_quote($opt{$h}); + print "<tr><td>\u$h:<td><input type='text' name=\"$h\" value=\"$v\">\n"; + delete $opt{$h}; + } + if ($boundary) { + $boundary = &html_quote($boundary); + print "<tr><td>Content-Type:<td>multipart/form-data; boundary=\"$boundary\"\n"; + print "<input type='hidden' name='boundary' value=\"$boundary\">\n"; + } + foreach $h (keys %opt) { + $qh = &html_quote($h); + $v = &lang_html_quote($opt{$h}); + print "<tr><td>\u$h:<td>$v\n"; + print "<input type='hidden' name=\"$qh\" value=\"$v\">\n"; + } + print "<tr><td colspan=2>\n"; + print "<textarea cols=40 rows=10 name='body'>\n"; + if ($body) { + print &lang_html_quote($body); + } + print "</textarea>\n"; + print "</table>\n"; + print "<input type='submit' name='action' value='Preview'>\n"; + print "</form>\n"; + print "</body></html>\n"; + exit(0); +} else { + sysread(STDIN, $req, $ENV{'CONTENT_LENGTH'}); + %opt = &parse_opt($req); + if ($local_cookie ne $opt{'cookie'}) { + print "Content-Type: text/plain\r\n"; + print "\r\n"; + print "Local cookie doesn't match: It may be an illegal execution\n"; + exit 1; + } + delete $opt{'cookie'}; + $body = $opt{'body'}; + delete $opt{'body'}; + $act = $opt{'action'}; + delete $opt{'action'}; + $boundary = $opt{'boundary'}; + delete $opt{'boundary'}; + &lang_setup; + + if ($act eq "Preview") { + print "Content-Type: text/html; charset=$charset\r\n"; + print "w3m-control: DELETE_PREVBUF\r\n"; + print "w3m-control: NEXT_LINK\r\n"; + print "\r\n"; + print "<html><head><title>W3M Mailer</title></head>\n"; + print "<body>\n"; + print "<h1>W3M Mailer: preview</h1>\n"; + print "<form action=\"file://$0\" method='POST'>\n"; + $local_cookie = &html_quote($local_cookie); + print "<input type='hidden' name='cookie' value=\"$local_cookie\">\n"; + print "<hr>\n"; + print "<pre>\n"; + foreach $h (keys %opt) { + $qh = &html_quote($h); + $v{$h} = &lang_html_quote($opt{$h}); + if ($v{$h}) { + print "\u$qh: $v{$h}\n"; + } + } + ($cs,$cte,$body) = &lang_body(&lang_html_quote($body), 0); + print "Mime-Version: 1.0\n"; + if ($boundary) { + $boundary = &html_quote($boundary); + print "Content-Type: multipart/form-data;\n"; + print " boundary=\"$boundary\"\n"; + } else { + print "Content-Type: text/plain; charset=$cs\n"; + } +# print "Content-Transfer-Encoding: $cte\n"; + print "User-Agent: ", &html_quote("$ENV{'SERVER_SOFTWARE'} $prog/$id"), + "\n"; + print "\n"; + print $body; + print "\n" if ($body !~ /\n$/); + print "</pre>\n"; + print "<input type='submit' name='action' value='Send'>\n"; + print "<hr>\n"; + print "<table>\n"; + foreach $h ('from', 'to', 'cc', 'bcc', 'subject') { + print "<tr><td>\u$h:<td><input type='text' name=\"$h\" value=\"$v{$h}\">\n"; + delete $opt{$h}; + } + if ($boundary) { + print "<tr><td>Content-Type:<td>Content-Type: multipart/form-data; boundary=\"$boundary\"\n"; + print "<input type='hidden' name=\"boundary\" value=\"$boundary\">\n"; + } + foreach $h (keys %opt) { + $qh = &html_quote($h); + print "<tr><td>\u$qh:<td>$v{$h}\n"; + print "<input type='hidden' name=\"$qh\" value=\"$v{$h}\">\n"; + } + print "<tr><td colspan=2>\n"; + print "<textarea cols=40 rows=10 name=body>\n"; + if ($body) { + print $body; + } + print "</textarea>\n"; + print "</table>\n"; + print "<input type='submit' name='action' value='Preview'><br>\n"; + print "</body></html>\n"; + } else { +# XXX: quote? +# if ($opt{'from'}) { +# $sendmail_fromopt = '-f' . $opt{'from'}; +# } + unless (open(MAIL, "|$SENDMAIL $SENDMAIL_OPT")) { + print "Content-Type: text/html\r\n"; + print "\r\n"; + print "<html><head><title>W3M Mailer</title></head>\n"; + print "<body><h1>W3M Mailer: open sendmail failed</h1>\n"; + print "<p>", &html_quote($@), "</p>\n"; + print "</body></html>\n"; + exit(0); + } + foreach $h (keys %opt) { + $v = &lang_header($opt{$h}); + if ($v) { + print MAIL "\u$h: $v\n"; + } + } + ($cs,$cte,$body) = &lang_body($body, 1); + print MAIL "Mime-Version: 1.0\n"; + if ($boundary) { + print MAIL "Content-Type: multipart/form-data;\n"; + print MAIL " boundary=\"$boundary\"\n"; + } else { + print MAIL "Content-Type: text/plain; charset=$cs\n"; + } + print MAIL "Content-Transfer-Encoding: $cte\n"; + print MAIL "User-Agent: $ENV{'SERVER_SOFTWARE'} $prog/$id\n"; + print MAIL "\n"; + print MAIL $body; + if (close(MAIL)) { + print "w3m-control: DELETE_PREVBUF\r\n"; + print "w3m-control: BACK\r\n"; + print "\r\n"; + } else { + print "Content-Type: text/html\r\n"; + print "\r\n"; + print "<html><head><title>W3M Mailer</title></head>\n"; + print "<body><h1>W3M Mailer: close sendmail failed</h1>\n"; + print "<p>", &html_quote($@), "</p>\n"; + print "</body></html>\n"; + } + } +} + +sub lang_setup { + $lang = $ENV{'LC_ALL'} || $ENV{'LC_CTYPE'} || $ENV{'LANG'}; + if ($lang =~ /^ja/i) { + eval "use NKF;"; + if (! $@) { + $use_NKF = 1; + } else { + $use_NKF = 0; + } + $charset = "EUC-JP"; + } else { + $charset = &guess_charset($lang); + } +} + +sub lang_header { + if ($lang =~ /^ja/i) { + return &lang_header_ja(@_); + } else { + return &lang_header_default(@_); + } +} + +sub lang_body { + if ($lang =~ /^ja/i) { + return &lang_body_ja(@_); + } else { + return &lang_body_default(@_); + } +} + +sub lang_html_quote { + local($_) = @_; + if ($lang =~ /^ja/i) { + if (/[\x80-\xFF]/ || /\033[\$\(][BJ@]/) { + $_ = &conv_nkf("-e", $_); + } + } + return &html_quote($_); +} + +sub lang_header_default { + local($h) = @_; + if ($h =~ s/([=_?\x80-\xFF])/sprintf("=%02x", ord($1))/ge) { + return "=?$charset?Q?$h?="; + } else { + return $h; + } +} + +sub lang_body_default { + local($body, $_7bit) = @_; + if ($body =~ /[\x80-\xFF]/) { + if ($_7bit) { + $body =~ s/([=\x80-\xFF])/sprintf("=%02x", ord($1))/ge; + return ($charset, "quoted-printable", $body); + } else { + return ($charset, "8bit", $body); + } + } else { + return ("US-ASCII", "7bit", $body); + } +} + +sub lang_header_ja { + local($h) = @_; + if ($h =~ /[\x80-\xFF]/ || $h =~ /\033[\$\(][BJ@]/) { + $h = &conv_nkf("-j", $h); + &conv_nkf("-M", $h); + } else { + return $h; + } +} + +sub lang_body_ja { + local($body, $_7bit) = @_; + if ($body =~ /[\x80-\xFF]/ || $body =~ /\033[\$\(][BJ@]/) { + if ($_7bit) { + $body = &conv_nkf("-j", $body); + } + return ("ISO-2022-JP", "7bit", $body); + } else { + return ("US-ASCII", "7bit", $body); + } +} + +sub conv_nkf { + local(@opt) = @_; + if ($use_NKF) { + return nkf(@opt); + } + local($body) = pop(@opt); + $body =~ s/\r+\n/\n/g; + $| = 1; + pipe(R, W2); + pipe(R2, W); + if (! fork()) { + close(F); + close(R); + close(W); + open(STDIN, "<&R2"); + open(STDOUT, ">&W2"); + exec "nkf", @opt; + die; + } + close(R2); + close(W2); + print W $body; + close(W); + $body = ''; + while(<R>) { + $body .= $_; + } + close(R); + return $body; +}; + + + +sub parse_opt { + local($opt) = @_; + local(%opt) = (); + if ($opt) { + foreach $o (split('&', $opt)) { + if ($o =~ /(\w+)=(.*)/) { + $opt{"\L$1"} = &url_unquote($2); + } + } + } + return %opt; +} + +sub html_quote { + local($_) = @_; + local(%QUOTE) = ( + '<', '<', + '>', '>', + '&', '&', + '"', '"', + ); + s/[<>&"]/$QUOTE{$&}/g; + return $_; +} + +sub url_unquote { + local($_) = @_; + s/\+|%([0-9A-Fa-f][0-9A-Fa-f])/$& eq '+' ? ' ' : pack('c', hex($1))/ge; + return $_; +} + +sub guess_charset { + local(%lang_charset) = ( + 'cs', 'iso-8859-2', + 'el', 'iso-8859-7', + 'iw', 'iso-8859-8', + 'ja', 'EUC-JP', + 'ko', 'EUC-KR', + 'hu', 'iso-8859-2', + 'pl', 'iso-8859-2', + 'ro', 'iso-8859-2', + 'ru', 'iso-8859-5', + 'sk', 'iso-8859-2', + 'sl', 'iso-8859-2', + 'tr', 'iso-8859-9', + 'zh', 'GB2312', + ); + local($_) = @_; + local($lang); + + if (! s/\.(.*)$//) { + if (/^zh_tw/i) { + return 'Big5'; + } + /^(..)/; + return $lang_charset{$1} || 'iso-8859-1'; + } + $lang = $_; + $_ = $1; + if (/^euc/i) { + if (/^euc$/i) { + $lang =~ /^zh_tw/ && return 'EUC-TW'; + $lang =~ /^zh/ && return 'GB2312'; + $lang =~ /^ko/ && return 'EUC-KR'; + return 'EUC-JP'; + } + /^euccn/i && return 'GB2312'; + s/[\-_]//g; + s/^euc/EUC-/i; + tr/a-z/A-Z/; + } elsif (/^iso8859/i) { + s/[\-_]//g; + s/^iso8859/iso-8859-/i; + } + return $_; +} |