#!/usr/bin/perl
# gooメールからメールをダウンロードしてmbox形式で出力する
use strict;
use Encode;

# Windows + Active Perl/Strawberry Perl 用
# 使い方： perl GooMailSalvager4Win.pl <ID> <Pass> <Proxy>
# example: perl GooMailSalvager4Win.pl foo Password http://proxy.host:1234

my $LOCAL_LANG = 'shift-jis';		# ファイルシステムの文字コード(for Win32 Active Perl etc...)
#my $LOCAL_LANG = 'utf-8';		# ファイルシステムの文字コード(for Cygwin)
#my $LOCAL_LANG = 'euc-jp';		# ファイルシステムの文字コード(for UNIX)

my $USER = $ARGV[0];				# goo ID
my $PASS = $ARGV[1];				# Password
my $PROXY = $ARGV[2];				# Proxy
#my $PROXY = 'http://proxy.host:1234';		# Proxyが必要なら設定(/で終わってはダメなので注意)

my $client = GooMail->new(debug => 1, proxy => $PROXY);
$client->login($USER, $PASS) || die;

my $folder_ref = $client->get_folder_list() || die;
while (my ($folder_id, $folder_name) = each %$folder_ref) {
	Encode::from_to($folder_name, 'euc-jp', $LOCAL_LANG);
	open(MBOX, '>'.$folder_id.'_'.$folder_name) ||die;
	my $message_list_ref = $client->get_message_list($folder_id);
	for (@$message_list_ref) {
		my $message = $client->get_message($_) || next;
		print MBOX $message."\n";
	}
	close(MBOX);
}

exit 0;


package GooMail;

use strict;
use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Request::Common;
use Time::Local;
use Encode;
use MIME::Base64;

my $INDEX_URL;

sub new {
	my $class = shift;
	my $self = { @_ };

	$INDEX_URL = 'http://amigo.mail.goo.ne.jp/goomail/index.ghtml';

	$self->{debug} && printlog("GooMail constructor\n");
	$self->{ua} = LWP::UserAgent->new(keep_alive => '300');
	$self->{ua}->cookie_jar(HTTP::Cookies->new({}));
	if ($self->{proxy}) {
		$self->{ua}->proxy('http', $self->{proxy});
		$ENV{HTTPS_PROXY} = $self->{proxy};
	}
	return bless $self, $class;
}

sub login {
	my ($self, $user, $pass) = @_;

	$self->{debug} && printlog("login($user)\n");

	my $action = 'https://login.mail.goo.ne.jp/id/authn/Login';
	my %params;
	$params{Site} = 'NO_SPECIFIED';
	$params{Success} = 'http://login.mail.goo.ne.jp/id/Top';
	$params{uname} = $user;
	$params{pass} = $pass;

	my $res = $self->do_post_only($action, \%params);
	$res->code == 200 || $res->code == 302 || (printlog($res->content), return 0);
	$self->{debug} > 2 && printlog($res->content);

	return 1;
}

sub get_folder_list {
	my $self = shift;
	my %folder_list;
	
	$self->{debug} && printlog("get all folders\n");

	my $res = $self->do_get($INDEX_URL);
	$res->code == 200 || return 0;

	for (split(/[\x0d\x0a]+/, $res->content)) {
		m|<font size="2"><a href="\?view=mailbox&fid=(\d+)">(.*)</a>| || next;
		my $folder_id = $1;
		my $folder_name = $2;
		$folder_id == 0 && next;  # 迷惑メール
		$folder_id == 2 && next;  # 送信箱
		$folder_id == 3 && next;  # 下書き
		$folder_id == 4 && next;  # ゴミ箱

		$folder_name =~ s/\s+\(\d+\)//g;
		$folder_list{$folder_id} = $folder_name;
	}

	return \%folder_list;
}

sub get_message_list {
	my ($self, $folder_id) = @_;
	my @message_list;

	$self->{debug} && printlog("get_message_list for folder ID : $folder_id\n");

	my $res = $self->do_get($INDEX_URL.'?view=mailbox&fid='.$folder_id);
	$res->code == 200 || return 0;

	my $next = get_message_list_thispage($res->content, \@message_list) || return \@message_list;

	while ($next) {
		$self->{debug} && printlog("get_message_list($folder_id) page $next\n");

		$res = $self->do_get($INDEX_URL.'?view=mailbox&fid='.$folder_id.'&p='.$next);
		$res->code == 200 || return 0;
		$next = get_message_list_thispage($res->content, \@message_list);
	}

	return \@message_list;
}

sub get_message_list_thispage {
	my ($body, $message_list_ref) = @_;
	my $next_page;

	for (split(/[\x0d\x0a]+/, $body)) {
		m|<a href="/goomail/index.ghtml\?view=mailbox&fid=\d+&p=(\d+)">次へ</a>| &&
			($next_page = $1);
		/a href="\?view=mail_read&msg_id=([^&]+)&/ || next;
		push(@$message_list_ref, $1);
	}
	return $next_page;
}

sub get_message {
	my ($self, $message_id) = @_;
	local $_;
	
	$self->{debug} && printlog("get_message for message ID : $message_id\n");

	# メール本文の読み込み
	my $url = $INDEX_URL.'?view=mail_read&header=1&msg_id='.$message_id;
	my $res = $self->do_get($url);
	$res->code == 200 || return 0;
	
	my $header;
	my $body;
	my $received;
	my $mode = -1;
	my @files;
	# $modeは解析している場所と状態を表す
	# -1:受信日より前
	#  0:ヘッダより前
	#  1:ヘッダ
	#  2:ヘッダより後で本文より前(添付ファイルはここにある)
	#  3: 本文(PREで囲まれたプレーンテキスト)
	#  4: 本文(HTMLエスケープされたプレーンテキスト)
	#  5: 本文(HTMLメールでalternativeの場合)
	#  6: 本文(HTMLメールでrelatedの場合)
	#  7: 本文(プレーンテキストか?)
	for (split(/[\x0d\x0a]+/, $res->content)) {
		$mode == -1 && m|<div style="margin-top:12px;"><font size="2">(\d+)年(\d+)月(\d+)日 (\d+):(\d+):(\d+)</font>&nbsp;&nbsp; <font size="-2">| &&
			($received = timelocal($6, $5, $4, $3, $2 - 1, $1), next);
		$mode == -1 && m|^<\!--mail_header-->$| && ($mode = 0, next);
		$mode == 0 && m|^<font size="2">$| && ($mode = 1, next);
		$mode == 1 && s|</font>$|| && ($header .= $_."\n", $mode = 2, next);
		$mode == 2 && m|<a href="\?view=dl&id=([\d\.]+)&type=file" target=_blank>(.*?)</a>| &&
			(push(@files, {id=>$1, name=>$2}), next);
		$mode == 2 && s|^<td><table><tr><td><div class='body'><pre><font size="2">|| && ($mode = 3);
		$mode == 2 && s|^<td><table><div class='body'><font size="2">|| && ($mode = 4);
		$mode == 2 && s|^<td><table><tr><td><div class='body'>|| && ($mode = 7);
		$mode == 2 && s|^<td><table><tr><td>|| && ($mode = 6);
		$mode == 2 && s|^<td><table>|| && ($mode = 5);
		$mode == 3 && s|</font></pre></div></td></tr></table></td>$|| && ($body .= $_."\n", last);
		$mode == 4 && s|</font></div></table></td>$|| && ($body .= $_."\n", last);
		$mode == 5 && s|</table></td>$|| && ($body .= $_."\n", last);
		$mode == 6 && m|^</td></tr></table></td>$| && last;
		$mode == 7 && s|</div></td></tr></table></td>$|| && ($body .= $_."\n", last);
		if ($mode == 1) {
			$header .= $_."\n";
		}
		if ($mode >= 3) {
			$body .= $_."\n";
		}
	}

	$header =~ s|<br />\n|\n|g;
	$header =~ s|&lt;|<|g;
	$header =~ s|&gt;|>|g;
	$header =~ s|&quot;|"|g;
	$header =~ s|&amp;|&|g;
	# Content-Typeは有無を言わさずJIS日本語に
	$header =~ s|[Cc]ontent-[Tt]ype: (.*); charset=["A-Za-z_\-0-9]+|Content-Type: $1; charset="iso-2022-jp"|;
	$header =~ s|[Cc]ontent-[Tt]ransfer-[Ee]ncoding: (.*); charset=["A-Za-z_\-0-9]+|Content-Transfer-Encoding: $1; charset="iso-2022-jp"|;
	Encode::from_to($header, 'euc-jp', 'iso-2022-jp');

	# プレーンテキストはHTMLエスケープを戻す
	if ($mode == 3 || $mode == 4 || $mode == 7) {
		$body =~ s|<a href="\?view=mail_creation&to=(.*)">\1</a>|$1|g;
		$body =~ s|<a href="(.*)" target="LINK">\1</a>|$1|g;
		$body =~ s|<br />\n|\n|g;
		$body =~ s|&lt;|<|g;
		$body =~ s|&gt;|>|g;
		$body =~ s|&nbsp;| |g;
		$body =~ s|&quot;|"|g;
	}
	Encode::from_to($body, 'euc-jp', 'iso-2022-jp');

	if ($header =~ m|[Cc]ontent-[Tt]ype: multipart/|) {

		$header =~ /boundary=("?)(.*)\1/ || (printlog("boundary not found($url)\n"), return 0);
		my $boundary = $2;

		# 本文出力(本文はJIS日本語のプレーンテキストに決め打ち)
		if ($mode == 3 || $mode == 4 || $mode == 7) {
			$body = <<EOF;

--$boundary
Content-Type: text/plain; charset="iso-2022-jp"
Content-Transfer-Encoding: 7bit

$body
EOF
		} else {
			$body = <<EOF;

--$boundary
Content-Type: text/html; charset="iso-2022-jp"
Content-Transfer-Encoding: 7bit

<html>
<body>
$body
</body>
</html>
EOF
		}
		# 添付ファイルがある場合
		for (@files) {
			# 添付ファイル名をJIS日本語に変換して、さらにMIMEエンコーディング
			my $name = $_->{name};
			Encode::from_to($name, 'euc-jp', 'iso-2022-jp');
			$name = encode('MIME-Header-ISO_2022_JP', $name);
			# 添付ファイルのヘッダを出力。MIMEタイプはめんどくさいのでoctet-streamに決め打ち。
			$body .= <<EOF;

--$boundary
Content-Type: application/octet-stream; name="$name"
Content-Transfer-Encoding: base64
Content-Disposition: attachment; filename="$name"

EOF
			# 添付ファイルの中身を取得してBASE64エンコーディング
			my $url = $INDEX_URL.'?view=dl&type=file&id='.$_->{id};
			my $res = $self->do_get($url);
			$res->code == 200 || (printlog("attached file download failed($url)\n"), return 0);
			$body .= MIME::Base64::encode($res->content);
		}
		# alternativeの場合
		if ($header =~ m|[Cc]ontent-[Tt]ype: multipart/alternative|) {
			# プレーンテキスト部分をview=dlで取得して先頭のコンテンツにする(必ず先頭!)
			my $url = $INDEX_URL.'?view=dl&type=mail&msg_id='.$message_id;
			my $res = $self->do_get($url);
			$res->code == 200 || (printlog("plaint text of multipart download failed($url)\n"), return 0);
			
			# 最初の5行を捨てる
			my $plain_body;
			my $i = 0;
			for (split(/[\x0d\x0a]+/, $res->content)) {
				$i++ < 5 && next;
				$plain_body .= $_."\n";
			}
			Encode::from_to($plain_body, 'shift_jis', 'iso-2022-jp');
			$body = <<EOF;

--$boundary
Content-Type: text/plain; charset="iso-2022-jp"
Content-Transfer-Encoding: 7bit

$plain_body
$body
EOF
		}
		$body .= "\n--$boundary--\n";
	} else {
		# 添付もないしHTMLメールでもないのに中身が空ってなんか失敗した可能性があるのでログに吐く
		$body || (printlog("no data($url)\n"), return 0);
	}

	# mbox形式に整形
	my $message;
	$message .= 'From - '.scalar(gmtime($received))." GMT\n";
	$message .= $header."\n";
	$message .= $body;
	return $message;
}

sub do_get {
	my ($self, $url) = @_;

	my $res = $self->{ua}->request(GET($url));
	$self->{debug} > 1 && printlog("response status ".$res->code."\n");

	return $res;
}

sub do_post_only {
	my ($self, $url, $param) = @_;

	my $res = $self->{ua}->request(POST($url, [%$param]));
	$self->{debug} > 1 && printlog("response status ".$res->code."\n");

	return $res;
}

sub do_post_and_redirect {
	my ($self, $url, $param) = @_;

	my $res = $self->do_post_only($url, $param);
	$res->code == 302 || die "$res->code error";

	return $self->do_get($res->header('Location'));
}

sub DESTROY {
	my $self = shift;

	$self->{debug} && printlog("GooMail destructor\n");
}

sub printlog {
	my $msg = shift;
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime();
	print STDERR sprintf("%04d/%02d/%02d %02d:%02d:%02d $msg", $year + 1900, $mon +1, $mday, $hour, $min, $sec);
}

sub time_YYYYMMDDHI24MI {
	my $data = shift;
	
	$data || return;
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($data);
	return sprintf("%04d/%02d/%02d %02d:%02d", $year+1900, $mon +1, $mday, $hour, $min);
}
