version 1.7, 2007/08/14 20:59:15
|
version 1.10, 2014/05/06 00:42:15
|
Line 30
|
Line 30
|
# original From: address). This is convenient when you want to notify |
# original From: address). This is convenient when you want to notify |
# script maintainer instead of the poster (exactly what I need). |
# script maintainer instead of the poster (exactly what I need). |
# |
# |
|
# Changes by Boris Veytsman - added --cut option |
|
# |
|
# Changes by LG: added --obfuscate option to protect e-mails in the body. |
# |
# |
# NB: to generate MD5 hash of your password, use the following command: |
# NB: to generate MD5 hash of your password, use the following command: |
# perl -MDigest::MD5 -e 'print Digest::MD5::md5_hex("yourpassword")."\n"' |
# perl -MDigest::MD5 -e 'print Digest::MD5::md5_hex("yourpassword")."\n"' |
Line 42
|
Line 45
|
# Original script seems to be distributed as freeware, so I stick to that |
# Original script seems to be distributed as freeware, so I stick to that |
# decision. No warranty whatsoever, of course - use at your own risk ;-). |
# decision. No warranty whatsoever, of course - use at your own risk ;-). |
# |
# |
# Changes by Boris Veytsman - added --cut option |
|
# |
|
# ------------------------------------------------------------------------ |
# ------------------------------------------------------------------------ |
|
|
use strict ; |
use strict ; |
Line 54 use HTTP::Request ;
|
Line 55 use HTTP::Request ;
|
use URI::Escape ; |
use URI::Escape ; |
use MIME::Parser ; |
use MIME::Parser ; |
use MIME::Words qw/decode_mimewords encode_mimeword/ ; |
use MIME::Words qw/decode_mimewords encode_mimeword/ ; |
use Unicode::MapUTF8 qw/to_utf8 from_utf8/ ; |
use Unicode::MapUTF8 qw/to_utf8 from_utf8 utf8_charset_alias/ ; |
use HTML::TokeParser ; |
use HTML::TokeParser ; |
|
|
# Changed by LG - commented out configs. |
# Changed by LG - commented out configs. |
Line 113 my %tr = (
|
Line 114 my %tr = (
|
'À' => 'yu', 'Ñ' => 'ya' |
'À' => 'yu', 'Ñ' => 'ya' |
); |
); |
|
|
|
# What to convert '@' to when obfuscating e-mail addresses (in '--add-from' |
|
# and/or '--obfuscate' modes. |
|
my $newdog = '[_@_]'; |
|
|
# ------------------------------------------------------------------------ # |
# ------------------------------------------------------------------------ # |
# End configuration settings. |
# End configuration settings. |
# ------------------------------------------------------------------------ # |
# ------------------------------------------------------------------------ # |
Line 132 my @opt_taglist ; # command-line tag
|
Line 137 my @opt_taglist ; # command-line tag
|
my $opt_ljcut ; # Add lj-cut after line number N |
my $opt_ljcut ; # Add lj-cut after line number N |
my $ljcut_delta = 5 ; # No lj-cut if less lines left after it |
my $ljcut_delta = 5 ; # No lj-cut if less lines left after it |
my $opt_ljcut_text ; # A text for lj-cut. |
my $opt_ljcut_text ; # A text for lj-cut. |
|
my $opt_obfuscate ; # Obfuscate e-mail addresses in body |
my $Parse = GetOptions( \%Opt, |
my $Parse = GetOptions( \%Opt, |
'user|u=s', |
'user|u=s', |
'password|passwd|p=s', |
'password|passwd|p=s', |
Line 155 my $Parse = GetOptions( \%Opt,
|
Line 161 my $Parse = GetOptions( \%Opt,
|
'ljcut|lj-cut|cut|l=i'=>\$opt_ljcut, |
'ljcut|lj-cut|cut|l=i'=>\$opt_ljcut, |
'ljcut-text|lj-cut-text|cut-text|ljcuttext|cuttext=s'=>\$opt_ljcut_text, |
'ljcut-text|lj-cut-text|cut-text|ljcuttext|cuttext=s'=>\$opt_ljcut_text, |
'keep-spaces|keep-space|keepspaces|keepspace|spaces|space!' => \$opt_keepspaces, |
'keep-spaces|keep-space|keepspaces|keepspace|spaces|space!' => \$opt_keepspaces, |
|
'obfuscate|obfu|o!' => \$opt_obfuscate, |
'help|h' => \$opt_h, |
'help|h' => \$opt_h, |
); |
); |
|
|
Line 198 if ( exists $Opt{'comments'} ) {
|
Line 205 if ( exists $Opt{'comments'} ) {
|
$Opt{'prop_opt_nocomments'} = "" ; |
$Opt{'prop_opt_nocomments'} = "" ; |
$Opt{'prop_opt_noemail'} = 1 ; |
$Opt{'prop_opt_noemail'} = 1 ; |
} elsif ( $Opt{'comments'} =~ /^\s*((off)|(no))\s*$/i ) { |
} elsif ( $Opt{'comments'} =~ /^\s*((off)|(no))\s*$/i ) { |
$Opt{'prop_opt_nocomments'} = 1 |
$Opt{'prop_opt_nocomments'} = 1 ; |
} else { |
} else { |
$Opt{'prop_opt_nocomments'} = $Opt{'comments'} ; |
$Opt{'prop_opt_nocomments'} = $Opt{'comments'} ; |
} |
} |
Line 211 if ( exists $Opt{'comments'} ) {
|
Line 218 if ( exists $Opt{'comments'} ) {
|
$Opt{'prop_taglist'} = join( ", ", @opt_taglist ) if ( @opt_taglist ) ; |
$Opt{'prop_taglist'} = join( ", ", @opt_taglist ) if ( @opt_taglist ) ; |
|
|
# Convert $opt_ljcut_text to UTF8. |
# Convert $opt_ljcut_text to UTF8. |
|
$opt_ljcut = 0 unless defined $opt_ljcut ; # Safety |
if ( defined $opt_ljcut_text ) { |
if ( defined $opt_ljcut_text ) { |
$opt_ljcut_text = |
$opt_ljcut_text = |
to_utf8({ -string => $opt_ljcut_text, -charset => $SystemCharset }) ; |
to_utf8({ -string => $opt_ljcut_text, -charset => $SystemCharset }) ; |
Line 226 href2utf8( \%Opt, $SystemCharset) ;
|
Line 234 href2utf8( \%Opt, $SystemCharset) ;
|
umask 077 ; |
umask 077 ; |
|
|
|
|
|
# Changed by LG: make sure that 'UTF-8' is recognized as a valid charset |
|
# along with "UTF8" ;-) |
|
utf8_charset_alias({ 'UTF-8' => 'UTF8' }); |
|
|
|
|
# Changed by LG - moved from above. |
# Changed by LG - moved from above. |
my $alias = shift @ARGV || "none" ; |
my $alias = shift @ARGV || "none" ; |
my $mp = new MIME::Parser() or die "new MIME::Parser(): $!\n" ; |
my $mp = new MIME::Parser() or die "new MIME::Parser(): $!\n" ; |
Line 544 sub post_body2href {
|
Line 557 sub post_body2href {
|
} elsif ($var =~ /^no-?tags?$/ || $var eq "no-?taglist") { |
} elsif ($var =~ /^no-?tags?$/ || $var eq "no-?taglist") { |
$req_data->{prop_taglist} = "" if $val =~ /^\s*((on)|(yes))\s*$/i ; |
$req_data->{prop_taglist} = "" if $val =~ /^\s*((on)|(yes))\s*$/i ; |
|
|
|
# Changed by LG - added 'Obfuscate' option to protect e-mail |
|
# addresses in the body of the message. |
|
} elsif ($var =~ /^obfuscate$/ ) { |
|
$val = 1 if $val =~ /^\s*((on)|(yes))\s*$/i ; |
|
$val = 0 if $val =~ /^\s*((off)|(no))\s*$/i ; |
|
$opt_obfuscate = $val ; |
|
|
# Anything else - just assign. |
# Anything else - just assign. |
} else { |
} else { |
$req_data->{$var} = $val ; |
$req_data->{$var} = $val ; |
Line 599 sub str2utf8 {
|
Line 619 sub str2utf8 {
|
|
|
sub post_me2req { |
sub post_me2req { |
my ($me, $e, $hints) = @_ ; |
my ($me, $e, $hints) = @_ ; |
my $mebh = $me->bodyhandle() or die "post_message(): no body?\n" ; |
# Changed by LG - if no body found (may happen sometimes in multipart |
|
# messages) then attempt to grab the very first MIME part. This is |
|
# somewhat hack-ish, but generally works ;-) |
|
# my $mebh = $me->bodyhandle() or die "post_message(): no body?\n" ; |
|
my $mebh = $me->bodyhandle() ; |
my $mehh = $me->head() ; |
my $mehh = $me->head() ; |
|
if ( ! defined $mebh ) { |
|
# Hack! And get the corresponding header instead of overall one. |
|
$mebh = $me->parts(0)->bodyhandle() or die "post_message(): no body?\n" ; |
|
$mehh = $me->parts(0)->head() ; |
|
} |
my $charset = $mehh->mime_attr("content-type.charset") || $e ; |
my $charset = $mehh->mime_attr("content-type.charset") || $e ; |
my $subject = hdr2utf8($me->get('Subject') || "", $charset) ; |
my $subject = hdr2utf8($me->get('Subject') || "", $charset) ; |
chomp $subject ; # Changed by LG |
chomp $subject ; # Changed by LG |
# Changed by LG. |
# Changed by LG. |
my $from = hdr2utf8($me->get('From') || "", $charset) ; |
my $from = hdr2utf8($me->get('From') || "", $charset) ; |
chomp $from ; |
chomp $from ; |
|
my $olddog_utf8 = str2utf8("\@", "ISO-8859-1") ; # @ in utf |
|
my $newdog_utf8 = str2utf8($newdog, "ISO-8859-1") ; # obfuscated in utf |
|
|
my $hr = href2utf8(post_body2href($mebh->open("r")), $charset) ; |
my $hr = href2utf8(post_body2href($mebh->open("r")), $charset) ; |
my $req = new HTTP::Request('POST', $post_uri) or |
my $req = new HTTP::Request('POST', $post_uri) or |
Line 626 sub post_me2req {
|
Line 657 sub post_me2req {
|
# Changed by LG - removed prefixing. |
# Changed by LG - removed prefixing. |
# $hr->{subject} = "[mail2lj] " . $hr->{subject} ; |
# $hr->{subject} = "[mail2lj] " . $hr->{subject} ; |
|
|
|
|
|
# Changed by LG - added option to obfuscate all e-mail addresses in |
|
# the body of mail messages. |
|
if ( $opt_obfuscate ) { |
|
$hr->{event} =~ |
|
s/\b([-+_.\w]+)($olddog_utf8)([-_.\w]+)\b/$1${newdog_utf8}$3/g ; |
|
} |
|
|
|
|
# Changed by LG - added options to add the plain or HTML-ized 'From' |
# Changed by LG - added options to add the plain or HTML-ized 'From' |
# field to the posted message. |
# field to the posted message. |
# |
# |
Line 652 sub post_me2req {
|
Line 692 sub post_me2req {
|
. str2utf8("</i></nobr>\n\n", "ISO-8859-1") ; |
. str2utf8("</i></nobr>\n\n", "ISO-8859-1") ; |
} |
} |
|
|
# Obfuscate the address. |
# This address is alway obfuscated (independently of the |
my $olddog = str2utf8("\@", "ISO-8859-1") ; # @ in utf8 |
# '--obfuscate' option which only governs addresses _already_ |
my $newdog = str2utf8("[_\@_]", "ISO-8859-1") ; # [_@_] in utf8 |
# in the body. |
$added_from =~ s/$olddog/$newdog/g ; # Obfuscate |
$added_from =~ s/$olddog_utf8/$newdog_utf8/g ; # Obfuscate |
$hr->{event} = $added_from . $hr->{event} ; # And append |
$hr->{event} = $added_from . $hr->{event} ; # And append |
} |
} |
|
|
Line 1003 Options:
|
Line 1043 Options:
|
Insert the From: field from the e-mail as the first line of |
Insert the From: field from the e-mail as the first line of |
the posted message. The field is added in plain text (without |
the posted message. The field is added in plain text (without |
any HTML-formatting - see '--fromh' for that). For slight |
any HTML-formatting - see '--fromh' for that). For slight |
antispam protection, '\@' is replaced by '[_\@_]'. The option |
antispam protection, '\@' is replaced by '$newdog'. The option |
can be negated ('--nofrom'). Default is '--nofrom'. |
can be negated ('--nofrom'). Default is '--nofrom'. |
|
Note: this option is independent from '--obfuscate' (i.e. the |
|
prepended From is always obfuscated, even if the rest of the |
|
message is not). |
|
|
--fromh, --addfromh |
--fromh, --addfromh |
Same as '--from', but uses HTML-markup to highlight inserted |
Same as '--from', but uses HTML-markup to highlight inserted |
Line 1012 Options:
|
Line 1055 Options:
|
nice for mailing list -> Livejournal crossposting. The option |
nice for mailing list -> Livejournal crossposting. The option |
can be negated ('--nofromh'). Default is '--nofromh'. |
can be negated ('--nofromh'). Default is '--nofromh'. |
|
|
|
-o, --obfuscate |
|
Obfuscate all e-mail addresses that are present in the body |
|
of the message. For slight antispam protection, '\@' in these |
|
addresses is replaced by '$newdog'. The option can be negated |
|
('--noobfuscate'). Default is '--noobfuscate'. |
|
|
--spaces, --keepspaces |
--spaces, --keepspaces |
Normally the script does not change original message text, |
Normally the script does not change original message text, |
and all of it is preserved in the body of resulting LJ post. |
and all of it is preserved in the body of resulting LJ post. |