aboutsummaryrefslogtreecommitdiffstats
path: root/scripts/w3mmail.cgi.in
diff options
context:
space:
mode:
authorTatsuya Kinoshita <tats@vega.ocn.ne.jp>2011-05-04 07:18:09 +0000
committerTatsuya Kinoshita <tats@vega.ocn.ne.jp>2011-05-04 07:18:09 +0000
commit5f8e0f8ef9a422691dd72e8a953a42a41478fcb4 (patch)
tree4b2df4796a534793648b3c4fc532fc36bd0cd525 /scripts/w3mmail.cgi.in
parentReleasing debian version 0.3-2.4 (diff)
downloadw3m-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-xscripts/w3mmail.cgi.in403
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) = (
+ '<', '&lt;',
+ '>', '&gt;',
+ '&', '&amp;',
+ '"', '&quot;',
+ );
+ 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 $_;
+}