#!@PERL@
$rcsid = q$Id: w3mmail.cgi.in,v 1.6 2002/01/27 18:59:58 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 "<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";
print "<input type='hidden' name='cookie' value='$local_cookie'>\n";
print "<table>\n";
if ($opt{'from'}) {
$v = &lang_html_quote($opt{'from'});
print "<tr><td width=80>From:<td>$v\n";
print "<input type='hidden' name='from' value=\"$v\">\n";
delete $opt{'from'};
}
foreach $h ('to', 'cc', 'bcc', 'subject') {
$v = &lang_html_quote($opt{$h});
print "<tr><td width=80>\u$h:<td><input type='text' name=\"$h\" value=\"$v\">\n";
delete $opt{$h};
}
foreach $h (keys %opt) {
$qh = &html_quote($h);
$v = &lang_html_quote($opt{$h});
print "<tr><td width=80>\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'};
&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 "<html><head><title>W3M Mailer</title></head>\n";
print "<body>\n";
print "<h1>W3M Mailer: preview</h1>\n";
print "<form action='$0' method='POST'>\n";
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_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 "</pre>\n";
print "<input type='submit' name='action' value='Send'>\n";
print "<hr>\n";
print "<table>\n";
if ($opt{'from'}) {
print "<tr><td width=80>From:<td>$v{'from'}\n";
print "<input type='hidden' name='from' value=\"$v\">\n";
delete $opt{'from'};
}
foreach $h ('to', 'cc', 'bcc', 'subject') {
print "<tr><td width=80>\u$h:<td><input type='text' name=\"$h\" value=\"$v{$h}\">\n";
delete $opt{$h};
}
foreach $h (keys %opt) {
$qh = &html_quote($h);
print "<tr><td width=80>\u$qh:<td>$v{$h}\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 $body;
}
print "</textarea>\n";
print "</table>\n";
print "<input type='submit' name='action' value='Preview'><br>\n";
print "</body></html>\n";
} else {
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>$@</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);
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 "<html><head><title>W3M Mailer</title></head>\n";
print "<body><h1>W3M Mailer: close sendmail failed</h1>\n";
print "<p>$@</p>\n";
print "</body></html>\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(<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 $_;
}
