#!/usr/local/bin/perl
#============================================================================
#
# i-nPOP
#
# npop.cgi
#
# Copyright (C) 1996-2002 by Tomoaki Nakashima. All rights reserved.
# http://www.nakka.com/
# nakka@nakka.com
#
#============================================================================
require 'jcode.pl';
require 'mimer.pl';
use IO::Socket;
#ファイル名
$filename = $ENV{'SCRIPT_NAME'};
#トップページのリンク先
$toppage = "/i/";
#本文受信行数
$get_line = 500;
#1ページに表示する本文のバイト数
$body_page_size = 3000;
#一覧に表示する Subject のバイト数
$list_line_size = 16 * 3;
#設定のデフォルト値
$server = "";
$port = "110";
$user = "";
$pass = "";
#i-nPOP で利用するパスワード (簡易認証)
$ipass = "";
$page_max = 5;
#============================================================================
$cur_no = 0;
$no = 0;
$offset = 0;
$apass = "";
if($ENV{'REQUEST_METHOD'} eq "POST"){
read(STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
foreach $pair (split(/[&;]/,$query_string)) {
($key, $value) = split('=', $pair, 2);
$value =~ s/\+/ /g;
$value =~ s/%(..)/pack('c',hex($1))/ge;
$form{$key} = $value;
}
if($form{'action'} eq 'setnext'){
#設定完了
$server = $form{'server'};
$port = $form{'port'};
$user = $form{'user'};
$pass = $form{'pass'};
$ipass = $form{'ipass'};
$page_max = $form{'page_max'};
&setnext();
exit;
}
$info = $form{'info'};
($server,$port,$user,$apass,$page_max,$cur_no,$no,$offset,) = split(/\,/,$info);
if($page_max eq ""){
$page_max = 5;
}
if($cur_no eq ""){
$cur_no = 0;
}
if($offset eq ""){
$offset = 0;
}
$pass = $apass;
$pass =~ s/(..)/pack('c',hex($1) ^ 0xFF)/ge;
$ipass = $form{'ipass'};
if($ipass ne $form{'inpass'}){
print "Content-type: text/html\n\n";
print "
i-nPOP/$user\n";
$err_action = "errnext";
&error("簡易認証のパスワードが間違っています");
}
if($form{'action'} eq 'set'){
#設定表示
&setpop();
}elsif($form{'action'} eq 'list'){
#一覧表示
&showlist();
}elsif($form{'action'} eq 'body'){
#本文表示
&showbody();
}elsif($form{'action'} eq 'errnext'){
&setnext();
}
}else{
#設定表示
&setpop();
}
#----------------------------------------------------------------------------
sub setpop {
print "Content-type: text/html\n\n";
print <i-nPOP 設定
i-nPOP 設定
使い方
EOM
}
#----------------------------------------------------------------------------
sub setnext {
print "Content-type: text/html\n\n";
print "i-nPOP/$user\n";
#エラーチェック
$err_action = "set";
if($pass eq ""){
&error("パスワードが入力されていません");
}else{
#パスワードの暗号化
$apass = $pass;
$apass =~ s/(.)/sprintf("%2x", unpack('c', $1) ^ 0xFF)/eg;
}
if($server eq ""){
&error("POP3サーバが入力されていません");
}
if($port eq ""){
&error("ポート番号が入力されていません");
}
if($port =~ /[^0-9]/){
&error("ポート番号は数値のみです");
}
if($user eq ""){
&error("ユーザ名が入力されていません");
}
if($ipass eq ""){
&error("簡易認証が入力されていません");
}
if($page_max =~ /[^0-9]/){
&error("1ページ表\示件数は数値のみです");
}
#ログイン可能かチェック
&pop_connect();
&pop_close();
print <
お知らせ
ここを「画面メモ」すると次回設定の手間が省けます。
EOM
}
#----------------------------------------------------------------------------
sub showlist {
local($cnt, $i, $mno, $size, $len, @chars);
print "Content-type: text/html\n\n";
print "i-nPOP/$user\n";
print "$server/$user
\n";
#接続
&pop_connect();
#メール件数取得
$cnt = &pop_getcount();
#一覧作成
$i = $cur_no;
while($i < ($cur_no + $page_max)){
$mno = $cnt - $i;
if($mno <= 0){
last;
}
&pop_getmessage($mno, 0);
$len = $list_line_size - length("$mno") - 1;
if(length($head{'subject'}) > $len){
#文字列を分解 (SJIS)
@chars = $head{'subject'} =~ /([\x81-\x9F|\xE0-\xFC].|.)/og;
$head{'subject'} = "";
$len -= 3;
#長い文字列を切り捨て
for(@chars){
$len -= length($_);
if($len <= 0){
last;
}
$head{'subject'} .= $_;
}
$head{'subject'} .= "...";
}
$size = sprintf("%.0fK", $head{'size'} / 1024);
print <
$head{'subject'}
亮\;$head{'from'}
$head{'date'}($size)
EOM
$i++;
}
&pop_close();
if($cur_no < $cnt - 5){
#次のページに移動するボタン
$next_no = $cur_no + $page_max;
print <
EOM
}
if($cur_no > 0){
#前のページに移動するボタン
$next_no = $cur_no - $page_max;
print <
EOM
}
print <
EOM
print "";
}
#----------------------------------------------------------------------------
sub showbody {
local($i, $size, $buf, $buf_length, $quot);
print "Content-type: text/html\n\n";
print "i-nPOP/$user\n";
#接続
&pop_connect();
#本文取得
&pop_getmessage($no, $get_line);
&pop_close();
#ヘッダ表示
print "$head{'subject'}
";
if($head{'subject'} !~ /^Re:/i){
$head{'subject'} = "Re\:" . $head{'subject'};
}
print "亮\;$head{'from'}
\n";
#後の空行を除去
if($#message > 1){
while($message[-1] eq ''){
pop @message;
}
}
#前の空行を除去
for($i = $offset; $i <= $#message; $i++) {
if($message[$i] ne ""){
last;
}
}
#本文表示
$quot = 0;
for(; $i <= $#message; $i++){
$buf = $message[$i];
if($buf eq ""){
#連続した空行をスキップ
while($i+1 <= $#message && $message[$i + 1] eq ""){
$i++;
}
}
$buf_length = length($buf);
$size = $size + $buf_length;
if($size > $body_page_size){
last;
}
#引用行に色を付ける
if($buf =~ /^>/){
if($quot == 0){
$quot = 1;
$buf = "$buf";
}
}elsif($quot == 1){
$quot = 0;
$buf .= "";
}
print "$buf
\n";
}
if($quot == 1){
print "";
}
print "
";
if($i <= $#message){
print <
EOM
}
print <
EOM
}
#----------------------------------------------------------------------------
sub pop_connect {
#接続
$remote = IO::Socket::INET->new(Proto => "tcp",
PeerAddr => $server,
PeerPort => $port,
) || &error("接続に失敗しました");
$remote->autoflush(1);
&expect_ok();
#ログイン
print $remote "USER $user\r\n";
&expect_ok();
print $remote "PASS $pass\r\n";
&expect_ok();
}
#----------------------------------------------------------------------------
sub pop_close {
print $remote "QUIT\r\n";
&expect_ok();
close $remote;
}
#----------------------------------------------------------------------------
sub pop_getcount {
local($line, $st, $size);
print $remote "STAT\r\n";
$line = &expect_ok();
($st,$cnt,$size) = split(' ', $line);
return $cnt;
}
#----------------------------------------------------------------------------
sub pop_getmessage {
local($mno) = $_[0];
local($len) = $_[1];
local($buf, $lst, $lno, $lsize, @headbuf,$mail_regex, @chars);
undef %head;
#メールサイズ取得
print $remote "LIST $mno\r\n";
$buf = &expect_ok();
($lst,$lno,$lsize) = split(/\s+/, $buf);
$head{'size'} = $lsize;
#メッセージ取得
print $remote "TOP $mno $len\r\n";
&expect_ok();
#ヘッダ取得
@headbuf = ('');
while(<$remote>){
s/[\r\n]*$//;
if($_ eq "." || $_ eq ""){
last;
}
if(/^\s+/){
s/^\s+//;
$headbuf[-1] .= $_;
}else{
push(@headbuf, $_);
}
}
shift @headbuf;
for(@headbuf){
if(/^Subject:/i){
#件名取得
s/^Subject:\s+//i;
$_ = &mimedecode($_, "SJIS");
$head{'subject'} = &compress_line($_);
}elsif(/^From:/i){
#差出人取得
s/^From:\s+//i;
$head{'from'} = &getaddress($_);
}elsif(/^Date:/i){
#送信日時取得
s/^Date:\s+//;
$head{'date'} = &dateconv($_);
}
}
if($head{'subject'} eq ""){
$head{'subject'} = "(no-title)";
}
#本文取得
$falg = 0;
@message = ();
while(<$remote>){
s/[\r\n]*$//;
if($_ eq "."){
last;
}
&jcode'convert(*_,"sjis");
$_ = &compress_line($_);
#URLをリンク
s/>/\t/g;
s/(https?|ftp|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1\:$2<\/A>/ig;
s/\t/>/g;
#メールアドレスをリンク (SJIS)
@chars = $_ =~ /([\x81-\x9F|\xE0-\xFC].|[^\x81-\x9F|\xE0-\xFC]+)/og;
$buf = "";
for(@chars){
if(/^[^\x81-\x9F|\xE0-\xFC]/){
s/([\w|\-\.]+)\@([\w|\-\.]+)/$1\@$2<\/A>/ig;
}
$buf .= $_;
}
push(@message, $buf);
}
}
#----------------------------------------------------------------------------
sub compress_line {
local($line) = @_;
local($str);
&jcode'convert(*line,"jis");
$str = "0-9A-Za-z";
&jcode'convert(*str, "jis");
&jcode'tr(*line, $str, "0-9A-Za-z");
&jcode'convert(*line,"sjis");
&jcode'tr(*line, "!“”#$%&’()*+,./", "!\"\"#\$%&'()*+,.\/");
&jcode'tr(*line, ":;<=>?@", ":;<=>?@");
&jcode'tr(*line, "[¥]^_`", "[\\]^_`");
&jcode'tr(*line, "{|}〜", "{|}~");
&jcode'tr(*line, " ", " ");
$line =~ s/(\W+) +(\w+)/$1$2/g;
$line =~ s/(\w+) +(\W+)/$1$2/g;
$line =~ s/(\W+) +(\W+)/$1$2/g;
$line =~ s/\t/ /g;
$line =~ s/ +/ /g;
$line =~ s/^\s+//;
$line =~ s/\s+$//;
$line =~ s/&/&/g;
$line =~ s/</g;
$line =~ s/>/>/g;
return $line;
}
#----------------------------------------------------------------------------
sub getaddress {
local($line_original) = @_;
local(@adrs, $line);
$line_original =~ s/\((.*)\)//g;
$line_original =~ s/"([^"]*)"//g;
@adrs = split(",", $line_original);
while(@adrs){
$adrs = shift(@adrs);
if ($adrs =~ /) {
$adrs =~ /<(.*)>/;
$line .= $1 . ",";
} else {
$line .= $adrs . ",";
}
}
$line =~ s/\s+//g;
chop($line);
return $line;
}
#----------------------------------------------------------------------------
sub dateconv {
local($date) = @_;
local($w, $d, $m, $y, $t, $tz, $mt, $h, $min, $s, $i);
@month = (
"Jan", "Feb", "Mar", "Apr",
"May", "Jun", "Jul", "Aug",
"Sep", "Oct", "Nov", "Dec",
);
($w,$d,$m,$y,$t,$tz) = split(' ',$date);
if($tz eq "" || $t eq "" || $y eq "" || $m eq "" || $d eq ""){
$cdate = $date;
}else{
for($i = 0; $i <= $#month; $i++){
if($month[$i] eq $m){
$mt = $i + 1;
last;
}
}
if($mt eq ""){
$cdate = $date;
}else{
($h,$min,$s) = split(':',$t);
$cdate = sprintf("%d/%d %d:%02d", $mt, $d, $h, $min);
}
}
return $cdate;
}
#----------------------------------------------------------------------------
sub expect_ok {
local($qres);
$res = <$remote>;
if($res =~ /^\+OK/){
return $res;
}
print $remote "QUIT\r\n";
$qres = <$remote>;
close $remote;
&error($res);
}
#----------------------------------------------------------------------------
sub error{
local($msg) = @_;
if($err_action eq ""){
$err_action = "list";
}
print <Error
$msg
TOP