#!@PERL@ $rcsid = q$Id: w3mmail.cgi.in,v 1.14 2004/08/30 16:32:24 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 = ; 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 "W3M Mailer: $qurl\n"; print "

W3M Mailer: $qurl

\n"; print "\n"; print "\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 "W3M Mailer\n"; print "\n"; print "

W3M Mailer: preview

\n"; print "

\n"; $local_cookie = &html_quote($local_cookie); print "\n"; print "

\n"; print "

\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 "

\n"; print "\n"; print "

\n"; print "\n"; foreach $h ('from', 'to', 'cc', 'bcc', 'subject') { print "

\u$h:	\n"; delete $opt{$h}; } if ($boundary) { print "
Content-Type:	Content-Type: multipart/form-data; boundary=\"$boundary\"\n"; print "\n"; } foreach $h (keys %opt) { $qh = &html_quote($h); print "
\u$qh:	$v{$h}\n"; print "\n"; } print "
\n"; print "\n"; if ($body) { print $body; } print "\n"; print "

\n"; print "
\n"; print "\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 "W3M Mailer\n"; print "

W3M Mailer: open sendmail failed

\n"; print "

", &html_quote($@), "

\n"; print "\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); $body =~ s/\r//g; 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 "W3M Mailer\n"; print "

W3M Mailer: close sendmail failed

\n"; print "

", &html_quote($@), "

\n"; print "\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() { $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 $_; }

\u$h:	\n"; delete $opt{$h}; } if ($boundary) { $boundary = &html_quote($boundary); print "
Content-Type:	multipart/form-data; boundary=\"$boundary\"\n"; print "\n"; } foreach $h (keys %opt) { $qh = &html_quote($h); $v = &lang_html_quote($opt{$h}); print "
\u$h:	$v\n"; print "\n"; } print "
\n"; print "\n"; if ($body) { print &lang_html_quote($body); } print "\n"; print "