#! /usr/bin/perl -w # # The script to post mail messages to LiveJournal # (see http://mail2lj.nichego.net/ for original). # # Changes by LG (all are labelled by '# Changed by LG' string): # - Removed all references to Mail2LJ::Config and $cfg (just as author's # comment below says). # - Changed $host definition. # - Changed location of mimemtmp subdirectory from $HOME to /tmp # - Changed location and name of log file to $HOME/mail/mail2lj.log # - In bounces and responces replaced charset from Windows-1251 to koi8-r # - Added comment-parsing settings (keyword Comments: can be "no" or "off" # to forbid comments, or "noemail" to not email comments). If not set, # falls back to Journal's Default, obviously. # - Removed "[mail2lj]" label in the subject. # # ! - Added command line parsing. Now all the keywords can be specified # on the command line (see '-h' for help). Collected options are passed # on to the posting subroutine and *override* corresponding body keywords # values (e.g., now you can specify '--usejournal' when posting via # 'hpost-(user)-(MD5Hash)' alias). As an added bonus, now it's possible # to post COMPLETELY without body keywords (via either 'post', # 'post-(user)-(password) or 'hpost-(user)-(MD5Hash)' aliases), so you # can use the script as a general purpose mail-to-LJ-anywhere gateway. # E.g. it'll work great in procmail. # # ! - Changed recipient of bounce messages in send_bounce() function to allow # optional designation of custom error recipient (as opposed to strictly # original From: address). This is convenient when you want to notify # script maintainer instead of the poster (exactly what I need). # # Changes by Boris Veytsman - added --cut option # # Changes by LG: added --obfuscate option to protect e-mails in the body. # # NB: to generate MD5 hash of your password, use the following command: # perl -MDigest::MD5 -e 'print Digest::MD5::md5_hex("yourpassword")."\n"' # # # Adopted by Lev Gorenstein from the original # script by jason@nichego.net (http://livejournal.com/users/jsn/) which # is available at http://mail2lj.nichego.net/ # # Original script seems to be distributed as freeware, so I stick to that # decision. No warranty whatsoever, of course - use at your own risk ;-). # # ------------------------------------------------------------------------ use strict ; use Getopt::Long; 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 utf8_charset_alias/ ; use HTML::TokeParser ; # Changed by LG - commented out configs. # use Mail2LJ::Config ; # you can just remove every line mentioning # # Mail2LJ::Config or $cfg # # my $cfg = $Mail2LJ::Config::conf ; # Changed by LG - added shorname and version. (my $shortname = $0) =~ s/^.*\///; # script name without path my $Version = "0.9"; # Version number my $LGmod = "-LG"; # Version modifier by LG 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" ; # Changed by LG # my $host = $ENV{MAIL2LJ_DOMAIN} || `hostname -f` ; # Changed by LG my $host = $ENV{MAIL2LJ_DOMAIN} || "ledorub.poxod.com" ; # Changed by LG # my $home = $ENV{HOME} || "/home/mail2lj" ; # Changed by LG my $home = $ENV{HOME} || "/tmp/mail2lj" ; # Changed by LG - added because sometimes procmail doesn't set $USER. my $SysUser = $ENV{USER} || $ENV{LOGNAME} || getpwuid($>) || $> ; # Changed by LG. Specifies the default incoming and outgoing charset for # all e-mails (i.e, the posts CONTENT and the script replies). # For incoming mails, the MIME header is analyzed and actual MIME charset # overrides the default, of course. # my $MailCharset = "cp1251"; my $MailCharset = "koi8-r"; # Changed by LG. Specifies the charset in which non-English characters # FROM THE COMMAND LINE are entered. I.e. if I give a command line option # '--subject ôÅÓÔ', the script needs to know the encoding to properly convert # it to UTF8. I'm too lazy to analyze current locale, so I'll make it the # user's responsibility. Override via '--charset' option. # my $SystemCharset = "cp1251"; # my $SystemCharset = "utf8"; my $SystemCharset = "koi8-r"; # Translation table for smstrip_data() function. Only used whith aliases # ljreply-... and ljreplys-... 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' ); # What to convert '@' to when obfuscating e-mail addresses (in '--add-from' # and/or '--obfuscate' modes. my $newdog = '[_@_]'; # ------------------------------------------------------------------------ # # End configuration settings. # ------------------------------------------------------------------------ # # ------------------------------------------------------------------------ # # Changed by LG - added parsing of command line. # Changed by BV - added options cut # ------------------------------------------------------------------------ # my %Opt = (); # Main options go here my $opt_h ; # Help flag my $opt_bounces ; # Alternative error recipient flag my $opt_addfrom ; # Add the From field to the post my $opt_addfromh ; # Add the htmlized From to the post my $opt_keepspaces ; # HTML-encode multiple spaces in e-mail my @opt_taglist ; # command-line taglist first goes here my $opt_ljcut ; # Add lj-cut after line number N my $ljcut_delta = 5 ; # No lj-cut if less lines left after it my $opt_ljcut_text ; # A text for lj-cut. my $opt_obfuscate ; # Obfuscate e-mail addresses in body my $Parse = GetOptions( \%Opt, 'user|u=s', 'password|passwd|p=s', 'hpassword|hpasswd|hp=s', 'date|d=s', 'security|sec=s', 'prop_opt_preformatted|formatted|f!', 'prop_opt_backdated|backdated|back-dated|backdate|back-date|back!', 'subject|subj|s=s', 'taglist|tags|tag|t=s' => \@opt_taglist, # Will tweak 'notaglist|notags|notag|not|no-taglist|no-tags|no-tag|no-t' => sub {undef @opt_taglist}, 'usejournal|use-journal|use|journal|j=s', 'prop_current_mood|current_mood|mood=s', 'prop_current_music|current_music|music=s', 'prop_picture_keyword|picture_keyword|picture|pic|userpic=s', 'comments|comment|c=s', # Will tweak below 'charset|enc=s' => \$SystemCharset, 'bounces|bounce|b=s' => \$opt_bounces, 'addfrom|add-from|from!' => \$opt_addfrom, 'addfromh|add-fromh|fromh!' => \$opt_addfromh, 'ljcut|lj-cut|cut|l=i'=>\$opt_ljcut, 'ljcut-text|lj-cut-text|cut-text|ljcuttext|cuttext=s'=>\$opt_ljcut_text, 'keep-spaces|keep-space|keepspaces|keepspace|spaces|space!' => \$opt_keepspaces, 'obfuscate|obfu|o!' => \$opt_obfuscate, 'help|h' => \$opt_h, ); # Handle bad options if ( ! $Parse ) { print_usage('short'); die "Run with '-h' for more help.\n\n"; } # Print help if requested. print_usage('long'), exit 0 if ($opt_h); # Check if '--date' was specified and convert hash value to proper format # for LJ request. if ( exists $Opt{'date'} ) { # Note: "DD.MM.YYYY HH:MM". Single-digit day, month and hour are allowed. # Double-digit "YY" is also allowed and considered "2000 + YY" if ( $Opt{'date'} =~ /(\d\d?)\.(\d\d?)\.(\d{2,4})\s+(\d\d?):(\d\d)/ ) { $Opt{'day'} = $1 ; $Opt{'mon'} = $2 ; $Opt{'year'} = $3 ; $Opt{'hour'} = $4 ; $Opt{'min'} = $5 ; $Opt{'year'} += 2000 if $Opt{'year'} < 100 ; } else { print STDERR "can't parse date '$Opt{'date'}', using current.\n" ; } delete $Opt{'date'} ; # And remove the old element. } # Comments option is 'comments yes/no/nomail', but LJ wants # 'prop_opt_*no*comments' property. Keep command line human-readable and # switch to proper value in the hash. if ( exists $Opt{'comments'} ) { if ( $Opt{'comments'} =~ /^s*((on)|(yes)|(default))\s*$/i ) { $Opt{'prop_opt_nocomments'} = "" ; } elsif ( $Opt{'comments'} =~ /^\s*(noe?mails?)\s*$/i ) { $Opt{'prop_opt_nocomments'} = "" ; $Opt{'prop_opt_noemail'} = 1 ; } elsif ( $Opt{'comments'} =~ /^\s*((off)|(no))\s*$/i ) { $Opt{'prop_opt_nocomments'} = 1 ; } else { $Opt{'prop_opt_nocomments'} = $Opt{'comments'} ; } delete $Opt{'comments'} ; # And remove the old element. } # Convert taglist array into a single string and store it # with other parameters. $Opt{'prop_taglist'} = join( ", ", @opt_taglist ) if ( @opt_taglist ) ; # Convert $opt_ljcut_text to UTF8. $opt_ljcut = 0 unless defined $opt_ljcut ; # Safety if ( defined $opt_ljcut_text ) { $opt_ljcut_text = to_utf8({ -string => $opt_ljcut_text, -charset => $SystemCharset }) ; } # Convert all %Opt command line options to unicode. # Function href2utf8() uses a reference to input hash, so %Opt is # being modified "in-place". href2utf8( \%Opt, $SystemCharset) ; # Changed by LG - set a restrictive umask (we're talking mail files here!) umask 077 ; # Changed by LG: make sure that 'UTF-8' is recognized as a valid charset # along with "UTF8" ;-) utf8_charset_alias({ 'UTF-8' => 'UTF8' }); # Changed by LG - moved from above. my $alias = shift @ARGV || "none" ; my $mp = new MIME::Parser() or die "new MIME::Parser(): $!\n" ; # Changed by LG - changed directory to be user and process-specific. # $mp->output_dir("$home/mimetmp") ; $mp->output_dir("/tmp/mimetmp-" . $SysUser . "-$$") ; mkdir $mp->output_dir if not -d $mp->output_dir ; # Create it if missing # Get the whole mail. # Changed by LG - added removal of output directory. my $me = $mp->parse(\*STDIN) ; END { $me and $me->purge() ; rmdir $mp->output_dir if -d $mp->output_dir or print STDERR "Error removing $mp->output_dir: $!\n" ; } ; # Changed by LG - different log file name. # open(STDERR, ">>$home/generic.log") or die "open(`log'): $!\n" ; my $logdir = "$home/mail" ; mkdir $logdir if not -d $logdir ; # Create it if missing open(STDERR, ">>$logdir/mail2lj.log") or die "open(`log'): $!\n" ; my $users = {} ; # $users = $cfg->{users} ; # Get mail header. my $mh = $me->head() ; $me->dump_skeleton(\*STDERR) ; # Changed by LG - added chomping of "To:" field. my $to = $me->get('To') || "" ; chomp $to ; print STDERR "Alias: $alias\n", "To: $to\n", "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" ; } # And here we do posting. if ($alias =~ /MAILER-DAEMON/i) { exit 0 ; } elsif ($alias =~ /^post$/) { # my $req = post_me2req($me, "windows-1251") ; # Changed by LG my $req = post_me2req($me, "$MailCharset", { %Opt }) ; # Changed by LG 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", { # Changed by LG # user => $l, # password => $p my $req = post_me2req($me, "$MailCharset", { # Changed by LG user => $l, password => $p, %Opt # Changed by LG }) ; 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", { # Changed by LG # user => $l, # hpassword => $hp my $req = post_me2req($me, "$MailCharset", { # Changed by LG user => $l, hpassword => $hp, %Opt # Changed by LG }) ; 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() ; # Changed by LG - changed to a variable. # my $charset = # ($me->parts(0)->head->mime_attr('content-type.charset') || # "windows-1251") ; my $charset = ($me->parts(0)->head->mime_attr('content-type.charset') || "$MailCharset") ; 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 ; # Changed by LG - changed to a variable. # $data = from_utf8({ -string => $data, -charset => "cp1251"}) ; # $charset = "windows-1251" ; $data = from_utf8({ -string => $data, -charset => "$MailCharset"}) ; $charset = "$MailCharset" ; $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' ; # Changed by LG. # $hr->{encoding} = $mh->mime_attr('content-type.charset') || # "cp1251" ; $hr->{encoding} = $mh->mime_attr('content-type.charset') || "$MailCharset" ; $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")) ; } } print STDERR "-------------------------------------------------------------\n" ; # ------------------------------------------------------------------------- # # All done. # ------------------------------------------------------------------------- # exit 0 ; # ------------------------------------------------------------------------- # # Subroutines from now down. # ------------------------------------------------------------------------- # 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") { # Changed by LG. # Note: "DD.MM.YYYY HH:MM". Single-digit day, month and # hour are allowed. Double-digit "YY" is also allowed # and considered "2000 + YY". 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', will use current\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 =~ /^\s*((on)|(yes))\s*$/i ; $val = 0 if $val =~ /^\s*((off)|(no))\s*$/i ; # Changed by LG - "autoformat" is opposite to "formatted". # Add 0 to make sure it's the number. $val = 0 + (not $val) if ($var eq "autoformat") ; $req_data->{prop_opt_preformatted} = $val ; } elsif ($var eq "auth") { $auth = $val ; # Changed by LG - added 'backdated' option. Remember, # Livejournal currently prohibits backdated entries in the # communities (as opposed to individual journals). } elsif ($var =~ /^back-?dated?$/ || $var eq "opt_backdated") { $val = 1 if $val =~ /^\s*((on)|(yes))\s*$/i ; $val = 0 if $val =~ /^\s*((off)|(no))\s*$/i ; $req_data->{prop_opt_backdated} = $val ; # Changed by LG - added comment-parsing settings. # Comments: default/on/yes | off/no | nomail # Assembled based on data from form values in the browser # and from info on # http://www.livejournal.com/doc/server/ljp.csp.flat.postevent.html # http://www.livejournal.com/doc/server/ljp.csp.proplist.html } elsif ($var eq "comments" || $var eq "comment" || $var eq "comment_settings" || $var eq "comments_settings" ) { if ( $val =~ /^\s*((on)|(yes)|(default))\s*$/i ) { # Journal default $val = "" ; $req_data->{comment_settings} = $val ; $req_data->{prop_opt_nocomments} = $val ; } elsif ( $val =~ /^\s*(noe?mails?)\s*$/i ) { # No emails $val = "1" ; $req_data->{prop_opt_nocomments} = (not $val) + 0; $req_data->{prop_opt_noemail} = $val ; } elsif ( $val =~ /^\s*((off)|(no))\s*$/i ) { # No comments $val = "1" ; $req_data->{prop_opt_nocomments} = $val ; } else { # Anything else. $req_data->{comment_settings} = $val ; } # Changed by LG - added 'tags' option. } elsif ($var =~ /^tags?$/ || $var eq "taglist") { $req_data->{prop_taglist} = $val; # Changed by LG - added 'notags' option. Empty the preceding # taglist if set to true, otherwise do nothing } elsif ($var =~ /^no-?tags?$/ || $var eq "no-?taglist") { $req_data->{prop_taglist} = "" if $val =~ /^\s*((on)|(yes))\s*$/i ; # Changed by LG - added 'Obfuscate' option to protect e-mail # addresses in the body of the message. } elsif ($var =~ /^obfuscate$/ ) { $val = 1 if $val =~ /^\s*((on)|(yes))\s*$/i ; $val = 0 if $val =~ /^\s*((off)|(no))\s*$/i ; $opt_obfuscate = $val ; # Anything else - just assign. } 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 ; } # Changed by LG - added this subroutine for a shortcut call to to_utf8(). # All it does is conversion of a string to utf8. sub str2utf8 { my ($s, $e) = @_; my $r = "" ; $r .= to_utf8({ -string => $s, -charset => $e }) ; return $r ; } sub post_me2req { my ($me, $e, $hints) = @_ ; # Changed by LG - if no body found (may happen sometimes in multipart # messages) then attempt to grab the very first MIME part. This is # somewhat hack-ish, but generally works ;-) # my $mebh = $me->bodyhandle() or die "post_message(): no body?\n" ; my $mebh = $me->bodyhandle() ; my $mehh = $me->head() ; if ( ! defined $mebh ) { # Hack! And get the corresponding header instead of overall one. $mebh = $me->parts(0)->bodyhandle() or die "post_message(): no body?\n" ; $mehh = $me->parts(0)->head() ; } my $charset = $mehh->mime_attr("content-type.charset") || $e ; my $subject = hdr2utf8($me->get('Subject') || "", $charset) ; chomp $subject ; # Changed by LG # Changed by LG. my $from = hdr2utf8($me->get('From') || "", $charset) ; chomp $from ; my $olddog_utf8 = str2utf8("\@", "ISO-8859-1") ; # @ in utf my $newdog_utf8 = str2utf8($newdog, "ISO-8859-1") ; # obfuscated in utf 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) { # Changed by LG - make hints override (not just complement) # existing values. # $hr->{$i} ||= $hints->{$i} ; $hr->{$i} = $hints->{$i} ; } } $hr->{subject} ||= $subject ; # Changed by LG - removed prefixing. # $hr->{subject} = "[mail2lj] " . $hr->{subject} ; # Changed by LG - added option to obfuscate all e-mail addresses in # the body of mail messages. if ( $opt_obfuscate ) { $hr->{event} =~ s/\b([-+_.\w]+)($olddog_utf8)([-_.\w]+)\b/$1${newdog_utf8}$3/g ; } # Changed by LG - added options to add the plain or HTML-ized 'From' # field to the posted message. # # NOTE: $from is already in UTF8, but the "From:" and HTML tags are # not. Strictly speaking, everything that goes to $hr->{event} # MUST ALSO BE IN UTF8. A cheating shortcut is possible: # since all lower ASCII characters are guaranteed to have # the same values in UTF8 as in plain ISO-8859-1, you could # possibly stick ASCII strings to $from without risk. But in # order to add something non-ASCII, you absolutely MUST convert # it to UTF8 first! To avoid the risk of forgetting this, the # following substitutions are done in a _proper_ (albeit # somewhat awkward) way. if ( $opt_addfrom || $opt_addfromh ) { # Assemble the added From string in UTF8. my $added_from ; if ( $opt_addfrom ) { $added_from = str2utf8("From: ", "ISO-8859-1") . $from . str2utf8("\n\n", "ISO-8859-1") ; } elsif ( $opt_addfromh ) { $added_from = str2utf8("From: ", "ISO-8859-1" ) . $from . str2utf8("\n\n", "ISO-8859-1") ; } # This address is alway obfuscated (independently of the # '--obfuscate' option which only governs addresses _already_ # in the body. $added_from =~ s/$olddog_utf8/$newdog_utf8/g ; # Obfuscate $hr->{event} = $added_from . $hr->{event} ; # And append } # Changed by LG - added an option to preserve (html-ize) multiple # spaces and tabs (convert '\t' to eight ' ' and convert # multiple continuous spaces into sequence of '  '). # Lines with tabs are additionally wrapped in ... tags. # # NOTE: These tags should be in UTF8. But since HTML tags themselves # are *certainly* in lower ASCII, we can safely stick them on # top of the existing UTF8 post. But if you dare to add # anything more than ASCII-markup, you'd better str2utf8() it # first! See note in the $opt_addfrom/$opt_addfromh processing above. if ( $opt_keepspaces ) { $hr->{event} =~ s/^(.*\t.*)$/$1<\/nobr>/gm ; $hr->{event} =~ s/\t/\ \ \ \ \ \ \ \ /g ; $hr->{event} =~ s/ / \ /g ; } # # Change by BV - added the option to put lj-cut after '--cut XX' lines # # Tweaked by LG - only adding lj-cut if more than $ljcut_delta lines # is left in the posting. Also added $opt_ljcut_text. # if ($opt_ljcut>0) { my $nlines = scalar( my @junk=split( /\n/, $hr->{event}, -1) ) - 1; my $start=0; for (my $i=0; $i<$opt_ljcut; $i++) { $start=index($hr->{event},"\n",$start)+1; if ($start == 0) { last; } } # And insert the lj-cut if not too close to the end of the post. if ($start>0 ) { if ( $nlines >= $opt_ljcut+$ljcut_delta ) { my $ljcut = ( $opt_ljcut_text =~ /^\s*$/ ) ? '' : '' ; substr($hr->{event}, $start,0) = $ljcut ; } else { print STDERR "'--cut $opt_ljcut' requested, which is " . "within $ljcut_delta of the total $nlines " . "lines. Skipping lj-cut.\n" ; } } } $req->content_type('application/x-www-form-urlencoded'); $req->content(href2string $hr) ; print STDERR "working on request from $hr->{user}\n", "From: $from\n", # Changed by LG "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" ; # Changed by LG - modified user-agent # $ua->agent("Mail2LJ/0.9"); $ua->agent("Mail2LJ/${Version}${LGmod}"); $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) ; } 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) = @_ ; # Changed by LG - use KOI-8 instead of Win-1251. # $charset ||= "windows-1251" ; $charset ||= "$MailCharset" ; my $bmsg = build MIME::Entity( 'From' => "MAILER-DAEMON\@$host", # Changed by LG - allow use of alternative addres for notifications. # 'To' => $orig->get('From'), 'To' => $opt_bounces || $orig->get('From'), 'Subject' => ( "mail2lj failure (was: " . $orig->get('Subject') . ")" ), 'Content-Type' => "text/plain; charset=$charset" , 'Data' => <send("sendmail") ; $bmsg->purge() ; } sub print_usage { # ----------------------------------------------------------------------- # # print_usage( $Long ); # # Prints help message. If defined $Long, the message is more detailed # as opposed to default brief description. # ----------------------------------------------------------------------- # my ( $long ) = @_; # Were we called with a parameter? my $spacer = ' ' x length($shortname); # bunch of spaces # --------------------------------------------------------------------- # Short usage will always be printed when called. # Indentation messed up because of the HERE-document. # --------------------------------------------------------------------- print <<___END_SHORT; $shortname v. ${Version} by jason\@nichego.net (http://jsn.livejournal.com). Tweaked to v. ${Version}${LGmod} by Lev Gorenstein \, 2007. Usage: $shortname ACTION [options] < InputFile cat MailMessage | $shortname ACTION [options] A script to post incoming mail messages to Livejournal.com journals. Reads STDIN and connects to Livejournal's HTTP posting interface. This is a modification of mail2lj.pl script by Jason (http://jsn.livejournal.com) described at http://mail2lj.nichego.net/. I added command line processing and couple more tweaks. Distributed freely under GNU Public License with absolutely no warranty. ___END_SHORT # --------------------------------------------------------------------- # When called in a long format, usage should be followed by some more info. # Indentation messed up because of the HERE-document. # --------------------------------------------------------------------- if ( defined $long && $long !~ /^\s*short\s*$/i ) { print <<______END_HELP; ACTIONS: post Original script used this to handle messages that had keywords inside (see http://mail2lj.nichego.net/userguide.html) and used 'post-...' and 'hpost-...' to post keywordless messages directly. This version doesn't require keywords (i.e. 'post' can handle keywordless messages and everything can be set via command line), but if you DO use keywords, then use this action. post-(user)-(password) A direct post of mail message (without looking for keywords in the body) using whatever settings supplied on the command line. With proper command line parameters, username and password can be completely bogus (i.e. 'post-aa-bb -u RealUser -p RealPass'). hpost-(user)-(MD5Hash_of_password) A direct post of mail message (without looking for keywords in the body) using whatever settings supplied on the command line, Same as 'post-...', but uses a password hash instead of clear-text password. With proper command line parameters, username and hash can be completely bogus (i.e. 'hpost-aa-bb -u RealUser --hp RealHash'). Options: -u USER, --user USER Use this LiveJournal user name to login. -p PASS, --password PASS Use this LiveJournal password to login. Use of this option is deprecated because of clear-text password. -hp MD5Hash, --hpassword MD5Hash Use this MD5 hash of the password to login. To generate a hash, do this: perl -MDigest::MD5 \ -e 'print Digest::MD5::md5_hex("PASSWORD")."\\n"' -j JOURNAL, --usejournal JOURNAL When posting to the community (or the journal that's different from the one you've specified via '--user'), use this option to specify that community's name. E.g. if the user 'gusarskie_vesti' wants to post to community 'gusary', it can be done with options like this: post -u gusarskie_vesti -p PASS --usejournal gusary -s SUBJECT, --subject SUBJECT Use this subject for the posting. If absent, defaults to e-mail's Subject:. -t TAGLIST, --tags TAGLIST Use tags from TAGLIST for posted message. Within a tag list, tags should be separated by commas. If your tags contain special characters or spaces, make sure to enclose TAGLIST in single or double quotes to protect from the shell. Multiple '-t' options are allowed and taglists will be combined. --notaglist, --notags Unsets all previously defined tags. Thus, a call to $shortname ... --tags X --tags Y ... --notags --tags Z will yield a taglist consisting of just "Z". This option is rarely needed and added only for the sake of completeness. -d DATE, --date DATE Label posting with this date. Date should be in LiveJournal's format: DD.MM.YYYY HH:mm. If absent, current date/time is used. --backdated If set, tells LiveJournal to make this message back-dated (i.e. to set 'Date out-of-order' flag to prevent this item from showing in people's friends lists). Note that currently Livejournal only allows back-dated entries in individual journals (not in communities), so use with caution. The option can be negated ('--nobackdated'). Default is '--nobackdated'. --security public|protected|private Post security mode. Default is "public". -f, --formatted If set, tells LiveJournal to assume our message to be already formatted (i.e. '--formatted' turns OFF LJ's autoformat feature). The option can be negated ('--noformatted'). Default is '--noformatted' (i.e. *use* LJ's autoformat). --mood MOOD Current Mood for Livejournal. TEXT ONLY (images not supported). Defaults to nothing. --music MUSIC Current Music for Livejournal. Defaults to nothing. --picture KEYWORD, --userpic KEYWORD Keyword for the Livejournal userpic to use. Default one is used when not specified. -c on|yes|default|off|no|noemail, --comments on|yes|default|off|no|noemail Controls permissions to leave comments for this post. "on" ("yes", "default") will use the journal's default settings. "off" or "no" prohibit comments. "noemail" allows comments, but tells Livejournal not to email them to you. --from, --addfrom Insert the From: field from the e-mail as the first line of the posted message. The field is added in plain text (without any HTML-formatting - see '--fromh' for that). For slight antispam protection, '\@' is replaced by '$newdog'. The option can be negated ('--nofrom'). Default is '--nofrom'. Note: this option is independent from '--obfuscate' (i.e. the prepended From is always obfuscated, even if the rest of the message is not). --fromh, --addfromh Same as '--from', but uses HTML-markup to highlight inserted field (From: Address). This is nice for mailing list -> Livejournal crossposting. The option can be negated ('--nofromh'). Default is '--nofromh'. -o, --obfuscate Obfuscate all e-mail addresses that are present in the body of the message. For slight antispam protection, '\@' in these addresses is replaced by '$newdog'. The option can be negated ('--noobfuscate'). Default is '--noobfuscate'. --spaces, --keepspaces Normally the script does not change original message text, and all of it is preserved in the body of resulting LJ post. Which means that all tabs and multiple consecutive spaces (while valid in e-mail and preserved in the post), will not be properly *shown* in the browser (browser will display them as single space). With '--spaces', however, all tabs will be converted to 8 '\ ' instances, and each pair of consecutive spaces will be converted to a ' \ ' sequence. Additionally, lines with tabs will be wrapped in tag. This way the formatting of original e-mail will be much better preserved in the journal. The option can be negated ('--nospaces'). Default is '--nospaces'. --ljcut NUM, --cut NUM, -l NUM Inserts '' after NUM lines of the post content. If the resulting lj-cut happens to be within $ljcut_delta lines from the end of the post, the cut will not be added. --ljcut-text TEXT, --cut-text TEXT, --cuttext TEXT Text to use as lj-cut text parameter (in ). If the text contains nothing but whitespace, it is ignored. Remember to quote spaces and special characters from the shell. --charset CHARSET This option tells the script that all COMMAND LINE options are given in this charset. Default is "$SystemCharset". Remember, THIS HAS NOTHING TO DO with the __posting's charset__ (which is determined from email headers and then converted to utf8). It also has absolutely no effect on the in-the-body keywords (they are also governed by email's charset). This option is meaningful ONLY for the text that you supply VIA COMMAND LINE (e.g. '-s Subject' or '--cuttext TEXT'). -b xxx\@yyy, --bounces xxx\@yyy Normally, if errors occur during posting (e.g. wrong password), the script sends an error notification to the _original poster_ (i.e., the address in the original From: field). This makes perfect sense for multi-user installations. But occasionally there is a need to send all errors to a single _maintainer_ (e.g., if you use the script as a mailing list --> LiveJournal gateway). This option allows exactly that. Default is unset (i.e. errors go to original poster). -h, --help: This help. If you decide to use keywords in the body of the message (as opposed to command line options), they should look like this: From: .... \\ To: .... + # Regular e-mail headers Subject: ... / # Normal blank line after headers User: gusarskie_vesti Password: password # (or Hpassword: MD5Hash) Date: 22.01.2007 5:04 Security: private Subject: Rzhevskij zhiv! Tags: Junk, Viva Rzhevskij! Notags: yes # Clears all preceding tags Formatted: on # Or equivalent "Autoformat: off" Usejournal: gusary Mood: okay Music: silence Backdated: yes Comments: no # Blank line Oh well. some text # Text of your message. And the text would be posted. Almost all keyword fields (as well as their command line counterparts) are optional and have reasonable defaults. The only mandatory parameter is the user name (well, doh!). See more on keywords in the original script's user guide: http://mail2lj.nichego.net/userguide.html ______END_HELP print "\n"; } # End of "if $long" test # --------------------------------------------------------------------- # All done # --------------------------------------------------------------------- return; }