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