#!/usr/local/bin/perl
#
# Mariko System Doujinshi version 1.00
#
# Copyright 1996-97 by Yuuki Mimori && Minako Aino
# (mailto: mimori@puni.net )
#

# 環境変数をセットします。
# このあたりを自分の環境にあわせれば動くはず。

$tmpfile="\/home\/mimori\/tmp\/tmpfile\.$$";    # テンポラリファイル
$dir='/home/mimori/xmldir';                     # メーリングリストディレクトリ
$admin='kerokero-request@princess.moemoe.or.jp'; # 管理人アドレス
$server='princess.moemoe.or.jp';                # このマシン。
$smtp_server=$server;                           # smtp サーバー。
                                                # 別のマシンの場合もあるため。
$mlname='Kerokero mailing list';                # メーリングリストの名前
$bracket="KEROKERO";                            # Subject: [...] に入る名前
$address='kerokero@princess.moemoe.or.jp';      # メーリングリストアドレス
$logfile="log";                                 # ログファイル名
$memberfile="members";                          # メンバーファイルの名前。
                                                # これを actives にすれば
                                                # fml/hml コンパチになる。
                                                # 1行にアドレス１つずつ書く。
$idfile="id";                                   # Mail-count を格納する
                                                # ファイル名。


$remailer="Mariko-d ver 1.00 ($server)";        # このソフトのバージョン
$telnet='telnet';
$cat='cat';
$ENV{'PATH'}='/usr/local/bin:/usr/bin:/usr/sbin:/usr/ucb:/bin';

#  以上の様にアプリケーションを設定します。まあ telnet とかが
#  違う名前、ということはあまりないでしょうが。

chdir $dir || die "Can't chdir to $dir\n";
# MLのホームにChdir します。移動出来なかったらエラー終了。

&lock;     # Mail Count のファイルはみんなで共有するため、ロックを
           # かけて同時にアクセス出来ないようにしておきます。
           # 金のリボンでほら、ロックロック（笑）

if(-r $idfile){
    open(ID, "< $idfile");
    $id=scalar(<ID>);
    close(ID);
}else{
    $id=0;
}

$id++;
open(ID, "> $id") || die "Can't write $id\n";
print ID $id;
close(ID);

# $id のファイルを読み、1足して$idに再度格納する、という処理です。
#ちなみになければ自動生成します。

&unlock;   # もう $id への処理は終了したのでロックを解除します。
           # ロックはいらない〜（笑）

open (FILE, "> $tmpfile");      # 一旦メールを書き出すための作業ファイ
                                # ルを開く

while(<STDIN>){                 # メール全体を処理。
	if (1 .. /^$/){         # ヘッダ行の場合の処理。1行目から改行
                                # だけの行まで

		if ($_=~/^$/o){
	              ;
	        }elsif ($_=~/^Reply\-to\s*:\s*(.*)/io){
	                $reply=$1;       # Reply-To があれば保存。
                }elsif ($_=~/^Return-Path\s*:\s*(.*)/io){
                        $ufrom=$1;       # Unix-From を log に保存。
		}elsif ($_=~/^From\s*:\s*(.*)/io){
                        print FILE $_;
	                chop;
	                $fr=$1;          # From を log に保存。
		}elsif ($_=~/^Date\s*:\s*(.*)/io){
                        print FILE $_;
	                chop;
	                $da=$1;          # Date を log に保存。
		}elsif ($_=~/^Subject\s*:\s*(.*)/io){
	                chop;
	                $su=$1;          # Subject も保存。[hoge:001]
                                         # の処理のためまだメールに
                                         # 書き出さない。

		}else{

       			print FILE $_;   # それ以外のヘッダは素通り。
		}
		$lastheader=$.;
	}
#  ここまではヘッダの処理。
        elsif ($. == $lastheader+1){    # ヘッダ処理が終った。
                                        # さらにヘッダの追加。

		$su =~ s/\[$bracket:[\s\d]*\]\s*//io;

# Subject の処理。リプライのメールだと Subject: [..] Re: [..] [..]...
# となってしまうので、前もって古いブラケットを落す。

		print FILE "Subject: [$bracket: $id] $su\n";

# で、ブラケットをつける。

		if ($reply){                     # Reply-To がもとからあった
			print FILE "Reply-To: $reply\n";
		}elsif($replyto{$to}){           # なければMLのをつける
	    		print FILE "Reply-To: $address\n";
	    	}

	print FILE "X-Remailer: $remailer \n"; 
        print FILE "X-Ml-Name: $mlname\n";
        print FILE "X-Mail-Count: $id\n";  
        print FILE "Precedence: bulk\n\n";     # ヘッダここまで。空行を１つ
                                               # 入れる。

        print FILE;                            # 今読み込んだ行を書き込む。

        open(LOG, "> $logfile") || warn "Can't open $logfile\n";
        print LOG "$id: $da, $fr($ufrom), $su\n";
        close(LOG);                            # LOGの書きだし。


	}else{
             print FILE;                       # 本文はそのまま素通り。
	}
}
close(FILE);

# この時点でヘッダなどが修正されたメールは $tmpfile に入っている。
# あとは配送するだけ。

open(SMTP, "| $telnet $smtp_server 25");       # smtp とお話し開始

print SMTP "HELO $server\n";                   # 前述の通り。
print SMTP "MAIL From: $admin\n";

open(MEMBER, "< $memberfile") || die "Can't open $memberfile\n";

while(<MEMBER>){
     chop;
     print SMTP "RCPT To: $_\n" if ($_ =~ /@/);
     }

close(MEMBER);

print SMTP "DATA\n";

open(FILE, "< $tmpfile");
while(<FILE>){print SMTP $_;}

print SMTP ".\n";
print SMTP "QUIT\n";

close(SMTP);                # SMTP とお話し終り。

unlink ($tmpfile);          # 残骸を消す。

# おしまひ

sub lock{                   # Lock のサブルーチン。まあこんなもんだと
                            # 思っといてください。

    $lockfile="tmp/lockfile";
    $timeout=1000 unless $timeout;

    open(LOCK, "> $tmpfile") || die("Can't Lock\n");
    print LOCK;
    close(LOCK);

    while($timeout > 0){
         if (link($locktmp, $lockfile)){
             last;
         }else{
             sleep(rand(5)+5);
	     $timeout--;
         }
    }

    if($timeout<0){
          system("$cat > $tmpfile");
          die("Can't lock!\n");
    }

}

sub unlock{ unlink ($lockfile); }      # Unlock は簡単。