package mailer;

#require 5;
require 'jcode.pl';
use Socket;
use Exporter;
@ISA=Exporter;
@EXPORT=qw(mailer);
@EXPORT_OK=qw();

#-------------------------------------------------
#  Prototypes
#-------------------------------------------------
sub mailer($$$$$);
sub GetDate();
sub MimeEncode($);
sub Base64Encode($);

#-------------------------------------------------
#  メール送信
#
#  mailer($smtp,$to,$from,$subject,$text)
#  $smtp    - SMTPサーバ名
#  $to      - 送信先アドレス
#  $from    - 送信先アドレス
#  $subject - メール題名
#  $text    - メール本文
#-------------------------------------------------
sub mailer($$$$$)
{
	local($smtp,$to,$from,$subject,$comment)=@_;
	local($server,$date,$port,$iaddr,$sock,$ret);
	if ($smtp eq "" || $to eq "" || $to!~/^[\w\-+\.]+\@[\w\-+\.]+$/i ){
	    return 0;
	}
	$server=$ENV{'SERVER_NAME'};

	jcode::convert(*subject,"jis");
	jcode::convert(*comment,"jis");

	MimeEncode(*subject);
	$date=GetDate();
	$comment=~s/^\./\.\./mg;	# 各行頭の.を..に変換

	# Create Socket
	$port=getservbyname('smtp','tcp') || 25;
	if (!($iaddr=inet_aton($smtp))){
		return 0;
	}
	$sock=sockaddr_in($port,$iaddr);
	if (!socket(SMTP,AF_INET,SOCK_STREAM,getprotobyname('tcp'))){
		return 0;
	}
	if (!connect(SMTP,$sock)){
		return 0;
	}
	select(SMTP); $|=1; select(STDOUT);	$|=1;# Stop buffering
	# 接続確認
	do{
		$ret=<SMTP>;
	}until($ret=~/\d\d\d/);
	if ($ret!~/^220/){
		close(SMTP);
		return 0;
	}
	# SMTPサーバとの対話 (ESMTP)
	print SMTP "EHLO $smtp\r\n";
	do{
		$ret=<SMTP>;
	}until($ret=~/\d\d\d/);
	if ($ret!~/^250/){
		print SMTP "HELO $smtp\r\n";
	do{
		$ret=<SMTP>;
	}until($ret=~/\d\d\d/);
		if ($ret!~/^250/){
			close(SMTP);
			return 0;
		}
	}
	print SMTP "MAIL FROM:$from\r\n";
	recv(SMTP,$ret,512,0);
	if ($ret!~/^250/){
		close(SMTP);
		return 0;
	}
	print SMTP "RCPT TO:$to\r\n";
	recv(SMTP,$ret,512,0);
	if ($ret!~/^250/){
		close(SMTP);
		return 0;
	}
	print SMTP "DATA\r\n";
	recv(SMTP,$ret,512,0);
	print SMTP "From: datchecker <$from>\r\n";
	print SMTP "To: $to\r\n";
	print SMTP "Subject: $subject\r\n";
	print SMTP "Date: $date\r\n";
	print SMTP "MIME-Version: 1.0\r\n";
	print SMTP "Content-Type: text/plain; charset=iso-2022-jp\r\n";
	print SMTP "Content-Transfer-Encoding: 7bit\r\n";
	print SMTP "X-Mailer: 2ch_thread_date_checker\r\n";
	print SMTP "\r\n";
	print SMTP "$comment\r\n";
	print SMTP "\r\n\.\r\n";
	recv(SMTP,$ret,512,0);
	if ($ret!~/^250/){
		close(SMTP);
		return 0;
	}
	print SMTP "QUIT\r\n";
	close(SMTP);
	return 1;
}

#-------------------------------------------------
#  Returns date in RFC 1123 format (GMT)
#-------------------------------------------------
sub GetDate()
{
	my($ret,@week,@month,@gmt);

	@week=("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
	@month=("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");

	@gmt=gmtime();
	$ret=sprintf("%s, %2d %s %d %02d:%02d:%02d GMT",
		$week[$gmt[6]],$gmt[3],$month[$gmt[4]],1900+$gmt[5],$gmt[2],$gmt[1],$gmt[0]);

	return $ret;
}

#-------------------------------------------------
#  Perform MIME encode
#-------------------------------------------------
sub MimeEncode($)
{
	local(*str)=@_;
	$str=~s/\x1b\x28\x42/\x1b\x28\x4a/g;
	$str=Base64Encode($str);
	$str="=?iso-2022-jp?B?$str?=";

	return $str;
}

sub Base64Encode($)
{
	my($str)=@_;
	my($base)="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
               ."abcdefghijklmnopqrstuvwxyz"
               ."0123456789+/";
	my($i,$s1,$s2,$out);

	$s1=unpack("B*",$str);
	for ($i=0;$s2=substr($s1,$i,6);$i+=6){
		$out.=substr($base,ord(pack("B*","00".$s2)), 1);
		if (length($s2) == 2){
			$out.="==";
		}
		elsif (length($s2) == 4){
			$out.="=";
		}
	}
	return $out;
}


1;