#!/usr/bin/perl

#============================================================
#
# migw.pl - IRC/SMTPゲートウェイ
#
# 川俣吉広、kaw@on.rim.or.jp
# $Id: migw.pl,v 1.8 2009/10/02 14:26:08 kaw Exp $
#
# 注意：日本語の文字列がハードコーディングされている。
#       ISO-2022-JPでファイルに保存しないこと。EUC-JP推奨。
#
#============================================================

use Net::IRC;
use Jcode;
use Net::SMTP;
use IO::Socket;

#========================================
#
# イベントハンドラ - $irc->startから呼ばれる
# コールバック関数の定義
#
#========================================

# チャンネルテキストのイベント処理関数
# 
#     ... publicとprivの両方のメッセージに対応
#         させることができると思うが、現在は
#         publicイベントのみ。
# 
sub on_text {
    my ($self, $event) = @_;
    my @to = $event->to;
    my ($nick, $mynick) = ($event->nick, $self->nick);
    my ($arg) = ($event->args);

    &dbmsg("public msg ($nick): $arg");
    # mail_send("IRC:$IRC_CH:$nick", ["$nick: $arg"]);
    &check_message("$nick: $arg");
}

# 接続イベント処理 ... 即座にJOIN
# 
sub on_connect {
    my $self = shift;
    $self->join($IRC_CH);
}

# DISCONNECTイベント処理
# 
sub on_disconnect {
    my ($self, $event) = @_;
    sleep(30);
    $self->join($IRC_CH); # 再接続（本当に？）
}

# UNIXドメインソケットから
# minjectorが送ってきたデータを処理する
# 
sub socket_cb {
    my($cmd, $words,
       $maddr, $mhead,
       @body, $linesover);

    if (my $peer = $sockin->accept()) {
        $linesover = '';
        while (<$peer>) {
            chomp;
            &dbmsg("injected msg: $_");
            # 
            # minjectorが送ってきたデータを
            # parseしながら処理
            # 
            ($cmd, $words) = /^([A-Z]+):(.*)/; # コマンドとパラメータに分離
            if ($cmd eq 'FROM') {
                # 発言者の処理
                #
		$maddr = $words;
                $mhead = &gethandle($maddr);
            } elsif ($cmd eq 'BODY') {
                # 発言文をバッファに蓄積
                # 
                push(@body, $words);
            } elsif ($cmd eq 'STAT') {
                # ステータスの取得
                # 
                if ($words eq 'LINESOVER') {
                    $linesover = 1;
                }
            } elsif ($cmd eq 'IAM') {
                # 動的Handlenameの更新
                #
		if ($words eq '') {
		    undef($dyn_handlenames{$maddr});
		} else {
		    $dyn_handlenames{$maddr} = $words;
		}
            } elsif ($cmd eq 'RELAY') {
                # 動的Handlenameの更新
                #
		if ($words eq 'ON') {
		    &dbmsg("Relaying turned on");
		    $do_relay = 1;
		} elsif ($words eq 'OFF') {
		    &dbmsg("Relaying turned off");
		    $do_relay = 0;
		}
            } else {
                &dbmsg("Unexpected line: $_");
            }
        }

        # 受け取ったデータが、自分が IRC->SMTP して帰ってきたものでないことの確認
        #     ... メッセージがループしないための判定
        # 
        if ($maddr && ($maddr ne $SMTP_FROM) && scalar(@body)) {
            # メッセージのIRCへの送出
            # 
            foreach $line (@body) {
                &msg_send($conn, $IRC_CH, "$mhead: $line\n");
                &dbmsg("$mhead: $line");
            }
            if ($linesover) {
                &msg_send($conn, $IRC_CH, "$mhead: ...\n");
                &dbmsg("$mhead: ...");
            }
        }
    }
}

#========================================
#
# ユティリティルーチン
#
#========================================

# IRCチャンネルメッセージを送るための下請け関数。
#
sub msg_send {
    return unless $do_relay;

    my $ins  = shift;
    my $dest = shift;
    my $msg  = shift;
    $ins->privmsg($dest, Jcode->new($msg)->h2z->jis);
}

# メール送信
#     ... この部分非同期処理のほうがいいかも。
#
sub mail_send {
    return unless $do_relay;

    my $subj  = shift;
    my $msg   = shift; #メール本文は、行文字列の配列のリファレンスとして渡すこと。

    &dbmsg("mail to:$SMTP_TO from:$SMTP_FROM subj:$subj, body=", scalar(@$msg), "line(s)");

    $smtp = Net::SMTP->new($SMTP_SERVER);

    $smtp->mail($SMTP_FROM);
    $smtp->to($SMTP_TO); # 単一のアドレスにのみ対応

    $smtp->data();
    $smtp->datasend("From: $SMTP_FROM\n");
    $smtp->datasend("To: $SMTP_TO\n");
    $smtp->datasend("Subject: $subj\n"); # 今んとこMIMEヘッダ未対応。日本語不可
    $smtp->datasend("Content-Transfer-Encoding: 7bit\n");
    $smtp->datasend("Content-Type: text/plain; charset=ISO-2022-JP\n");
    $smtp->datasend("Mime-Version: 1.0\n");
    $smtp->datasend("\n");
    for (my($i) = 0; $i <= $#$msg; $i++) {
        $smtp->datasend(Jcode->new($msg->[$i] . "\n")->jis);
    }
    $smtp->dataend();
    $smtp->quit;
}

# メールアドレスをハンドルネームに変換する。
#
# ハンドルネームとは、IRC上でmigwが中継したメッセージの冒頭に表示される
# 発言者名である。
# IRCのいわゆるニックネームと区別するために、ハンドルネームと命名した。
# 
# ハンドルネームへの変換には２種類の連想配列を使用し、検索を行う。
# 
# 一つは、初期化ファイルにより定義される静的な変換表 $stat_handlenames、
# もう一つは、minjectorからのIAMメッセージ、つまりメールユーザからの
# 要求により設定される動的な変換表 $dyn_handlenames である。
# 
# 動的変換表の検索結果が成功した場合、静的変換表の検索は行われない。
# 
# どちらの表の検索もヒットしなかった場合はメールアドレスを短縮したものが
# ハンドルネームとして使われる。
#
# This routine added on 16th Sep 2009 by mikio@pagans.jp
# Modified by kaw, Sep 21, 2009
#
sub gethandle ($) {
    my ($maddr) = @_;

    return ($dyn_handlenames{$maddr}) if $dyn_handlenames{$maddr};

    if ($load_stat_handlefile && defined($IRC_HANDLEFILE)) {
        &dbmsg("Reloading static handlenames: $IRC_HANDLEFILE");
        do $IRC_HANDLEFILE;
	$load_stat_handlefile = 0;
    }
    return ($stat_handlenames{$maddr}) if $stat_handlenames{$maddr};

    $maddr =~ s/^(.+@[^.]+).*/$1/; # メールアドレスを縮める
    return($maddr);
}

# デバッグ用メッセージ出力
#
sub dbmsg {
    if ($DEBUG) {
        print STDERR @_, "\n";
    }
}

# デバッグ用メッセージ出力
# タイムスタンプ付
#
sub tprint {
    &dbmsg(time(), ": ", @_);
}

#========================================
#
# メール本文を溜めておくための
# メッセージキュー
#
#========================================
{package buff;

 my(@msgbuf)   = ();

# バッファが空かどうか
#
 sub is_empty {
     return(scalar(@msgbuf) == 0);
 }

# バッファに行を追加
#
 sub enqueue {
     my($msg) = shift;

     push(@msgbuf, $msg);
     &::tprint("===== \@msgbuf[", $#msgbuf, "] = '$msg' =====");
 }

# バッファの内容をflush
# 行先は、$SMTP_TO で指定したメールアドレス。
#
 sub flush {
     if (scalar(@msgbuf)) {
         &::tprint("===== \@msgbuf[", $#msgbuf, "] FLUSHED. =====");
         &::mail_send("IRC:$::IRC_CH", \@msgbuf);

     } else {
         &::tprint("===== \@msgbuf is EMPTY. =====");
     }
     @msgbuf = ();
 }
}
# ========== END OF PACKAGE ==========

#========================================
#
# IRC発言タイムアウトの管理
#
# timerパッケージでは、次の2つのタイマを管理している；
#
#   itimer ... Interval Timer
#              IRC上での発言の時間間隔が $ILIMIT秒以上になった場合の
#              タイムアウトを管理するタイマ
#
#   ctimer ... Contiguous Timer
#              IRC上での発言が itimerがタイムアウトすることなく
#              連続して行われる状態が $CLIMIT秒を超えた場合の
#              タイムアウトを管理するタイマ
#
#========================================
{package timer;

 my($CLIMIT) = 15; my($ctime); &reset_ctimer();
 my($ILIMIT) = 10; my($itime); &reset_itimer();

 # ユティリテイ関数 ... 最小値と最大値の取得
 #
 sub min { return($_[0] < $_[1] ? $_[0] : $_[1]); }
 sub max { return($_[0] < $_[1] ? $_[1] : $_[0]); }

 # 必要に応じてalarm()組み込み手続きを呼び出し、
 # ALRMシグナルが発生するようセットする。
 #
 sub set_alarm {
     my($now, $limit) = @_;
     &::tprint("    set_alarm(${now}, ${limit})");

     if ($now < $limit) {
         alarm($limit - $now);
         &::tprint("    alarm(", ($limit - $now), ") really set");
     }
 }

 # ctimerのタイムアウト値の設定
 #
 sub set_climit {
     $CLIMIT = shift;
     die "c-timeout too small" if ($CLIMIT < 1);
 }

 # ctimerのタイムアウト値の設定
 #
 sub set_ilimit {
     $ILIMIT = shift;
     die "i-timeout too small" if ($ILIMIT < 1);
 }

 # ctimerのタイムアウト(epoch)の取得
 #
 sub get_ctimer {
     if (&isset_ctimer()) {
         return($ctime);
     } else {
         die "ctimer not set";
     }
 }

 # itimerのタイムアウト(epoch)の取得
 #
 sub get_itimer {
     if (&isset_itimer()) {
         return($itime);
     } else {
         die "itimer not set";
     }
 }

 # cimerのタイムアウト時刻をepochでセットする
 #
 sub set_ctimer {
     my($now) = shift;

     $ctime = $now + $CLIMIT;
     if (&isset_itimer()) {
         &::tprint("ctimer set to $ctime", &min($ctime, &get_itimer()));
         &set_alarm($now, &min($ctime, &get_itimer()));
     } else {
         &::tprint("ctimer set to $ctime");
         &set_alarm($now, $ctime);
     }
 }

 # cimerのタイムアウト時刻をepochでセットする
 #
 sub set_itimer {
     my($now) = shift;

     $itime = $now + $ILIMIT;
     if (&isset_ctimer()) {
         &::tprint("itimer set to $itime", &min($itime, &get_ctimer()));
         &set_alarm($now, &min($itime, &get_ctimer()));
     } else {
         &::tprint("itimer set to $itime");
         &set_alarm($now, $itime);
     }
 }

 # ctimer, itimerを無効にする
 #
 sub reset_ctimer { $ctime = -1; }
 sub reset_itimer { $itime = -1; }

 # ctimer, itimerが有効かどうかを返す
 #
 sub isset_ctimer { return($ctime != -1); }
 sub isset_itimer { return($itime != -1); }

}
# ========== END OF PACKAGE ==========

# IRCから受信したメッセージをメール送信バッファに入れた
# 上で、新たなタイムアウト値を設定する。
#
sub check_message {
    my($msg) = shift;
    my($now) = time();

    &buff::enqueue($msg);

    &timer::isset_ctimer() || &timer::set_ctimer($now);
    &timer::set_itimer($now);
}

# ALARMシグナルの処理
#
# このシグナルが発生するのは、ctimerかitimerがタイムアウトした場合。
# バッファに溜っていたメッセージをメール送信するためflushし、
# その後一旦 ctimerとitimerを無効化する。
#
$SIG{'ALRM'} = sub {
    &tprint("---->ALRM TRAPPED.");

    my($now) = time();

    &tprint("---->now=   ", $now);
    &tprint("---->ctimer=", &timer::get_ctimer()) if &timer::isset_ctimer();
    &tprint("---->itimer=", &timer::get_itimer()) if &timer::isset_itimer();

    &tprint("---->TIMER EXPIRED");
    &buff::flush();

    &timer::reset_ctimer();
    &timer::reset_itimer();
};


#========================================
#
# 実際に走行するコードはここから
#
#========================================

# 全域変数の初期化
#
$do_relay = 1;

# 設定ファイル読み込み
#
if (@ARGV) {
    @INC = ('.');
    require $ARGV[0] || die;
} else {
    print STDERR "Usage: $0 config-file\n";
    exit(1);
}

# 静的HandleNameファイルの読み込みを指示
#
$load_stat_handlefile = 1;
#
# シグナルハンドラを登録
#   ... SIGUSR1で静的HandleNameファイルを再読込する。
#
$SIG{'USR1'} = sub { $load_stat_handlefile = 1 };
#
# 動的HandleNameファイルの初期化
#
%dyn_handlenames = ();

# IRCサーバへの接続
#
$irc = new Net::IRC;

$conn = $irc->newconn(Nick    => $IRC_NICK,
                      Server  => $IRC_SERVER,
                      Port    => $IRC_PORT,
                      Ircname => $IRC_NAME) || die;

# イベントハンドラの登録
#
$conn->add_global_handler(376, \&on_connect);
$conn->add_handler('public', \&on_text);
$conn->add_handler('disconnect', \&on_disconnect);

# 目的のチャンネルにJOIN
#
$conn->join($IRC_CH); # endmotdイベントをうまくtrapできなかったので
                      # 明示的に起動

# injectorと通信するための
# UNIXドメインソケットの準備
#
$sockin = IO::Socket::UNIX->new(Local   => $SOCKPATH,
                                Type    => SOCK_STREAM,
                                Listen  => 5,
                                Timeout => 1) || die $@;

# UNIXドメインソケットとハンドラを登録
#
$irc->addfh($sockin, \&socket_cb, "r" );

# IRCの発言タイムアウトを設定
#
&timer::set_climit($IRC_CTIMEOUT);
&timer::set_ilimit($IRC_ITIMEOUT);

# イベントループの実行
#
&dbmsg("Starting event loop...");
$irc->start;
&dbmsg("Event loop exited.");

# 終了処理
#
END {
    unlink $SOCKPATH;
}