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