#! /usr/bin/perl -w

use	strict ;

use	LWP::UserAgent ;
use	HTTP::Request ;
use	URI::Escape ;
use	MIME::Parser ;
use	MIME::Words qw/decode_mimewords encode_mimeword/ ;
use	Unicode::MapUTF8 qw/to_utf8 from_utf8/ ;
use	HTML::TokeParser ;

use	Mail2LJ::Config ; # you can just remove every line mentioning
			  # Mail2LJ::Config or $cfg

my	$cfg = $Mail2LJ::Config::conf ;

my	$post_uri = "http://www.livejournal.com/cgi-bin/log.cgi" ;
my	$ljcomment_action = 'http://www.livejournal.com/talkpost_do.bml';
my	$host = $ENV{MAIL2LJ_DOMAIN} || "mail2lj.nichego.net" ;

my	$mp = new MIME::Parser() or
	die "new MIME::Parser(): $!\n" ;
my	$home = $ENV{HOME} || "/home/mail2lj" ;
my	$alias = shift @ARGV || "none" ;


$mp->output_dir("$home/mimetmp") ;
my	$me = $mp->parse(\*STDIN) ;
END	{ $me && $me->purge() } ;

open(STDERR, ">>$home/generic.log") or die "open(`log'): $!\n" ;

my	$users = {} ;

$users = $cfg->{users} ;

sub	href2utf8 {
	my	($hr, $e) = @_ ;
	my	$i ;

	foreach $i (keys %$hr) {
	    $hr->{$i} = to_utf8({ -string => $hr->{$i}, -charset => $e}) ;
	}
	return $hr ;
}

sub	href2string {
	my	$hr = shift ;
	my	$i ;
	my	$s = "" ;

	foreach $i (keys %$hr) {
	    next if $i eq "event" ;
	    $s .= "&" if $s ;
	    $s .= $i . "=" . uri_escape($hr->{$i}, "^A-Za-z0-9") ;
	}

	if ($hr->{event}) {
	    $s .= "&" if $s ;
	    $s .= "event=" . uri_escape($hr->{event}, "^A-Za-z0-9") ;
	}
	return $s ;
}

sub	post_body2href {
	my	$fh = shift ;
	my	($l, $auth) ;
	my	$req_data = {
	    webversion			=> 'full',
	    ver				=> 1,
	    security			=> 'public',
	    prop_opt_preformatted	=> 0,
	    mode			=> 'postevent'
	} ;

	while ($l = $fh->getline()) {
	    if (exists $req_data->{event}) {
		$req_data->{event} .= $l ;
		next ;
	    }

	    next if $l =~ /^$/ ;

	    if ($l =~ /^(\w[\w_]*[\w])\s*[=:]\s*(\S.*)$/) {
		my	($var, $val) = (lc($1), $2) ;

		if ($var eq "date") {
		    if ($val =~ /(\d\d)\.(\d\d)\.(\d{2,4})\s+(\d\d?):(\d\d)/) {
			$req_data->{day} = $1 ;
			$req_data->{mon} = $2 ;
			$req_data->{year} = $3 ;
			$req_data->{hour} = $4 ;
			$req_data->{min} = $5 ;
			$req_data->{year} += 2000 if $req_data->{year} < 100 ;
		    } else {
			print STDERR "can't parse date '$val'\n" ;
		    }
		} elsif ($var eq "mood" || $var eq "current_mood") {
		    $req_data->{prop_current_mood} = $val ;
		} elsif ($var eq "music" || $var eq "current_music") {
		    $req_data->{prop_current_music} = $val ;
		} elsif ($var eq "picture" || $var eq "picture_keyword") {
		    $req_data->{prop_picture_keyword} = $val ;
		} elsif ($var eq "formatted" || $var eq "autoformat") {
		    $val = 1 if $val =~ /((on)|(yes))/i ;
		    $val = 0 if $val =~ /((off)|(no))/i ;
		    $req_data->{prop_opt_preformatted} = $val ;
		} elsif ($var eq "auth") {
		    $auth = $val ;
		} else {
		    $req_data->{$var} = $val ;
		}
	    } else {
		$req_data->{event} = $l ;
	    }
	}

	if (!exists $req_data->{year}) {
	    my	@lt = localtime() ;
	    $req_data->{day} = $lt[3] ;
	    $req_data->{mon} = $lt[4] + 1 ;
	    $req_data->{year} = 1900 + $lt[5] ;
	    $req_data->{hour} = $lt[2] ;
	    $req_data->{min} = $lt[1] ;
	}

	if ($auth) {
	    $req_data->{password} = $users->{$req_data->{user}}->{password}
		if exists $users->{$req_data->{user}} &&
		    $users->{$req_data->{user}}->{auth} eq $auth ;
	}

	return $req_data ;
}
sub	hdr2utf8 {
	my	($s, $e) = @_ ;
	my	$r = "" ;
	my	$i ;

	foreach $i (decode_mimewords $s) {
	    $r .= to_utf8({
		-string => $i->[0],
		-charset => ($i->[1] || $e)
	    }) ;
	}

	return $r ;
}

sub	post_me2req {
	my	($me, $e, $hints) = @_ ;
	my	$mebh = $me->bodyhandle() or die "post_message(): no body?\n" ;
	my	$mehh = $me->head() ;
	my	$charset = $mehh->mime_attr("content-type.charset") || $e ;
	my	$subject = hdr2utf8($me->get('Subject') || "", $charset) ;
	my	$hr = href2utf8(post_body2href($mebh->open("r")), $charset) ;
	my	$req = new HTTP::Request('POST', $post_uri) or
		die "new HTTP::Request(): $!\n" ;

	if ($hints) {
	    my	$i ;
	    foreach $i (keys %$hints) {
		$hr->{$i} ||= $hints->{$i} ;
	    }
	}

	$hr->{subject} ||= $subject ;
	$hr->{subject} = "[mail2lj] " . $hr->{subject} ;

	$req->content_type('application/x-www-form-urlencoded');
	$req->content(href2string $hr) ;

	print STDERR "working on request from $hr->{user}\n",
	      "Subject: $hr->{subject}\n",
	      "Date: ", scalar localtime, "\n" ;

	return $req ;
}

sub	submit_request {
	my	($req, $proto) = @_ ;
	my	$ljres = {} ;
	my	$ua = new LWP::UserAgent or
		die "new LWP::UserAgent: $!\n" ;
	$ua->agent("Mail2LJ/0.9");
	$ua->timeout(100);
	my	$res = $ua->request($req);

	if ($proto && $proto eq "comment") {
	    if ($res->is_success) {
		$ljres->{'success'} = "OK";
	    } else {
		$ljres->{'success'} = "FAIL";
		$ljres->{'errmsg'} = "Client error: Error contacting server.";
	    }

	    return $ljres ;
	}

	if ($res->is_success) {
		%$ljres = split(/\n/, $res->content);
	} else {
		$ljres->{'success'} = "FAIL";
		$ljres->{'errmsg'} = "Client error: Error contacting server.";
	}
	return $ljres ;
}

sub	ljcomment_form2string {
	my	$s = shift ;
	my	$h = {} ;
	my	$p = new HTML::TokeParser(\$s) or
	    die "new HTML::TokeParser(): $!\n" ;
	my	$token = $p->get_tag("form");
	die "get_inputs(): Wrong form.\n"
	    if ($token->[1]{action} ne $ljcomment_action) ;

	while ($token = $p->get_tag("input") ) {
	    $h->{$token->[1]{name}} =
		$token->[1]{value} || '' if ($token->[1]{name});
	}

	die "get_inputs(): Incomplete form data\n"
	    unless $h->{userpost} && $h->{journal} && $h->{parenttalkid} &&
		   $h->{itemid} && $h->{ecphash} ;

	$h->{ecphash} =~ s/^ecph-// ;

	return "$h->{userpost}-$h->{journal}-$h->{parenttalkid}-$h->{itemid}-$h->{ecphash}" ;
}

sub	ljcomment_string2form {
	my	$s = shift ;
	my	$hr = {} ;
	my	$i ;
	my	@l = split /\-/, $s ;

	foreach $i (qw/userpost journal parenttalkid itemid ecphash/) {
	    $hr->{$i} = shift @l ;
	}

	die "badly formed formdata '$s'\n" unless $hr->{ecphash} ;
	$hr->{ecphash} = "ecph-" . $hr->{ecphash} ;

	return $hr ;
}

sub	normalize_header {
	my	($s, $e) = @_ ;
	my	$d = decode_mimewords($s) ;
	chomp $d ;

	return encode_mimeword($d, 'B', $e) ;
}


my %tr = (
'á' => 'A', 'â' => 'B', '÷' => 'V', 'ç' => 'G', 'ä' => 'D', 'å' => 'E', '³' =>
'E', 'ö' => 'Zh', 'ú' => 'Z', 'é' => 'I', 'ê' => 'J', 'ë' => 'K', 'ì' => 'L',
'í' => 'M', 'î' => 'N', 'ï' => 'O', 'ð' => 'P', 'ò' => 'R', 'ó' => 'S', 'ô' =>
'T', 'õ' => 'U', 'æ' => 'F', 'è' => 'H', 'ã' => 'C', 'þ' => 'Ch', 'ý' => 'Sch',
'û' => 'Sh', 'ø' => '\'', 'ù' => 'Y', 'ÿ' => '\'', 'ü' => 'E', 'à' => 'Yu',
'ñ' => 'Ya', 'Á' => 'a', 'Â' => 'b', '×' => 'v', 'Ç' => 'g', 'Ä' => 'd', 'Å' =>
'e', '£' => 'e', 'Ö' => 'zh', 'Ú' => 'z', 'É' => 'i', 'Ê' => 'i', 'Ë' => 'k',
'Ì' => 'l', 'Í' => 'm', 'Î' => 'n', 'Ï' => 'o', 'Ð' => 'p', 'Ò' => 'r', 'Ó' =>
's', 'Ô' => 't', 'Õ' => 'u', 'Æ' => 'f', 'È' => 'h', 'Ã' => 'c', 'Þ' => 'ch',
'Û' => 'sh', 'Ý' => 'sch', 'Ø' => '\'', 'Ù' => 'y', 'ß' => '\'', 'Ü' => 'e',
'À' => 'yu', 'Ñ' => 'ya'
);

sub	smstrip_data {
	my	$data = shift ;
	my	($hdr, $ftr) ;
	my	($who, $journal) ;

	$data =~ /^(.+)Their reply was:(.+)You can view the discussion(.+)$/si
	    or return $data ;
	$hdr = $1 ;
	$data = $2 ;
	$ftr = $3 ;

	$hdr =~ /\((\w+)\) replied to .* ((post)|(comment))/ and $who = $1 ;

	$ftr =~ m,http://www\.livejournal\.com/talkpost.bml\?journal=(\w+),
	    and $journal = $1 ;

	if ($who) {
	    $data = "user [$who] in [$journal]:\n" . $data ;
	}

	$data =~ s/^\s+Subject:\s*$//m ;
	$data =~ s/^\s+Subject:\s(\S.*)\s*$/[$1]/m ;
	$data =~ s/\s+/ /gs ;
	$data =~ s/(.)/$tr{$1} || $1/ge ;

	return $data ;
}

sub	send_bounce {
	my	($errmsg, $orig, $charset) = @_ ;

	$charset ||= "windows-1251" ;

	my	$bmsg = build MIME::Entity(
	    'From'         => "MAILER-DAEMON\@$host",
	    'To'           => $orig->get('From'),
	    'Subject'      => (
		"mail2lj failure (was: " . $orig->get('Subject') .  ")"
	    ),
	    'Content-Type' => "text/plain; charset=$charset" ,
	    'Data'         => <<EOF

	Dear Mail2Lj User,

 Mail2Lj gateway at $host was trying hard to submit your request,
but, unfortunately, to no avail: a silly, but fatal error has occured.
Mail2Lj(tm) proudly presents the extremely informative error message:

'$errmsg'

Thank you for understanding,
good luck next time,
take care,
sincerely, completely and, in general, very truly yours,
-Mail2Lj.
EOF
	);
	$bmsg->send("sendmail") ;
	$bmsg->purge() ;
}

my	$mh = $me->head() ;

$me->dump_skeleton(\*STDERR) ;
print STDERR "Alias: $alias, To: ", $me->get('To'),
	  "Charset: ", $mh->mime_attr("content-type.charset") || "NONE", "\n" ;

my	$xmailer = $mh->get('X-Mailer') || "unknown" ;
if ($xmailer =~ /EPOC/ || $xmailer =~ /Eudora.+PalmOS/) {
	# too bad. they do violate standards there.
	$mh->mime_attr("content-type.charset" => "windows-1251") ;
	print STDERR "Charset changed to 'windows-1251' (hopefully)\n" ;
}

if ($alias =~ /MAILER-DAEMON/i) {
	exit 0 ;
} elsif ($alias =~ /^post$/) {
	my	$req = post_me2req($me, "windows-1251") ;
	my	$ljres = submit_request($req) ;

	if ($ljres->{'success'} eq "OK") {
	    print STDERR "journal updated successfully\n" ;
	} else {
	    print STDERR "error updating journal: $ljres->{errmsg}\n" ;
	    send_bounce($ljres->{errmsg}, $me, $mh->mime_attr("content-type.charset")) ;
	}
} elsif ($alias =~ /^post-(\w+)-(\w+)$/) {
	my	$l = $1 ;
	my	$p = $2 ;
	my	$req = post_me2req($me, "windows-1251", {
		    user => $l,
		    password => $p
		}) ;
	my	$ljres = submit_request($req) ;

	if ($ljres->{'success'} eq "OK") {
	    print STDERR "journal updated successfully\n" ;
	} else {
	    print STDERR "error updating journal: $ljres->{errmsg}\n" ;
	    send_bounce($ljres->{errmsg}, $me, $mh->mime_attr("content-type.charset")) ;
	}
} elsif ($alias =~ /^hpost-(\w+)-(\w+)$/) {
	my	$l = $1 ;
	my	$hp = $2 ;
	my	$req = post_me2req($me, "windows-1251", {
		    user => $l,
		    hpassword => $hp
		}) ;
	my	$ljres = submit_request($req) ;

	if ($ljres->{'success'} eq "OK") {
	    print STDERR "journal updated successfully\n" ;
	} else {
	    print STDERR "error updating journal: $ljres->{errmsg}\n" ;
	    send_bounce($ljres->{errmsg}, $me, $mh->mime_attr("content-type.charset")) ;
	}
} elsif ($alias =~ /^ljreply-(\S+)$/ || $alias =~ /^ljreplys-(\S+)$/) {
	my	$email = $1 ;
	$email =~ s/\.\./\@/ ;

	if ($mh->get('From') !~ m/lj_dontreply\@livejournal.com/ && 
	    $mh->get('From') !~ m/lj_notify\@livejournal.com/) {
	    # someone just picked our email from livejournal.com site
	    print STDERR "no livejournal signature found, bouncing to $email\n";
	    $mh->replace('To', $email) ;
	    $me->send("sendmail") ;
	    exit 0 ;
	}

	die "ljreply doesn't look like a 2-part message.\n"
	    unless $me->parts() == 2 ;
	my	$formdata = ljcomment_form2string
	    $me->parts(1)->bodyhandle->as_string() ;
	my	$charset =
		($me->parts(0)->head->mime_attr('content-type.charset') ||
                "windows-1251") ;
	my	$data = $me->parts(0)->bodyhandle->as_string() ;

	my	$nicefrom = "Mail2LJ-translated comment" ;
	if ($mh->get("From") =~ /\(([^\)]+)\)/) {
	    $nicefrom = $1 ;
	}
	print STDERR "nicefrom is '$nicefrom'\n" ;

	if ($alias =~ /^ljreplys/) {
	    print STDERR "stripping content...\n" ;
	    $data = to_utf8({ -string => $data, -charset => $charset})
		if $charset !~ /^utf-?8$/i ;
	    $data = from_utf8({ -string => $data, -charset => "koi8-r"}) ;
	    $charset = "koi8-r" ;
	    $data = smstrip_data $data ;
	}

	my	$msg = build MIME::Entity(
	    'From'         => "ljfrom-$formdata\@$host",
#	    'Sender'	   => "ljfrom-$formdata\@$host",
	    'To'           => $email,
	    'Subject'      => normalize_header($mh->get('Subject'), $charset),
	    'Content-Type' => "text/plain; charset=$charset" ,
	    'Data'         => $data
	);
	$msg->send("sendmail") ;
	$msg->purge() ;
} elsif ($alias =~ /^ljfrom-(\S+)$/) {
	my	$formdata = $1 ;
	my	$hr = ljcomment_string2form($formdata) ;
	my	$req = new HTTP::Request('POST' => $ljcomment_action)
		or die "new HTTP::Request(): $!\n" ;

	$hr->{usertype} = 'user' ;
	$hr->{encoding} = $mh->mime_attr('content-type.charset') ||
			  "cp1251" ;
	$hr->{subject}  = decode_mimewords($mh->get('Subject'));
	$hr->{body} = $me->bodyhandle->as_string() ;

	$req->content_type('application/x-www-form-urlencoded');
	$req->content(href2string($hr)) ;

	my      $ljres = submit_request($req, "comment") ;

	if ($ljres->{'success'} eq "OK") {
	    print STDERR "journal updated successfully\n" ;
	} else {
	    print STDERR "error updating journal: $ljres->{errmsg}\n" ;
	    send_bounce($ljres->{errmsg}, $me, $mh->mime_attr("content-type.charset")) ;
	}
}