Annotation of mail2lj/mail2lj.pl, revision 1.10

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

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