405 lines
9.7 KiB
Plaintext
Executable File
405 lines
9.7 KiB
Plaintext
Executable File
#!@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 = <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);
|
|
$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 "<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 $_;
|
|
}
|