#!/usr/bin/perl
# todo 2kごとに分割するようにしなければならない。
use Net::POP3;
require "cgi-lib.pl";
require "jcode.pl";
Main:
{
&ReadParse(*input);
if( $input{'pass'} ){
$server = $input{'server'};
$pass = $input{'pass'};
$account = $input{'account'};
$mpop = Net::POP3->new($server) || &error(1);
$mpop->login($account, $pass) || &error(2);
if($input{'mail'} ){
&show_mail;
}else{
&list;
}
}else{
&input;
}
}
sub show_mail{
print "Content-Type: text/html\n\n";
print "remote mail".
"".
"\n";
foreach $mail ($input{'mail'} ){
my $check = 0;
$line = $mpop->get($mail);
for $one_line (@$line){
if($check){
&jcode::convert(\$one_line, "sjis");
&jcode::z2h_sjis(\$one_line);
print "$one_line
\n";
}elsif($one_line =~ /^From/){
$one_line =~ s/=\?ISO-2022-JP\?B\?(.*)\?=/&old_decode_base64($1)/gei;
$one_line =~ /([\w\d\.-]*\b@[\w\d\.-]*)/;
$from = $1;
$name = $`.$';
$name =~ /^From[:\s]+(.*)/;
$name = $1;
$name =~ s/[\"\s<>()（） ]//g; #"
$from = $name if $name;
&jcode::convert(\$from, "sjis");
&jcode::z2h_sjis(\$one_line);
$multi_line = 2;
}elsif($one_line =~ /^Subject/){
$one_line =~ s/=\?ISO-2022-JP\?B\?(.*)\?=/&old_decode_base64($1)/gei;
$subject = $one_line;
$subject =~ s/^Subject[: ]*//;
&jcode::convert(\$subject, "sjis");
&jcode::z2h_sjis(\$one_line);
$multi_line=1;
}elsif($one_line =~/^$/){
$check=1;
print &jcode::sjis("差出人");
print "$from
";
print &jcode::sjis("件名");
print "$subject
==========
\n";
}elsif( $multi_line){
if($one_line =~ /^\s.*/ ){
if($multi_line == 1){
$one_line =~ s/=\?ISO-2022-JP\?B\?(.*)\?=/&old_decode_base64($1)/geim;
&jcode::convert(\$one_line, "sjis");
&jcode::z2h_sjis(\$one_line);
$subject .= $one_line;
}elsif($multi_line == 2){
$one_line =~ s/=\?ISO-2022-JP\?B\?(.*)\?=/&old_decode_base64($1)/geim;
&jcode::convert(\$one_line, "sjis");
&jcode::z2h_sjis(\$one_line);
$from .= $one_line;
}
}else{
$multi_line=0;
}
}
}
}
print "";
}
sub list{
print "Content-Type: text/html\n\n";
print "remote mail\n";
$end = $mpop->last();
print "$end new messages
\n";
print "";
$mpop->quit();
print "";
}
sub old_decode_base64 ($)
{
local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
my $str = shift;
my $res = "";
$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
if (length($str) % 4) {
require Carp;
Carp::carp("Length of base64 data not a multiple of 4")
}
$str =~ s/=+$//; # remove padding
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
while ($str =~ /(.{1,60})/gs) {
my $len = chr(32 + length($1)*3/4); # compute length byte
$res .= unpack("u", $len . $1 ); # uudecode
}
$res;
}
sub input{
print "Content-type: text/html\n\n";
print "\n";
print "Input Password\n";
print "\n";
print "サーバとアカウント、パスワードを入力しましょう
\n";
print "
\n";
print "";
}
sub error($){
($error) = @_;
print "Content-type: text/html\n\n";
print "Error\n\n";
print "エラー発生
\n
\n";
if ($error == 1){
print "サーバの名前が違います。
\n";
print "サーバにアクセスできませんでした。";
}elsif($error == 2){
print "アカウント名、パスワードが違います。
";
print "サーバにアクセスできませんでした。";
}
print "
\n";
exit(1);
}
# $Log: mail.txt,v $
# Revision 1.1.1.1 2001/07/09 16:37:30 kenstar
# start
#
# Revision 1.6 2000/06/06 03:52:17 kenstar
#
# こちらの方が動作が安定しているように見受けられるため、
# CGI.pmから、cgi-lib.plを使うようにした。
#
# Revision 1.5 2000/06/05 09:47:48 kenstar
#
# 全角カタカナを半角カタカナへ変更。
# Jcodeモジュールではなく、jcode.plを利用するようにした。
#
# Revision 1.4 2000/06/02 08:13:25 kenstar
#
# 長い件名も表示可能。
# サーバへのログイン失敗時の対処(&error($))
#
# Revision 1.3 2000/06/01 14:49:35 kenstar
#
# POPserver, account, passwordをいちいち打つようにした。
# ただし、i-modeからの利用は（恐らく）めんどうになってしまう。
# メンバー制にできるようにしなければならないだろう。
#
# Revision 1.2 2000/06/01 14:29:05 kenstar
#
# パスワードによる認証をかけ、
# さらに日本語の件名をしっかりと表示できるように改良。
#