#!@PERL@ $rcsid = q$Id: w3mmail.cgi.in,v 1.5 2002/01/21 15:56:13 ukai Exp $; ($id = $rcsid) =~ s/^.*,v ([\d\.]*).*/$1/; ($prog=$0) =~ s/.*\///; $query = $ENV{'QUERY_STRING'}; $local_cookie = $ENV{'LOCAL_COOKIE'}; $SENDMAIL = '/usr/lib/sendmail'; $SENDMAIL = '/usr/sbin/sendmail' if -x '/usr/sbin/sendmail'; $SENDMAIL_OPT = '-oi -t'; 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); $body = $opt{'body'}; delete $opt{'body'}; &lang_setup; print "Content-Type: text/html\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"; print "\n"; if ($opt{'from'}) { $v = &lang_html_quote($opt{'from'}); print "
From:$v\n"; print "\n"; delete $opt{'from'}; } foreach $h ('to', 'cc', 'bcc', 'subject') { $v = &lang_html_quote($opt{$h}); print "
\u$h:\n"; delete $opt{$h}; } 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"; print "
\n"; print "\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'}; &lang_setup; if ($act eq "Preview") { print "Content-Type: text/html\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"; print "\n"; print "
\n"; print "
\n";
	foreach $h (keys %opt) {
	    $qh = &html_quote($h);
	    $v{$h} = &lang_header(&lang_html_quote($opt{$h}));
	    if ($v{$h}) {
		print "\u$qh: $v{$h}\n";
	    }
	}
	($cs,$cte,$body) = &lang_body(&lang_html_quote($body));
	print "Mime-Version: 1.0\n";
	print "Content-Type: text/plain; charset=$cs\n";
	print "Content-Transfer-Encoding: $cte\n";
	print "User-Agent: $ENV{'SERVER_SOFTWARE'} $prog/$id\n";
	print "\n";
	print $body;
	print "\n" if ($body !~ /\n$/);
	print "
\n"; print "\n"; print "
\n"; print "\n"; if ($opt{'from'}) { print "
From:$v{'from'}\n"; print "\n"; delete $opt{'from'}; } foreach $h ('to', 'cc', 'bcc', 'subject') { print "
\u$h:\n"; delete $opt{$h}; } foreach $h (keys %opt) { $qh = &html_quote($h); print "
\u$qh:$v{$h}\n"; print "\n"; } print "
\n"; print "\n"; print "
\n"; print "
\n"; print "\n"; } else { 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 "

$@

\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); print MAIL "Mime-Version: 1.0\n"; 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 "

$@

\n"; print "\n"; } } } sub lang_setup { $lang = $ENV{'LANG'}; if ($lang =~ /^ja/i) { eval "use NKF;"; if (! $@) { $use_NKF = 1; } else { $use_NKF = 0; } } } 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 "=iso-8859-1?Q?$h?="; } else { return $h; } } sub lang_body_default { local($body) = @_; if ($body =~ s/([\x80-\xFF])/sprintf("=%02x", ord($1))/ge) { return ("iso-8859-1", "quoted-printable", $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) = @_; if ($body =~ /[\x80-\xFF]/ || $body =~ /\033[\$\(][BJ@]/) { $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 '+' ? ' ' : chr(hex($1))/ge; return $_; }