#! /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 <lev@ledorub.poxod.com> 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("<nobr><i><b>From:</b> ", "ISO-8859-1" )
. $from
. str2utf8("</i></nobr>\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 <nobr>...</nobr> 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.*)$/<nobr>$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*$/ ) ?
'<lj-cut>' :
'<lj-cut text="' . $opt_ljcut_text . '">' ;
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' => <<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() ;
}
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 \<lev\@ledorub.poxod.com\>, 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 (<nobr><i><b>From:</b> Address</i></nobr>). 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 <nobr> 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 '<lj-cut>' 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 <lj-cut text="TEXT">).
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;
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mail2lj.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Local Repository] / mail2lj