Annotation of mail2lj/mail2lj.pl, revision 1.9

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>