Annotation of mail2lj/mail2lj.pl, revision 1.1
1.1 ! boris 1: #! /usr/bin/perl -w
! 2: #
! 3: # The script to post mail messages to LiveJournal
! 4: # (see http://mail2lj.nichego.net/ for original).
! 5: #
! 6: # Changes by LG (all are labelled by '# Changed by LG' string):
! 7: # - Removed all references to Mail2LJ::Config and $cfg (just as author's
! 8: # comment below says).
! 9: # - Changed $host definition.
! 10: # - Changed location of mimemtmp subdirectory from $HOME to /tmp
! 11: # - Changed location and name of log file to $HOME/mail/mail2lj.log
! 12: # - In bounces and responces replaced charset from Windows-1251 to koi8-r
! 13: # - Added comment-parsing settings (keyword Comments: can be "no" or "off"
! 14: # to forbid comments, or "noemail" to not email comments). If not set,
! 15: # falls back to Journal's Default, obviously.
! 16: # - Removed "[mail2lj]" label in the subject.
! 17: #
! 18: # ! - Added command line parsing. Now all the keywords can be specified
! 19: # on the command line (see '-h' for help). Collected options are passed
! 20: # on to the posting subroutine and *override* corresponding body keywords
! 21: # values (e.g., now you can specify '--usejournal' when posting via
! 22: # 'hpost-(user)-(MD5Hash)' alias). As an added bonus, now it's possible
! 23: # to post COMPLETELY without body keywords (via either 'post',
! 24: # 'post-(user)-(password) or 'hpost-(user)-(MD5Hash)' aliases), so you
! 25: # can use the script as a general purpose mail-to-LJ-anywhere gateway.
! 26: # E.g. it'll work great in procmail.
! 27: #
! 28: # ! - Changed recipient of bounce messages in send_bounce() function to allow
! 29: # optional designation of custom error recipient (as opposed to strictly
! 30: # original From: address). This is convenient when you want to notify
! 31: # script maintainer instead of the poster (exactly what I need).
! 32: #
! 33: #
! 34: # NB: to generate MD5 hash of your password, use the following command:
! 35: # perl -MDigest::MD5 -e 'print Digest::MD5::md5_hex("yourpassword")."\n"'
! 36: #
! 37: #
! 38: # Adopted by Lev Gorenstein <lev@ledorub.poxod.com> from the original
! 39: # script by jason@nichego.net (http://livejournal.com/users/jsn/) which
! 40: # is available at http://mail2lj.nichego.net/
! 41: #
! 42: # Original script seems to be distributed as freeware, so I stick to that
! 43: # decision. No warranty whatsoever, of course - use at your own risk ;-).
! 44: #
! 45: # ------------------------------------------------------------------------
! 46:
! 47: use strict ;
! 48:
! 49: use Getopt::Long;
! 50: use LWP::UserAgent ;
! 51: use HTTP::Request ;
! 52: use URI::Escape ;
! 53: use MIME::Parser ;
! 54: use MIME::Words qw/decode_mimewords encode_mimeword/ ;
! 55: use Unicode::MapUTF8 qw/to_utf8 from_utf8/ ;
! 56: use HTML::TokeParser ;
! 57:
! 58: # Changed by LG - commented out configs.
! 59: # use Mail2LJ::Config ; # you can just remove every line mentioning
! 60: # # Mail2LJ::Config or $cfg
! 61: #
! 62: # my $cfg = $Mail2LJ::Config::conf ;
! 63:
! 64: # Changed by LG - added shorname and version.
! 65: (my $shortname = $0) =~ s/^.*\///; # script name without path
! 66: my $Version = "0.9"; # Version number
! 67: my $LGmod = "-LG"; # Version modifier by LG
! 68:
! 69:
! 70: my $post_uri = "http://www.livejournal.com/cgi-bin/log.cgi" ;
! 71: my $ljcomment_action = 'http://www.livejournal.com/talkpost_do.bml';
! 72: # my $host = $ENV{MAIL2LJ_DOMAIN} || "mail2lj.nichego.net" ; # Changed by LG
! 73: # my $host = $ENV{MAIL2LJ_DOMAIN} || `hostname -f` ; # Changed by LG
! 74: my $host = $ENV{MAIL2LJ_DOMAIN} || "ledorub.poxod.com" ; # Changed by LG
! 75: # my $home = $ENV{HOME} || "/home/mail2lj" ; # Changed by LG
! 76: my $home = $ENV{HOME} || "/tmp/mail2lj" ;
! 77:
! 78: # Changed by LG. Specifies the default incoming and outgoing charset for
! 79: # all e-mails (i.e, the posts CONTENT and the script replies).
! 80: # For incoming mails, the MIME header is analyzed and actual MIME charset
! 81: # overrides the default, of course.
! 82: # my $MailCharset = "cp1251";
! 83: my $MailCharset = "koi8-r";
! 84:
! 85: # Changed by LG. Specifies the charset in which non-English characters
! 86: # FROM THE COMMAND LINE are entered. I.e. if I give a command line option
! 87: # '--subject ôÅÓÔ', the script needs to know the encoding to properly convert
! 88: # it to UTF8. I'm too lazy to analyze current locale, so I'll make it the
! 89: # user's responsibility. Override via '--charset' option.
! 90: # my $SystemCharset = "cp1251";
! 91: # my $SystemCharset = "utf8";
! 92: my $SystemCharset = "koi8-r";
! 93:
! 94:
! 95: # Translation table for smstrip_data() function. Only used whith aliases
! 96: # ljreply-... and ljreplys-...
! 97: my %tr = (
! 98: 'á' => 'A', 'â' => 'B', '÷' => 'V', 'ç' => 'G', 'ä' => 'D', 'å' => 'E', '³' =>
! 99: 'E', 'ö' => 'Zh', 'ú' => 'Z', 'é' => 'I', 'ê' => 'J', 'ë' => 'K', 'ì' => 'L',
! 100: 'í' => 'M', 'î' => 'N', 'ï' => 'O', 'ð' => 'P', 'ò' => 'R', 'ó' => 'S', 'ô' =>
! 101: 'T', 'õ' => 'U', 'æ' => 'F', 'è' => 'H', 'ã' => 'C', 'þ' => 'Ch', 'ý' => 'Sch',
! 102: 'û' => 'Sh', 'ø' => '\'', 'ù' => 'Y', 'ÿ' => '\'', 'ü' => 'E', 'à' => 'Yu',
! 103: 'ñ' => 'Ya', 'Á' => 'a', 'Â' => 'b', '×' => 'v', 'Ç' => 'g', 'Ä' => 'd', 'Å' =>
! 104: 'e', '£' => 'e', 'Ö' => 'zh', 'Ú' => 'z', 'É' => 'i', 'Ê' => 'i', 'Ë' => 'k',
! 105: 'Ì' => 'l', 'Í' => 'm', 'Î' => 'n', 'Ï' => 'o', 'Ð' => 'p', 'Ò' => 'r', 'Ó' =>
! 106: 's', 'Ô' => 't', 'Õ' => 'u', 'Æ' => 'f', 'È' => 'h', 'Ã' => 'c', 'Þ' => 'ch',
! 107: 'Û' => 'sh', 'Ý' => 'sch', 'Ø' => '\'', 'Ù' => 'y', 'ß' => '\'', 'Ü' => 'e',
! 108: 'À' => 'yu', 'Ñ' => 'ya'
! 109: );
! 110:
! 111: # ------------------------------------------------------------------------ #
! 112: # End configuration settings.
! 113: # ------------------------------------------------------------------------ #
! 114:
! 115:
! 116: # ------------------------------------------------------------------------ #
! 117: # Changed by LG - added parsing of command line.
! 118: # ------------------------------------------------------------------------ #
! 119: my %Opt = (); # Main options go here
! 120: my $opt_h ; # Help flag
! 121: my $opt_bounces ; # Alternative error recipient flag
! 122: my $opt_addfrom ; # Add the From field to the post
! 123: my $opt_addfromh ; # Add the htmlized From to the post
! 124: my $opt_keepspaces ; # HTML-encode multiple spaces in e-mail
! 125: my @opt_taglist ; # command-line taglist first goes here
! 126: my $Parse = GetOptions( \%Opt,
! 127: 'user|u=s',
! 128: 'password|passwd|p=s',
! 129: 'hpassword|hpasswd|hp=s',
! 130: 'date|d=s',
! 131: 'security|sec=s',
! 132: 'prop_opt_preformatted|formatted|f!',
! 133: 'prop_opt_backdated|backdated|back-dated|backdate|back-date|back!',
! 134: 'subject|subj|s=s',
! 135: 'taglist|tags|tag|t=s' => \@opt_taglist, # Will tweak
! 136: 'usejournal|use-journal|use|journal|j=s',
! 137: 'prop_current_mood|current_mood|mood=s',
! 138: 'prop_current_music|current_music|music=s',
! 139: 'prop_picture_keyword|picture_keyword|picture|pic|userpic=s',
! 140: 'comments|comment|c=s', # Will tweak below
! 141: 'charset|enc=s' => \$SystemCharset,
! 142: 'bounces|bounce|b=s' => \$opt_bounces,
! 143: 'addfrom|add-from|from!' => \$opt_addfrom,
! 144: 'addfromh|add-fromh|fromh!' => \$opt_addfromh,
! 145: 'keep-spaces|keep-space|keepspaces|keepspace|spaces|space!' => \$opt_keepspaces,
! 146: 'help|h' => \$opt_h,
! 147: );
! 148:
! 149: # Handle bad options
! 150: if ( ! $Parse ) {
! 151: print_usage('short');
! 152: die "Run with '-h' for more help.\n\n";
! 153: }
! 154:
! 155: # Print help if requested.
! 156: print_usage('long'), exit 0 if ($opt_h);
! 157:
! 158:
! 159: # Check if '--date' was specified and convert hash value to proper format
! 160: # for LJ request.
! 161: if ( exists $Opt{'date'} ) {
! 162: # Note: "DD.MM.YYYY HH:MM". Single-digit day, month and hour are allowed.
! 163: # Double-digit "YY" is also allowed and considered "2000 + YY"
! 164: if ( $Opt{'date'} =~ /(\d\d?)\.(\d\d?)\.(\d{2,4})\s+(\d\d?):(\d\d)/ ) {
! 165: $Opt{'day'} = $1 ;
! 166: $Opt{'mon'} = $2 ;
! 167: $Opt{'year'} = $3 ;
! 168: $Opt{'hour'} = $4 ;
! 169: $Opt{'min'} = $5 ;
! 170: $Opt{'year'} += 2000 if $Opt{'year'} < 100 ;
! 171: } else {
! 172: print STDERR "can't parse date '$Opt{'date'}', using current.\n" ;
! 173: }
! 174: delete $Opt{'date'} ; # And remove the old element.
! 175: }
! 176:
! 177:
! 178:
! 179: # Comments option is 'comments yes/no/nomail', but LJ wants
! 180: # 'prop_opt_*no*comments' property. Keep command line human-readable and
! 181: # switch to proper value in the hash.
! 182: if ( exists $Opt{'comments'} ) {
! 183: if ( $Opt{'comments'} =~ /^s*((on)|(yes)|(default))\s*$/i ) {
! 184: $Opt{'prop_opt_nocomments'} = "" ;
! 185: } elsif ( $Opt{'comments'} =~ /^\s*(noe?mails?)\s*$/i ) {
! 186: $Opt{'prop_opt_nocomments'} = "" ;
! 187: $Opt{'prop_opt_noemail'} = 1 ;
! 188: } elsif ( $Opt{'comments'} =~ /^\s*((off)|(no))\s*$/i ) {
! 189: $Opt{'prop_opt_nocomments'} = 1
! 190: } else {
! 191: $Opt{'prop_opt_nocomments'} = $Opt{'comments'} ;
! 192: }
! 193: delete $Opt{'comments'} ; # And remove the old element.
! 194: }
! 195:
! 196:
! 197: # Convert taglist array into a single string and store it
! 198: # with other parameters.
! 199: $Opt{'prop_taglist'} = join( ", ", @opt_taglist ) if ( @opt_taglist ) ;
! 200:
! 201: # Convert all command line options to unicode.
! 202: # Function href2utf8() uses a reference to input hash, so %Opt is
! 203: # being modified "in-place".
! 204: href2utf8( \%Opt, $SystemCharset) ;
! 205:
! 206:
! 207: # Changed by LG - set a restrictive umask (we're talking mail files here!)
! 208: umask 077 ;
! 209:
! 210:
! 211: # Changed by LG - moved from above.
! 212: my $alias = shift @ARGV || "none" ;
! 213: my $mp = new MIME::Parser() or die "new MIME::Parser(): $!\n" ;
! 214:
! 215:
! 216: # Changed by LG - changed directory.
! 217: # $mp->output_dir("$home/mimetmp") ;
! 218: $mp->output_dir("/tmp/mimetmp-$ENV{user}") ;
! 219: mkdir $mp->output_dir if not -d $mp->output_dir ; # Create it if missing
! 220:
! 221: # Get the whole mail.
! 222: my $me = $mp->parse(\*STDIN) ;
! 223: END { $me && $me->purge() } ;
! 224:
! 225: # Changed by LG - different log file name.
! 226: # open(STDERR, ">>$home/generic.log") or die "open(`log'): $!\n" ;
! 227: my $logdir = "$home/mail" ;
! 228: mkdir $logdir if not -d $logdir ; # Create it if missing
! 229: open(STDERR, ">>$logdir/mail2lj.log") or die "open(`log'): $!\n" ;
! 230:
! 231: my $users = {} ;
! 232: # $users = $cfg->{users} ;
! 233:
! 234: # Get mail header.
! 235: my $mh = $me->head() ;
! 236: $me->dump_skeleton(\*STDERR) ;
! 237:
! 238: # Changed by LG - added chomping of "To:" field.
! 239: my $to = $me->get('To') || "" ;
! 240: chomp $to ;
! 241: print STDERR "Alias: $alias\n", "To: $to\n",
! 242: "Charset: ", $mh->mime_attr("content-type.charset") || "NONE", "\n" ;
! 243:
! 244: my $xmailer = $mh->get('X-Mailer') || "unknown" ;
! 245: if ($xmailer =~ /EPOC/ || $xmailer =~ /Eudora.+PalmOS/) {
! 246: # too bad. they do violate standards there.
! 247: $mh->mime_attr("content-type.charset" => "windows-1251") ;
! 248: print STDERR "Charset changed to 'windows-1251' (hopefully)\n" ;
! 249: }
! 250:
! 251:
! 252: # And here we do posting.
! 253: if ($alias =~ /MAILER-DAEMON/i) {
! 254: exit 0 ;
! 255: } elsif ($alias =~ /^post$/) {
! 256: # my $req = post_me2req($me, "windows-1251") ; # Changed by LG
! 257: my $req = post_me2req($me, "$MailCharset", { %Opt }) ; # Changed by LG
! 258: my $ljres = submit_request($req) ;
! 259:
! 260: if ($ljres->{'success'} eq "OK") {
! 261: print STDERR "journal updated successfully\n" ;
! 262: } else {
! 263: print STDERR "error updating journal: $ljres->{errmsg}\n" ;
! 264: send_bounce($ljres->{errmsg}, $me, $mh->mime_attr("content-type.charset")) ;
! 265: }
! 266: } elsif ($alias =~ /^post-(\w+)-(\w+)$/) {
! 267: my $l = $1 ;
! 268: my $p = $2 ;
! 269: # my $req = post_me2req($me, "windows-1251", { # Changed by LG
! 270: # user => $l,
! 271: # password => $p
! 272: my $req = post_me2req($me, "$MailCharset", { # Changed by LG
! 273: user => $l,
! 274: password => $p,
! 275: %Opt # Changed by LG
! 276: }) ;
! 277: my $ljres = submit_request($req) ;
! 278:
! 279: if ($ljres->{'success'} eq "OK") {
! 280: print STDERR "journal updated successfully\n" ;
! 281: } else {
! 282: print STDERR "error updating journal: $ljres->{errmsg}\n" ;
! 283: send_bounce($ljres->{errmsg}, $me, $mh->mime_attr("content-type.charset")) ;
! 284: }
! 285: } elsif ($alias =~ /^hpost-(\w+)-(\w+)$/) {
! 286: my $l = $1 ;
! 287: my $hp = $2 ;
! 288: # my $req = post_me2req($me, "windows-1251", { # Changed by LG
! 289: # user => $l,
! 290: # hpassword => $hp
! 291: my $req = post_me2req($me, "$MailCharset", { # Changed by LG
! 292: user => $l,
! 293: hpassword => $hp,
! 294: %Opt # Changed by LG
! 295: }) ;
! 296: my $ljres = submit_request($req) ;
! 297:
! 298: if ($ljres->{'success'} eq "OK") {
! 299: print STDERR "journal updated successfully\n" ;
! 300: } else {
! 301: print STDERR "error updating journal: $ljres->{errmsg}\n" ;
! 302: send_bounce($ljres->{errmsg}, $me, $mh->mime_attr("content-type.charset")) ;
! 303: }
! 304: } elsif ($alias =~ /^ljreply-(\S+)$/ || $alias =~ /^ljreplys-(\S+)$/) {
! 305: my $email = $1 ;
! 306: $email =~ s/\.\./\@/ ;
! 307:
! 308: if ($mh->get('From') !~ m/lj_dontreply\@livejournal.com/ &&
! 309: $mh->get('From') !~ m/lj_notify\@livejournal.com/) {
! 310: # someone just picked our email from livejournal.com site
! 311: print STDERR "no livejournal signature found, bouncing to $email\n";
! 312: $mh->replace('To', $email) ;
! 313: $me->send("sendmail") ;
! 314: exit 0 ;
! 315: }
! 316:
! 317: die "ljreply doesn't look like a 2-part message.\n"
! 318: unless $me->parts() == 2 ;
! 319: my $formdata = ljcomment_form2string
! 320: $me->parts(1)->bodyhandle->as_string() ;
! 321: # Changed by LG - changed to a variable.
! 322: # my $charset =
! 323: # ($me->parts(0)->head->mime_attr('content-type.charset') ||
! 324: # "windows-1251") ;
! 325: my $charset =
! 326: ($me->parts(0)->head->mime_attr('content-type.charset') ||
! 327: "$MailCharset") ;
! 328: my $data = $me->parts(0)->bodyhandle->as_string() ;
! 329:
! 330: my $nicefrom = "Mail2LJ-translated comment" ;
! 331: if ($mh->get("From") =~ /\(([^\)]+)\)/) {
! 332: $nicefrom = $1 ;
! 333: }
! 334: print STDERR "nicefrom is '$nicefrom'\n" ;
! 335:
! 336: if ($alias =~ /^ljreplys/) {
! 337: print STDERR "stripping content...\n" ;
! 338: $data = to_utf8({ -string => $data, -charset => $charset})
! 339: if $charset !~ /^utf-?8$/i ;
! 340: # Changed by LG - changed to a variable.
! 341: # $data = from_utf8({ -string => $data, -charset => "cp1251"}) ;
! 342: # $charset = "windows-1251" ;
! 343: $data = from_utf8({ -string => $data, -charset => "$MailCharset"}) ;
! 344: $charset = "$MailCharset" ;
! 345: $data = smstrip_data $data ;
! 346: }
! 347:
! 348: my $msg = build MIME::Entity(
! 349: 'From' => "ljfrom-$formdata\@$host",
! 350: # 'Sender' => "ljfrom-$formdata\@$host",
! 351: 'To' => $email,
! 352: 'Subject' => normalize_header($mh->get('Subject'), $charset),
! 353: 'Content-Type' => "text/plain; charset=$charset" ,
! 354: 'Data' => $data
! 355: );
! 356: $msg->send("sendmail") ;
! 357: $msg->purge() ;
! 358: } elsif ($alias =~ /^ljfrom-(\S+)$/) {
! 359: my $formdata = $1 ;
! 360: my $hr = ljcomment_string2form($formdata) ;
! 361: my $req = new HTTP::Request('POST' => $ljcomment_action)
! 362: or die "new HTTP::Request(): $!\n" ;
! 363:
! 364: $hr->{usertype} = 'user' ;
! 365: # Changed by LG.
! 366: # $hr->{encoding} = $mh->mime_attr('content-type.charset') ||
! 367: # "cp1251" ;
! 368: $hr->{encoding} = $mh->mime_attr('content-type.charset') ||
! 369: "$MailCharset" ;
! 370: $hr->{subject} = decode_mimewords($mh->get('Subject'));
! 371: $hr->{body} = $me->bodyhandle->as_string() ;
! 372:
! 373: $req->content_type('application/x-www-form-urlencoded');
! 374: $req->content(href2string($hr)) ;
! 375:
! 376: my $ljres = submit_request($req, "comment") ;
! 377:
! 378: if ($ljres->{'success'} eq "OK") {
! 379: print STDERR "journal updated successfully\n" ;
! 380: } else {
! 381: print STDERR "error updating journal: $ljres->{errmsg}\n" ;
! 382: send_bounce($ljres->{errmsg}, $me, $mh->mime_attr("content-type.charset")) ;
! 383: }
! 384: }
! 385: print STDERR "-------------------------------------------------------------\n" ;
! 386:
! 387:
! 388: # ------------------------------------------------------------------------- #
! 389: # All done.
! 390: # ------------------------------------------------------------------------- #
! 391: exit 0 ;
! 392:
! 393:
! 394:
! 395: # ------------------------------------------------------------------------- #
! 396: # Subroutines from now down.
! 397: # ------------------------------------------------------------------------- #
! 398: sub href2utf8 {
! 399: my ($hr, $e) = @_ ;
! 400: my $i ;
! 401:
! 402: foreach $i (keys %$hr) {
! 403: $hr->{$i} = to_utf8({ -string => $hr->{$i}, -charset => $e}) ;
! 404: }
! 405: return $hr ;
! 406: }
! 407:
! 408: sub href2string {
! 409: my $hr = shift ;
! 410: my $i ;
! 411: my $s = "" ;
! 412:
! 413: foreach $i (keys %$hr) {
! 414: next if $i eq "event" ;
! 415: $s .= "&" if $s ;
! 416: $s .= $i . "=" . uri_escape($hr->{$i}, "^A-Za-z0-9") ;
! 417: }
! 418:
! 419: if ($hr->{event}) {
! 420: $s .= "&" if $s ;
! 421: $s .= "event=" . uri_escape($hr->{event}, "^A-Za-z0-9") ;
! 422: }
! 423: return $s ;
! 424: }
! 425:
! 426: sub post_body2href {
! 427: my $fh = shift ;
! 428: my ($l, $auth) ;
! 429: my $req_data = {
! 430: webversion => 'full',
! 431: ver => 1,
! 432: security => 'public',
! 433: prop_opt_preformatted => 0,
! 434: mode => 'postevent'
! 435: } ;
! 436:
! 437: while ($l = $fh->getline()) {
! 438: if (exists $req_data->{event}) {
! 439: $req_data->{event} .= $l ;
! 440: next ;
! 441: }
! 442:
! 443: next if $l =~ /^$/ ;
! 444:
! 445: if ($l =~ /^(\w[\w_]*[\w])\s*[=:]\s*(\S.*)$/) {
! 446: my ($var, $val) = (lc($1), $2) ;
! 447:
! 448: if ($var eq "date") {
! 449: # Changed by LG.
! 450: # Note: "DD.MM.YYYY HH:MM". Single-digit day, month and
! 451: # hour are allowed. Double-digit "YY" is also allowed
! 452: # and considered "2000 + YY".
! 453: if ($val =~ /(\d\d?)\.(\d\d?)\.(\d{2,4})\s+(\d\d?):(\d\d)/) {
! 454: $req_data->{day} = $1 ;
! 455: $req_data->{mon} = $2 ;
! 456: $req_data->{year} = $3 ;
! 457: $req_data->{hour} = $4 ;
! 458: $req_data->{min} = $5 ;
! 459: $req_data->{year} += 2000 if $req_data->{year} < 100 ;
! 460: } else {
! 461: print STDERR "can't parse date '$val', will use current\n" ;
! 462: }
! 463: } elsif ($var eq "mood" || $var eq "current_mood") {
! 464: $req_data->{prop_current_mood} = $val ;
! 465: } elsif ($var eq "music" || $var eq "current_music") {
! 466: $req_data->{prop_current_music} = $val ;
! 467: } elsif ($var eq "picture" || $var eq "picture_keyword") {
! 468: $req_data->{prop_picture_keyword} = $val ;
! 469: } elsif ($var eq "formatted" || $var eq "autoformat") {
! 470: $val = 1 if $val =~ /^\s*((on)|(yes))\s*$/i ;
! 471: $val = 0 if $val =~ /^\s*((off)|(no))\s*$/i ;
! 472: # Changed by LG - "autoformat" is opposite to "formatted".
! 473: # Add 0 to make sure it's the number.
! 474: $val = 0 + (not $val) if ($var eq "autoformat") ;
! 475: $req_data->{prop_opt_preformatted} = $val ;
! 476: } elsif ($var eq "auth") {
! 477: $auth = $val ;
! 478:
! 479: # Changed by LG - added 'backdated' option. Remember,
! 480: # Livejournal currently prohibits backdated entries in the
! 481: # communities (as opposed to individual journals).
! 482: } elsif ($var =~ /^back-?dated?$/ || $var eq "opt_backdated") {
! 483: $val = 1 if $val =~ /^\s*((on)|(yes))\s*$/i ;
! 484: $val = 0 if $val =~ /^\s*((off)|(no))\s*$/i ;
! 485: $req_data->{prop_opt_backdated} = $val ;
! 486:
! 487: # Changed by LG - added comment-parsing settings.
! 488: # Comments: default/on/yes | off/no | nomail
! 489: # Assembled based on data from form values in the browser
! 490: # and from info on
! 491: # http://www.livejournal.com/doc/server/ljp.csp.flat.postevent.html
! 492: # http://www.livejournal.com/doc/server/ljp.csp.proplist.html
! 493: } elsif ($var eq "comments" || $var eq "comment"
! 494: || $var eq "comment_settings"
! 495: || $var eq "comments_settings" ) {
! 496: if ( $val =~ /^\s*((on)|(yes)|(default))\s*$/i ) {
! 497: # Journal default
! 498: $val = "" ;
! 499: $req_data->{comment_settings} = $val ;
! 500: $req_data->{prop_opt_nocomments} = $val ;
! 501: } elsif ( $val =~ /^\s*(noe?mails?)\s*$/i ) {
! 502: # No emails
! 503: $val = "1" ;
! 504: $req_data->{prop_opt_nocomments} = (not $val) + 0;
! 505: $req_data->{prop_opt_noemail} = $val ;
! 506: } elsif ( $val =~ /^\s*((off)|(no))\s*$/i ) {
! 507: # No comments
! 508: $val = "1" ;
! 509: $req_data->{prop_opt_nocomments} = $val ;
! 510: } else {
! 511: # Anything else.
! 512: $req_data->{comment_settings} = $val ;
! 513: }
! 514:
! 515: # Changed by LG - added 'tags' option.
! 516: } elsif ($var =~ /^tags?$/ || $var eq "taglist") {
! 517: $req_data->{prop_taglist} = $val;
! 518:
! 519: # Anything else - just assign.
! 520: } else {
! 521: $req_data->{$var} = $val ;
! 522: }
! 523: } else {
! 524: $req_data->{event} = $l ;
! 525: }
! 526: }
! 527:
! 528: if (!exists $req_data->{year}) {
! 529: my @lt = localtime() ;
! 530: $req_data->{day} = $lt[3] ;
! 531: $req_data->{mon} = $lt[4] + 1 ;
! 532: $req_data->{year} = 1900 + $lt[5] ;
! 533: $req_data->{hour} = $lt[2] ;
! 534: $req_data->{min} = $lt[1] ;
! 535: }
! 536:
! 537: if ($auth) {
! 538: $req_data->{password} = $users->{$req_data->{user}}->{password}
! 539: if exists $users->{$req_data->{user}} &&
! 540: $users->{$req_data->{user}}->{auth} eq $auth ;
! 541: }
! 542:
! 543: return $req_data ;
! 544: }
! 545:
! 546: sub hdr2utf8 {
! 547: my ($s, $e) = @_ ;
! 548: my $r = "" ;
! 549: my $i ;
! 550:
! 551: foreach $i (decode_mimewords $s) {
! 552: $r .= to_utf8({
! 553: -string => $i->[0],
! 554: -charset => ($i->[1] || $e)
! 555: }) ;
! 556: }
! 557:
! 558: return $r ;
! 559: }
! 560:
! 561: sub post_me2req {
! 562: my ($me, $e, $hints) = @_ ;
! 563: my $mebh = $me->bodyhandle() or die "post_message(): no body?\n" ;
! 564: my $mehh = $me->head() ;
! 565: my $charset = $mehh->mime_attr("content-type.charset") || $e ;
! 566: my $subject = hdr2utf8($me->get('Subject') || "", $charset) ;
! 567: chomp $subject ; # Changed by LG
! 568:
! 569: # Changed by LG
! 570: my $from = hdr2utf8($me->get('From') || "", $charset) ;
! 571: chomp $from ;
! 572:
! 573: my $hr = href2utf8(post_body2href($mebh->open("r")), $charset) ;
! 574: my $req = new HTTP::Request('POST', $post_uri) or
! 575: die "new HTTP::Request(): $!\n" ;
! 576:
! 577: if ($hints) {
! 578: my $i ;
! 579: foreach $i (keys %$hints) {
! 580: # Changed by LG - make hints override (not just complement)
! 581: # existing values.
! 582: # $hr->{$i} ||= $hints->{$i} ;
! 583: $hr->{$i} = $hints->{$i} ;
! 584: }
! 585: }
! 586:
! 587: $hr->{subject} ||= $subject ;
! 588: # Changed by LG - removed prefixing.
! 589: # $hr->{subject} = "[mail2lj] " . $hr->{subject} ;
! 590:
! 591: # Changed by LG - added options to add the 'From' field to the
! 592: # posted message.
! 593: if ( $opt_addfrom ) {
! 594: $hr->{event} = "From: $from" . "\n\n" . $hr->{event} ;
! 595: } elsif ( $opt_addfromh ) {
! 596: my $html_from = "<nobr><i><b>From:</b> $from</i></nobr>" ;
! 597: $html_from =~ s/\@/[_\@_]/g ;
! 598: $hr->{event} = $html_from . "\n\n" . $hr->{event} ;
! 599: }
! 600:
! 601: # Changed by LG - added an option to preserve (html-ize) multiple
! 602: # spaces and tabs (convert '\t' to eight ' ' and convert
! 603: # multiple continuous spaces into sequence of ' ').
! 604: # Lines with tabs are additionally wrapped in <nobr>...</nobr> tags.
! 605: if ( $opt_keepspaces ) {
! 606: $hr->{event} =~ s/^(.*\t.*)$/<nobr>$1<\/nobr>/gm ;
! 607: $hr->{event} =~ s/\t/\ \ \ \ \ \ \ \ /g ;
! 608: $hr->{event} =~ s/ / \ /g ;
! 609: }
! 610:
! 611: $req->content_type('application/x-www-form-urlencoded');
! 612: $req->content(href2string $hr) ;
! 613:
! 614: print STDERR "working on request from $hr->{user}\n",
! 615: "From: $from\n", # Changed by LG
! 616: "Date: ", scalar localtime, "\n" ;
! 617:
! 618: return $req ;
! 619: }
! 620:
! 621: sub submit_request {
! 622: my ($req, $proto) = @_ ;
! 623: my $ljres = {} ;
! 624: my $ua = new LWP::UserAgent or
! 625: die "new LWP::UserAgent: $!\n" ;
! 626: # Changed by LG - modified user-agent
! 627: # $ua->agent("Mail2LJ/0.9");
! 628: $ua->agent("Mail2LJ/${Version}${LGmod}");
! 629: $ua->timeout(100);
! 630: my $res = $ua->request($req);
! 631:
! 632: if ($proto && $proto eq "comment") {
! 633: if ($res->is_success) {
! 634: $ljres->{'success'} = "OK";
! 635: } else {
! 636: $ljres->{'success'} = "FAIL";
! 637: $ljres->{'errmsg'} = "Client error: Error contacting server.";
! 638: }
! 639:
! 640: return $ljres ;
! 641: }
! 642:
! 643: if ($res->is_success) {
! 644: %$ljres = split(/\n/, $res->content);
! 645: } else {
! 646: $ljres->{'success'} = "FAIL";
! 647: $ljres->{'errmsg'} = "Client error: Error contacting server.";
! 648: }
! 649: return $ljres ;
! 650: }
! 651:
! 652: sub ljcomment_form2string {
! 653: my $s = shift ;
! 654: my $h = {} ;
! 655: my $p = new HTML::TokeParser(\$s) or
! 656: die "new HTML::TokeParser(): $!\n" ;
! 657: my $token = $p->get_tag("form");
! 658: die "get_inputs(): Wrong form.\n"
! 659: if ($token->[1]{action} ne $ljcomment_action) ;
! 660:
! 661: while ($token = $p->get_tag("input") ) {
! 662: $h->{$token->[1]{name}} =
! 663: $token->[1]{value} || '' if ($token->[1]{name});
! 664: }
! 665:
! 666: die "get_inputs(): Incomplete form data\n"
! 667: unless $h->{userpost} && $h->{journal} && $h->{parenttalkid} &&
! 668: $h->{itemid} && $h->{ecphash} ;
! 669:
! 670: $h->{ecphash} =~ s/^ecph-// ;
! 671:
! 672: return "$h->{userpost}-$h->{journal}-$h->{parenttalkid}-$h->{itemid}-$h->{ecphash}" ;
! 673: }
! 674:
! 675: sub ljcomment_string2form {
! 676: my $s = shift ;
! 677: my $hr = {} ;
! 678: my $i ;
! 679: my @l = split /\-/, $s ;
! 680:
! 681: foreach $i (qw/userpost journal parenttalkid itemid ecphash/) {
! 682: $hr->{$i} = shift @l ;
! 683: }
! 684:
! 685: die "badly formed formdata '$s'\n" unless $hr->{ecphash} ;
! 686: $hr->{ecphash} = "ecph-" . $hr->{ecphash} ;
! 687:
! 688: return $hr ;
! 689: }
! 690:
! 691: sub normalize_header {
! 692: my ($s, $e) = @_ ;
! 693: my $d = decode_mimewords($s) ;
! 694: chomp $d ;
! 695:
! 696: return encode_mimeword($d, 'B', $e) ;
! 697: }
! 698:
! 699:
! 700: sub smstrip_data {
! 701: my $data = shift ;
! 702: my ($hdr, $ftr) ;
! 703: my ($who, $journal) ;
! 704:
! 705: $data =~ /^(.+)Their reply was:(.+)You can view the discussion(.+)$/si
! 706: or return $data ;
! 707: $hdr = $1 ;
! 708: $data = $2 ;
! 709: $ftr = $3 ;
! 710:
! 711: $hdr =~ /\((\w+)\) replied to .* ((post)|(comment))/ and $who = $1 ;
! 712:
! 713: $ftr =~ m,http://www\.livejournal\.com/talkpost.bml\?journal=(\w+),
! 714: and $journal = $1 ;
! 715:
! 716: if ($who) {
! 717: $data = "user [$who] in [$journal]:\n" . $data ;
! 718: }
! 719:
! 720: $data =~ s/^\s+Subject:\s*$//m ;
! 721: $data =~ s/^\s+Subject:\s(\S.*)\s*$/[$1]/m ;
! 722: $data =~ s/\s+/ /gs ;
! 723: $data =~ s/(.)/$tr{$1} || $1/ge ;
! 724:
! 725: return $data ;
! 726: }
! 727:
! 728: sub send_bounce {
! 729: my ($errmsg, $orig, $charset) = @_ ;
! 730:
! 731: # Changed by LG - use KOI-8 instead of Win-1251.
! 732: # $charset ||= "windows-1251" ;
! 733: $charset ||= "$MailCharset" ;
! 734:
! 735: my $bmsg = build MIME::Entity(
! 736: 'From' => "MAILER-DAEMON\@$host",
! 737: # Changed by LG - allow use of alternative addres for notifications.
! 738: # 'To' => $orig->get('From'),
! 739: 'To' => $opt_bounces || $orig->get('From'),
! 740: 'Subject' => (
! 741: "mail2lj failure (was: " . $orig->get('Subject') . ")"
! 742: ),
! 743: 'Content-Type' => "text/plain; charset=$charset" ,
! 744: 'Data' => <<EOF
! 745:
! 746: Dear Mail2Lj User,
! 747:
! 748: Mail2Lj gateway at $host was trying hard to submit your request,
! 749: but, unfortunately, to no avail: a silly, but fatal error has occured.
! 750: Mail2Lj(tm) proudly presents the extremely informative error message:
! 751:
! 752: '$errmsg'
! 753:
! 754: Thank you for understanding,
! 755: good luck next time,
! 756: take care,
! 757: sincerely, completely and, in general, very truly yours,
! 758: -Mail2Lj.
! 759: EOF
! 760: );
! 761: $bmsg->send("sendmail") ;
! 762: $bmsg->purge() ;
! 763: }
! 764:
! 765:
! 766: sub print_usage {
! 767: # ----------------------------------------------------------------------- #
! 768: # print_usage( $Long );
! 769: #
! 770: # Prints help message. If defined $Long, the message is more detailed
! 771: # as opposed to default brief description.
! 772: # ----------------------------------------------------------------------- #
! 773: my ( $long ) = @_; # Were we called with a parameter?
! 774:
! 775: my $spacer = ' ' x length($shortname); # bunch of spaces
! 776:
! 777: # ---------------------------------------------------------------------
! 778: # Short usage will always be printed when called.
! 779: # Indentation messed up because of the HERE-document.
! 780: # ---------------------------------------------------------------------
! 781: print <<___END_SHORT;
! 782: $shortname v. ${Version} by jason\@nichego.net (http://jsn.livejournal.com).
! 783: Tweaked to v. ${Version}${LGmod} by Lev Gorenstein \<lev\@ledorub.poxod.com\>, 2007.
! 784:
! 785: Usage:
! 786: $shortname ACTION [options] < InputFile
! 787: cat MailMessage | $shortname ACTION [options]
! 788:
! 789: A script to post incoming mail messages to Livejournal.com journals.
! 790: Reads STDIN and connects to Livejournal's HTTP posting interface.
! 791:
! 792: This is a modification of mail2lj.pl script by Jason
! 793: (http://jsn.livejournal.com) described at http://mail2lj.nichego.net/.
! 794: I added command line processing and couple more tweaks.
! 795:
! 796: Distributed freely under GNU Public License with absolutely no warranty.
! 797:
! 798: ___END_SHORT
! 799:
! 800:
! 801: # ---------------------------------------------------------------------
! 802: # When called in a long format, usage should be followed by some more info.
! 803: # Indentation messed up because of the HERE-document.
! 804: # ---------------------------------------------------------------------
! 805: if ( defined $long && $long !~ /^\s*short\s*$/i ) {
! 806: print <<______END_HELP;
! 807: ACTIONS:
! 808: post Original script used this to handle messages that had keywords
! 809: inside (see http://mail2lj.nichego.net/userguide.html) and
! 810: used 'post-...' and 'hpost-...' to post keywordless messages
! 811: directly. This version doesn't require keywords (i.e. 'post'
! 812: can handle keywordless messages and everything can be set via
! 813: command line), but if you DO use keywords, then use this action.
! 814:
! 815: post-(user)-(password)
! 816: A direct post of mail message (without looking for keywords in
! 817: the body) using whatever settings supplied on the command line.
! 818: With proper command line parameters, username and password can
! 819: be completely bogus (i.e. 'post-aa-bb -u RealUser -p RealPass').
! 820:
! 821: hpost-(user)-(MD5Hash_of_password)
! 822: A direct post of mail message (without looking for keywords in
! 823: the body) using whatever settings supplied on the command line,
! 824: Same as 'post-...', but uses a password hash instead of
! 825: clear-text password.
! 826: With proper command line parameters, username and hash can be
! 827: completely bogus (i.e. 'hpost-aa-bb -u RealUser --hp RealHash').
! 828:
! 829:
! 830: Options:
! 831: -u USER, --user USER
! 832: Use this LiveJournal user name to login.
! 833:
! 834: -p PASS, --password PASS
! 835: Use this LiveJournal password to login. Use of this option
! 836: is deprecated because of clear-text password.
! 837:
! 838: -hp MD5Hash, --hpassword MD5Hash
! 839: Use this MD5 hash of the password to login. To generate a hash,
! 840: do this:
! 841: perl -MDigest::MD5 \
! 842: -e 'print Digest::MD5::md5_hex("PASSWORD")."\\n"'
! 843:
! 844: -j JOURNAL, --usejournal JOURNAL
! 845: When posting to the community (or the journal that's different
! 846: from the one you've specified via '--user'), use this option
! 847: to specify that community's name. E.g. if the user
! 848: 'gusarskie_vesti' wants to post to community 'gusary', it can
! 849: be done with options like this:
! 850: post -u gusarskie_vesti -p PASS --usejournal gusary
! 851:
! 852: -s SUBJECT, --subject SUBJECT
! 853: Use this subject for the posting. If absent, defaults to
! 854: e-mail's Subject:.
! 855:
! 856: -t TAGLIST, --tags TAGLIST
! 857: Use tags from TAGLIST for posted message. Within a tag list,
! 858: tags should be separated by commas. If your tags contain
! 859: special characters or spaces, make sure to enclose TAGLIST in
! 860: single or double quotes to protect from the shell. Multiple
! 861: '-t' options are allowed and taglists will be combined.
! 862:
! 863: -d DATE, --date DATE
! 864: Label posting with this date. Date should be in LiveJournal's
! 865: format: DD.MM.YYYY HH:mm. If absent, current date/time is used.
! 866:
! 867: --backdated
! 868: If set, tells LiveJournal to make this message back-dated
! 869: (i.e. to set 'Date out-of-order' flag to prevent this item
! 870: from showing in people's friends lists). Note that currently
! 871: Livejournal only allows back-dated entries in individual
! 872: journals (not in communities), so use with caution. The option
! 873: can be negated ('--nobackdated'). Default is '--nobackdated'.
! 874:
! 875: --security public|protected|private
! 876: Post security mode. Default is "public".
! 877:
! 878: -f, --formatted
! 879: If set, tells LiveJournal to assume our message to be already
! 880: formatted (i.e. '--formatted' turns OFF LJ's autoformat
! 881: feature). The option can be negated ('--noformatted').
! 882: Default is '--noformatted' (i.e. *use* LJ's autoformat).
! 883:
! 884: --mood MOOD Current Mood for Livejournal. TEXT ONLY (images not supported).
! 885: Defaults to nothing.
! 886:
! 887: --music MUSIC Current Music for Livejournal. Defaults to nothing.
! 888:
! 889: --picture KEYWORD, --userpic KEYWORD
! 890: Keyword for the Livejournal userpic to use. Default one is
! 891: used when not specified.
! 892:
! 893: -c on|yes|default|off|no|noemail, --comments on|yes|default|off|no|noemail
! 894: Controls permissions to leave comments for this post.
! 895: "on" ("yes", "default") will use the journal's default settings.
! 896: "off" or "no" prohibit comments. "noemail" allows comments,
! 897: but tells Livejournal not to email them to you.
! 898:
! 899: --from, --addfrom
! 900: Insert the From: field from the e-mail as the first line of
! 901: the posted message. The field is added in plain text (without
! 902: any HTML-formatting - see '--fromh' for that). For slight
! 903: antispam protection, '\@' is replaced by '[_\@_]'. The option
! 904: can be negated ('--nofrom'). Default is '--nofrom'.
! 905:
! 906: --fromh, --addfromh
! 907: Same as '--from', but uses HTML-markup to highlight inserted
! 908: field (<nobr><i><b>From:</b> Address</i></nobr>). This is
! 909: nice for mailing list -> Livejournal crossposting. The option
! 910: can be negated ('--nofromh'). Default is '--nofromh'.
! 911:
! 912: --spaces, --keepspaces
! 913: Normally the script does not change original message text,
! 914: and all of it is preserved in the body of resulting LJ post.
! 915: Which means that all tabs and multiple consecutive spaces
! 916: (while valid in e-mail and preserved in the post), will not
! 917: be properly *shown* in the browser (browser will display them
! 918: as single space). With '--spaces', however, all tabs will
! 919: be converted to 8 '\ ' instances, and each pair of
! 920: consecutive spaces will be converted to a ' \ ' sequence.
! 921: Additionally, lines with tabs will be wrapped in <nobr> tag.
! 922: This way the formatting of original e-mail will be much
! 923: better preserved in the journal. The option can be negated
! 924: ('--nospaces'). Default is '--nospaces'.
! 925:
! 926: --charset CHARSET
! 927: This option tells the script that all COMMAND LINE options are
! 928: given in this charset. Default is "$SystemCharset".
! 929: Remember, THIS HAS NOTHING TO DO with the __posting's charset__
! 930: (which is determined from email headers and then converted to
! 931: utf8). It also has absolutely no effect on the in-the-body
! 932: keywords (they are also governed by email's charset). This
! 933: option is meaningful ONLY for the text that you supply VIA
! 934: COMMAND LINE (e.g. '-s Subject').
! 935:
! 936: -b xxx\@yyy, --bounces xxx\@yyy
! 937: Normally, if errors occur during posting (e.g. wrong password),
! 938: the script sends an error notification to the _original poster_
! 939: (i.e., the address in the original From: field). This makes
! 940: perfect sense for multi-user installations. But occasionally
! 941: there is a need to send all errors to a single _maintainer_
! 942: (e.g., if you use the script as a mailing list --> LiveJournal
! 943: gateway). This option allows exactly that. Default is unset
! 944: (i.e. errors go to original poster).
! 945:
! 946: -h, --help: This help.
! 947:
! 948:
! 949: If you decide to use keywords in the body of the message (as opposed to
! 950: command line options), they should look like this:
! 951:
! 952: From: .... \\
! 953: To: .... + # Regular e-mail headers
! 954: Subject: ... /
! 955: # Normal blank line after headers
! 956: User: gusarskie_vesti
! 957: Password: password # (or Hpassword: MD5Hash)
! 958: Date: 22.01.2007 5:04
! 959: Security: private
! 960: Subject: Rzhevskij zhiv!
! 961: Tags: Junk, Viva Rzhevskij!
! 962: Formatted: on # Or equivalent "Autoformat: off"
! 963: Usejournal: gusary
! 964: Mood: okay
! 965: Music: silence
! 966: Backdated: yes
! 967: Comments: no
! 968: # Blank line
! 969: Oh well. some text # Text of your message.
! 970:
! 971: And the text would be posted.
! 972:
! 973: Almost all keyword fields (as well as their command line counterparts)
! 974: are optional and have reasonable defaults. The only mandatory parameter
! 975: is the user name (well, doh!). See more on keywords in the original
! 976: script's user guide: http://mail2lj.nichego.net/userguide.html
! 977:
! 978: ______END_HELP
! 979: print "\n";
! 980: } # End of "if $long" test
! 981:
! 982: # ---------------------------------------------------------------------
! 983: # All done
! 984: # ---------------------------------------------------------------------
! 985:
! 986: return;
! 987: }
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