#!/usr/bin/perl

# $Id: ljegate.pl,v 1.4 2004/04/02 21:27:55 root Exp $

# unffective, poorly written reply-by-mail enabler for lj
# this script was written by nslu with 1/2 of code taken from
# jsn mail2lj gate, see lj.myxomop.com for details
#
# you can redistribute this script in terms of GPL license,
# see http://www.gnu.org/copyleft/gpl.html for details

use MIME::Parser;
use MIME::Words qw( :all );
use LWP::UserAgent;
use HTTP::Request;
use URI::Escape;
use HTML::TokeParser;
use Unicode::MapUTF8 qw( to_utf8 );

use strict;
use warnings;

# let redirect everything to
open STDERR, "|/var/home/l/lj/logger";
print STDERR "-"x50 . "\n";
print STDERR scalar(localtime) . "\n";

# stuff 

my $realver = 20;        # increment by 1 on each change
my $ver = 1-1/$realver;  # asymptotic -> 1
my $uastr = 'ljegate';
my $ua_timeout = 180;

my $host = 'lj.myxomop.com';
my $rehost = 'myxomop.com'; #host that receives mail from lj
my $ljhost = 'livejournal.com';
my $correct_action = 'http://www.livejournal.com/talkpost_do.bml';

my $lj_reply_uri = "http://www.$ljhost/talkpost_do.bml";
my $lj_entry_uri = "http://www.$ljhost/cgi-bin/log.cgi";


# sub parses attached form from email notfication 
# and extrudes all <input> fields

sub get_inputs {
  my $s = shift;
  my $h = shift;
  
  my $p = HTML::TokeParser->new (\$s) or die "Can't parse: $!";
  
  my $token = $p->get_tag("form");
  die("Wrong form") unless ($token->[1]{action} eq $correct_action);

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

sub check_head {
  my $head = shift;
  return 1;
  
  for (my $i = $head->count('Received')-1; $i>=0; $i--) {
    my @rec_h = split(/\n/,$head->get('Received', $i));

    return 1 if ($rec_h[0] eq "from livejournal.com ([66.150.15.150])" && 
                 $rec_h[1] =~ /^\tby $rehost/)
  }
  return undef;
}


# creates and escapes url string from hash

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 ;
}


# here we are, we got a message in a pipe

my $parser = new MIME::Parser;
$parser->output_under("/tmp");
$parser->output_to_core(1);

my $entity = $parser->parse(\*STDIN);

# now we got message
# let's see where it came from and where it is targeted
# to do this we need headers

my $head = $entity->head;

my ($to) = $head->get('To', 0) =~ /([\w.+-]+\@[\w.+-]+)/;
my ($from) = $head->get('From', 0) =~ /([\w.+-]+\@[\w.+-]+)/;
chomp $to;
chomp $from;
print STDERR "From: $from\nTo: $to\n";

# as suggested, there are three themes of 'To' with `From: lj_dontrelpy'
# 1) ljf-$usermail -- for including params in from/to
# 2) ljb-$usermail -- for including params in body
# 3) lji-$usermail -- for including params in message-id
# the last one is the only one i am going to implement now
# `@' in $usermail should be replaced with `+'

# on error behaviour is simple: die


if ($from =~ /^lj_notify\@$ljhost/ && 
    $to =~ /^lj[if]-([\w-]+)\+([\w.-]+)\@\w+/) { 

  # this message is comment notification from livejournal.com, parse
  # and resend.

  # this is where message will go
  my $address = "$1\@$2";
  print STDERR "new addr = $address\n";

  my ($poster) = $head->get('From') =~ /\(([\w.+-]+)/;
  $poster = 'anonymous' if ($poster =~ /^LiveJournal$/ || (!defined $poster));

  # yeah, we are promiscuous as hell, but let's at least make sure message
  # comes from livejournal.com
 
  unless (check_head($head)) {
    $head->print(\*STDERR);
    die "Suspicious header:\n";
  }
 
  die "Should be exactly two entity parts" unless ($entity->parts == 2) ;

  my %hash;

  # get hidden form values from second mime entity (counting from zero)
  get_inputs ($entity->parts(1)->bodyhandle->as_string, \%hash);

  die ("Incomplete form data") unless ($hash{userpost} && $hash{journal} &&
                                       $hash{parenttalkid} && $hash{itemid} &&
                                       $hash{ecphash} );

  # now form Message-Id:
  my $msgid = "$hash{userpost}+$hash{journal}+$hash{parenttalkid}" . 
              "+$hash{itemid}+" . substr($hash{ecphash},5) . "\@$host";
  
  print STDERR $msgid . "\n";

  # we got a problem here - there is already nice already built entity 
  # in $entity->parts(1), do we want to build it again? looks like we
  # have to -- man is whole fucking 1242 lines long, cant read it.

  my $charset = $entity->parts(0)->head->mime_attr('content-type.charset');

  my $newfrom;
  
  if ($to =~ /^ljf/) {    # reply identified by 'To' 
    $newfrom = "<ljf-$msgid>";
  } else {                # ($to =~ /^lji/), reply identified by 'In-Reply-To'
    $newfrom = "<lji\@$host>";
  }

  $newfrom = qq["ljegate ($poster)" $newfrom];

  # substr is needed because MIME::Tools is broken
  my $subj = decode_mimewords($head->get('Subject'));

  $subj = substr($subj,0,30);
  chomp $subj;

  my $newent = MIME::Entity->build(
    'From'         => $newfrom,
    'Sender'       => $newfrom,
    'To'           => $address,
    'Subject'      => encode_mimeword($subj, 'B', $charset),
    'Content-Type' => "text/plain; charset=$charset",
    'Message-Id'   => "<$msgid>",
    'References'   => "<$hash{journal}-$hash{parenttalkid}\@$host>",
    'Data'         => $entity->parts(0)->bodyhandle->as_string
    );

  # need to send it now, huh?
  
  $newent->send('sendmail');
  $newent->purge();
  $entity->purge();

} elsif ($to =~ /^lji\@$host/ ||  
         $to =~ /^ljf-(\w+)\+(\w+)\+(\w+)\+(\w+)\+(\w+)\@$host/) {

  # somebody replied to message we send in previous `if'

  my %h;

  if ($to =~ /^lji/) {
    print STDERR "In-Reply-To: " . ($head->get('In-Reply-To')||'')  . "\n";
    ($h{userpost}, $h{journal}, $h{parenttalkid}, $h{itemid}, $h{ecphash}) = 
      $head->get('In-Reply-To') =~ /<(\w+)\+(\w+)\+(\w+)\+(\w+)\+(\w+)\@$host>/;
  } elsif ($to =~ /^ljf/) { 
    ($h{userpost}, $h{journal}, $h{parenttalkid}, $h{itemid}, $h{ecphash}) = 
      $head->get('To') =~ /ljf-(\w+)\+(\w+)\+(\w+)\+(\w+)\+(\w+)\@$host/;
  } 

  unless ($h{userpost} && $h{journal} && $h{parenttalkid} && 
          $h{itemid} && $h{ecphash}) 
  {
    print "malformed id\n";
    die "malformed id\n";
  }

  $h{ecphash} = "ecph-" . $h{ecphash};

  $h{usertype} = 'user';
  $h{encoding} = $head->mime_attr('content-type.charset');
  $h{subject}  = decode_mimewords($head->get('Subject'));

  $h{body} = $entity->bodyhandle->as_string ;
  
  $entity->purge();

  my $req = new HTTP::Request('POST' => $lj_reply_uri) or die $!;
  $req->content_type('application/x-www-form-urlencoded');
  $req->content(href2string(\%h)) ;

  my $ua = new LWP::UserAgent or die $!;
  $ua->agent("$uastr/$ver");
  $ua->timeout($ua_timeout);
  my $res = $ua->request($req);
  
  if ($res->is_success) {
    print STDERR "Comment posted\n";
  } else {
    print "Failed to post comment\n";
    print "LJ server response:\n" ;
    print $res->content;
    print "\n";
    die "Failed to post comment\n" . ($res->content) . "\n";

  }

} elsif ($to =~ /^lj-post\@$host$/ || 
         $to =~ /^lj-post-(\w+)-(\w+)\@$host$/) { 

  # request to post journal entry

  my $req_data = {
    webversion    => 'full',
    security      => 'public',
    prop_opt_preformatted  => 0,
    mode          => 'postevent',
    ver           => 1,
    subject       => decode_mimewords($head->get('Subject'))||''
  };

  if ($1 && $2) { 
    $req_data->{user} = $1;
    $req_data->{hpassword} = $2;
  }

  my $users = {
    'nobody' => {
      auth => 'some key',
      password => 'some password'
    }
  };

  my $auth ;

  foreach ($entity->bodyhandle->as_lines) {
    if (exists $req_data->{event}) {
      $req_data->{event} .= $_ ;
      next ;
    }

    next if /^$/ ;

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

      next unless $val; # skip empty headers, eg '^mood:$'

      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 ;
        }
      } 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" || $var eq "format") {
        $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 ;
      } elsif ($var eq "username") { 
        $req_data->{user} = $val ;
      } else {
        $req_data->{$var} = $val ;
      }
    } else {
      $req_data->{event} = $_ ;
    }
  }

  my $mood_ids = {
    aggravated=>1,
    angry=>2,
    annoyed=>3,
    anxious=>4,
    bored=>5,
    confused=>6,
    crappy=>7,
    cranky=>8,
    depressed=>9,
    discontent=>10,
    energetic=>11,
    enraged=>12,
    enthralled=>13,
    exhausted=>14,
    happy=>15,
    high=>16,
    horny=>17,
    hungry=>18,
    infuriated=>19,
    irate=>20,
    jubilant=>21,
    lonely=>22,
    moody=>23,
    'pissed off'=>24,
    sad=>25,
    satisfied=>26,
    sore=>27,
    stressed=>28,
    thirsty=>29,
    thoughtful=>30,
    tired=>31,
    touched=>32,
    lazy=>33,
    drunk=>34,
    ditzy=>35,
    mischievous=>36,
    morose=>37,
    gloomy=>38,
    melancholy=>39,
    drained=>40,
    excited=>41,
    relieved=>42,
    hopeful=>43,
    amused=>44,
    determined=>45,
    scared=>46,
    frustrated=>47,
    indescribable=>48,
    sleepy=>49,
    groggy=>51,
    hyper=>52,
    relaxed=>53,
    restless=>54,
    disappointed=>55,
    curious=>56,
    mellow=>57,
    peaceful=>58,
    bouncy=>59,
    nostalgic=>60,
    okay=>61,
    rejuvenated=>62,
    complacent=>63,
    content=>64,
    indifferent=>65,
    silly=>66,
    flirty=>67,
    calm=>68,
    refreshed=>69,
    optimistic=>70,
    pessimistic=>71,
    giggly=>72,
    pensive=>73,
    uncomfortable=>74,
    lethargic=>75,
    listless=>76,
    recumbent=>77,
    exanimate=>78,
    embarrassed=>79,
    envious=>80,
    sympathetic=>81,
    sick=>82,
    hot=>83,
    cold=>84,
    worried=>85,
    loved=>86,
    awake=>87,
    working=>88,
    productive=>89,
    accomplished=>90,
    busy=>91,
    blah=>92,
    full=>93,
    grumpy=>95,
    weird=>96,
    nauseated=>97,
    ecstatic=>98,
    chipper=>99,
    rushed=>100,
    contemplative=>101,
    nerdy=>102,
    geeky=>103,
    cynical=>104,
    quixotic=>105,
    crazy=>106,
    creative=>107,
    artistic=>108,
    pleased=>109,
    bitchy=>110,
    guilty=>111,
    irritated=>112,
    blank=>113,
    apathetic=>114,
    dorky=>115,
    impressed=>116,
    naughty=>117,
    predatory=>118,
    dirty=>119,
    giddy=>120,
    surprised=>121,
    shocked=>122,
    rejected=>123,
    numb=>124,
    cheerful=>125,
    good=>126,
    distressed=>127,
    intimidated=>128,
    crushed=>129,
    devious=>130,
    thankful=>131,
    grateful=>132,
    jealous=>133,
    nervous=>134
  };

  if (exists $req_data->{prop_current_mood}) {
  	if (exists $mood_ids->{lc($req_data->{prop_current_mood})}) {
  		$req_data->{prop_current_moodid} = $mood_ids->{lc($req_data->{prop_current_mood})};
  		delete $req_data->{prop_current_mood};
  	}
  }

  if (lc($req_data->{security}) eq "friends" || lc($req_data->{security}) eq "protected") {
  	$req_data->{security} = "usemask";
  	if (!exists $req_data->{allowmask}) {
  		$req_data->{allowmask} = 1;
  	}
  }

  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 ;
  } elsif (!$req_data->{user} || 
          ((!$req_data->{password})&&(!$req_data->{hpassword}))) {
    print "Failed to add journal entry, user/passwd not specified\n";
    die ("No user/password combination specified");
  }

  my $req = new HTTP::Request('POST' => $lj_entry_uri) or die $!;
  $req->content_type('application/x-www-form-urlencoded');

  unless ($head->mime_attr('content-type.charset') =~ /^utf-?8$/) {
    foreach (keys %{$req_data}) { 
      $req_data->{$_} = to_utf8(
        { -string  => $req_data->{$_}, 
          -charset => $head->mime_attr('content-type.charset')
        }
      );
    } 
  }

  $req->content(href2string($req_data)) ;
  
  $entity->purge();

  my $ua = new LWP::UserAgent or die $!;
  $ua->agent("$uastr/$ver");
  $ua->timeout($ua_timeout);
  my $res = $ua->request($req);
  
  if ($res->is_success) {
    print STDERR $res->content;
    print STDERR "Journal entry posted\n";
    foreach (split (/\n/, $res->content)) {
      chomp;
      if (/^errmsg/) {
        print $res->content;
        die "Post failed:\n" . $res->content . "\n";
      }
    }
  } else {
    print "Failed to post journal entry\nFull server responce below:\n" 
         . $res->error_as_HTML;
    die "Failed to post journal entry\n";
  }
  
} elsif ($from =~ /^.*\@livejournal.com/ && 
           $to =~ /^lji-([\w-]+)\+([\w.+-]+)\@\w+/) { 

  $entity->head->replace('To', "$1\@$2");

  $entity->send('sendmail');
  $entity->purge();
  print STDERR "Resending mail as it is...\n";

} else { 

  $entity->purge();
  print "\n\n\nljegate got really confused by this message\n\n\n\n";
  die "Dont know what to do with this message\n";
}
  
# vim:ai:et:ts=2:sw=2:tw=78: