flail
view release on metacpan or search on metacpan
:cmd = pipe just body through cmd and re-load just body
,code = invoke code on message (\$M bound to message, \$H bound to header)
multiple actions can be given at once, i.e. sSy = sign, cryptosign & send
|, : or , actions must be the last in the chain
__CactioN__
($P) = reverse(split("/",$0));
$USAGE = <<__UsaGE__;
usage: $P [-hvlqs1Qncp] [-P pop3_info] [-I imap_info] [-d folder_dir] [-i incoming_folder] [-F from_addr] [-D domain] [-S smtp_host] [-T tempdir] [-e editor] [-C fcc_folder] [-R imap/pop3] [-N new_label] [-g sig_dir] [cmd]
__UsaGE__
$| = 1; # for mumbling
$Mumbles = 0;
$DEF_FOLDER_DIR = $ENV{'HOME'} . "/mail";
$DEF_INCOMING = "INCOMING";
$DEF_ADDRESSBOOK = $ENV{'HOME'} . "/.flail_addressbook";
$DEF_HOST = eval { (uname())[1] } || `hostname` || undef;
if (defined($DEF_HOST)) {
my @tmp = split(/\./, $DEF_HOST);
if (scalar(@tmp) < 2) {
$DEF_DOMAIN = $DEF_HOST;
} else {
$DEF_DOMAIN = $tmp[$#tmp - 1] . "." . $tmp[$#tmp];
}
} else {
$DEF_DOMAIN = 'unknown.domain'; ### CONFIGURE
}
chomp($DEF_DOMAIN);
$NAME = eval { (getpwuid($>))[6] } || $ENV{NAME} || "";
if($NAME =~ /[^\w\s]/) {
# $NAME =~ s/"/\"/g;
$NAME = '"' . $NAME . '"';
}
# These should all be my ...
$DEF_FROM_ADDR = $ENV{'USER'} . "\@" . $DEF_DOMAIN;
$DEF_FROM = sprintf("%s <%s>", $NAME, $DEF_FROM_ADDR);
$DEF_SMTPHOST = "localhost";
$DEF_TEMPDIR = $ENV{'TMPDIR'} || "/tmp";
$DEF_EDITOR = $ENV{'EDITOR'} || "gnuclient";
$DEF_FCC_FOLDER = "carbon-copies";
$DEF_CHECK_TYPE = "pop3";
$DEF_RCFILE = $ENV{'HOME'} . "/.$P" . "rc";
$DEF_NEW_LABEL = "new";
$DEF_SIGDIR = $ENV{'HOME'} . "/.signatures";
$DEF_SIGDIR = $ENV{'HOME'} unless (-d $DEF_SIGDIR);
$DEF_SMTP_TOUT = 60;
$SUBDIR = "";
$MAX_PAGE_LINES = 24;
$MAX_LINE_WIDTH = 80;
$N_LINES = 0;
$RECENT_LINES = 0;
$IMAPInbox = "INBOX";
$RemoveFromServer = 1;
$SMTPPort = 25;
$TempCounter = 1;
$AskBeforeSending = 1;
$DontCacheConnections = 0;
$AllowCommandOverrides = 0;
$AutoSyncIncoming = 0;
$IMAPAutoExpunge = 0;
$PlainOutput = 0;
$PlainOutput = 1 if defined($ENV{'TERM'}) && ($ENV{'TERM'} =~ /^dumb|emacs$/);
#$GPGBinary = "/home/attila/gpg-1.2/bin/gpg";
$GPGBinary = "/usr/local/bin/gpg" if (-x "/usr/local/bin/gpg");
$GPGBinary ||= "/usr/bin/gpg" if (-x "/usr/bin/gpg");
$CryptoSignCmd = "$GPGBinary --clearsign"; # set in .flailrc
$CryptoCryptCmd = "$GPGBinary --armor -se"; # ditto
$AutoDotSig = undef; # set to automatically attach .sig
$SMTPTout = $DEF_SMTP_TOUT;
$SMTPDebug = 0;
$GPGHomeDir = $ENV{'HOME'} . "/.gnupg";
$DateHeaderFmt = "%a, %d %b %G %T %Z";
$DraftsFolder = "drafts";
$LeftJustifyList = 0;
$SpoolDir = '/var/mail' if -d '/var/mail';
$SpoolFile = $ENV{'USER'};
sub flail_eval;
sub flail_defcmd;
sub ascending { $a <=> $b }
sub descending { $b <=> $a }
sub psychochomp {
my $in = shift(@_);
$in =~ s/^\s+//g;
$in =~ s/\s+$//g;
return $in;
}
# is this strictly RFC822 compliant? what i want is to SQUISH all
# extraneous whitespace in an address wherever it might be.
sub addresschomp {
my $in = shift(@_);
$in =~ s/\n/ /g;
$in =~ s/\r/ /g;
$in =~ s/\s+/ /g;
$in = psychochomp($in);
return $in;
}
# sys - like system, but redirect stdout and stderr, and die on errors
#
sub sys {
system("@_ >/dev/null 2>&1") == 0 || die "\n$P: command: @_: $!\n";
}
# say - print a message if we're in verbose mode
#
sub say {
return unless $Verbose;
print "\n" if $Mumbles;
print ">>> @_";
print "\n" unless ("@_" =~ /\n$/);
$Mumbles = 0;
}
# dsay - debugging say
#
sub dsay {
return unless $Debug;
if ($_[0] =~ /^\d+$/) {
my $l = shift(@_);
return unless $Debug >= $l;
}
my($string) = @_;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
my @words = ();
my($word,$rest) = word_extract($string);
while ($word) {
push(@words, $word);
($word,$rest) = word_extract($rest);
}
return @words;
}
# Turn a string containing a possibly semicolon-delimited list of
# commands that contain quoted phrases into a vector of vectors
# with the quotes stripped off. The outer vector contains one
# sub-vector per command, the inner vectors contain one element
# per "word".
sub commandify {
my @words = wordify(shift(@_));
my $commands;
my($wantref0,$wantref1) = (0,0);
if (@_ && (ref($_[0]) eq 'ARRAY')) {
$wantref0 = 1;
$commands = shift(@_);
if ((@$commands == 1) && (ref($commands->[0]) eq 'ARRAY') && !scalar(@{$commands->[0]})) {
shift(@$commands);
$wantref1 = 1;
}
} else {
$commands = [];
}
my $cmd = [];
while (@words > 0) {
my $word = shift(@words);
if ($word =~ /^;(.*)$/) {
my $c = $1;
if (@$cmd) {
push(@$commands,$wantref1 ? $cmd : join(' ',@$cmd));
$cmd = [];
}
if ($c && length($c)) {
push(@$cmd, (!$wantref1 && ($c =~ /\s/)) ? qq|"$c"| : $c);
}
} elsif ($word =~ /^([^;].*);$/) {
my $c = $1;
if ($c && length($c)) {
push(@$cmd, (!$wantref1 && ($c =~ /\s/)) ? qq|"$c"| : $c);
}
push(@$commands,$wantref1 ? $cmd : join(' ',@$cmd));
$cmd = [];
} elsif ($word && length($word)) {
push(@$cmd, (!$wantref1 && ($word =~ /\s/)) ? qq|"$word"| : $word);
}
}
if (@$cmd) {
push(@$commands,$wantref1 ? $cmd : join(' ',@$cmd));
}
return $wantref0 ? $commands : @$commands;
}
# gpg_op - run gpg on a message
sub gpg_op {
my($msg,$op,$recips) = @_;
$op = 's' unless $op;
dsay "gpg_op: $op\n";
my $head = $msg->head();
my $fa;
if ($op =~ /d/i) {
$fa = headaddr0($head, "To");
} else {
$fa = headaddr0($head, "From");
}
my($fauser,$fahost) = address_email($fa);
my $faf = $fauser . '@' . $fahost;
dsay "fauser=$fauser,fahost=$fahost";
my $faemail = "$fauser\@$fahost";
if (!defined($recips)) {
$recips = headaddrs($head, "To");
}
dsay "gpg recips:";
dsay join(" \n", @$recips);
my $mp = new PGP::GPG::MessageProcessor;
my $ghd = $GPGHomeDirs{$faf} || $GPGHomeDirs{$fauser} || $GPGHomeDir;
$mp->{homedir} = $ghd if $ghd;
my $p = get_password("GPG/$faf", "Passphrase for $faf");
while (!$mp->passphrase_test($p)) {
print "Bad passphrase.\n";
forget_password("GPG/$faf");
$p = get_password("GPG/$faf", "Passphrase for $faf");
}
my $input = gensym;
my $output = gensym;
my $error = gensym;
my $status = gensym;
$mp->{encrypt} = 0;
$mp->{sign} = 0;
$mp->{encrypt} = 1 if $op =~ /e/i;
dsay "[encrypting]\n" if $mp->{encrypt};
$mp->{sign} = 1 if $op =~ /s/i;
$mp->{clearsign} = 1 if $mp->{sign};
dsay "[signing]\n" if $mp->{sign};
$mp->{passphrase} = $p;
$mp->{recipients} = $recips;
if ($op =~ /i/i) {
$mp->{interactive} = 1;
$mp->{extraArgs} = [ '--allow-non-selfsigned-uid' ];
} else {
$mp->{interactive} = 0;
}
$mp->{noTTY} = 0;
$mp->{armor} = 1;
my $pid;
if ($op =~ /d/i) {
$pid = $mp->decipher($input, $output, $error, $status);
} else {
$pid = $mp->cipher($input, $output, $error, $status);
}
my $bod = $msg->body();
foreach my $line (@$bod) {
print $input $line;
print $input "\n" unless ($line =~ /\n$/);
}
close($input);
my @result = <$output>;
my @err = <$error>;
my @s = <$status>;
if ($Verbose) {
print "Status from the GPG operation:\n";
foreach my $statline (@s) {
print " $statline";
}
print "Error output from the GPG operation:\n";
foreach my $errline (@err) {
print " $errline"
}
}
close($output);
close($error);
close($status);
if (!scalar(@result) && (scalar(@$bod) > 0)) {
@_ = ( $1 );
}
foreach my $key (@_) {
addressbook_delete($key);
}
} elsif ($subcmd =~ /^import$/i) {
foreach my $file (@_) {
if ($file =~ /\.ldif$/) {
print "Importing LDIF file: $file\n";
addressbook_import_ldif($file);
} elsif ($file =~ /\.csv$/) {
print "Importing CSV file: $file\n";
addressbook_import_csv($file);
} else {
print "I'm not sure what kind of file $file is...\n";
print "I support LDIF and CSV; please rename it to one of those\n";
}
}
} elsif ($subcmd =~ /^take$/i) {
if (!defined($FOLDER)) {
print "no current folder\n";
return;
}
my $label = shift(@_) || "cur";
my $force = shift(@_) || undef;
$force = 1 if defined($force);
flail_eval("map $label { take_addrs($force); }"); # sick, but effective
} else {
if (($subcmd eq '') || ($subcmd =~ /^help$/i)) {
print "Addressbook subcommands:\n";
print " add nick mail - add an entry that maps nick -> mail\n";
print " import file... - import LDIF-format file(s)\n";
print " show nick... - show specific entries\n";
print " list [regexp] - list whole addressbook, or matching entries\n";
print " take [tag] - take addresses from the current message\n";
print " or from all messages with the given tag\n";
print " del nick... - delete entries\n";
} else {
print "Addressbook: bad cmd $subcmd; one of add,import,show,list,del\n";
}
return;
}
addressbook_checkpoint();
}
sub flail_read {
#dump_OPT() if $Verbose;
my $do_decrypt = defined($OPT->{decrypt})? 1: 0;
if (!defined($FOLDER)) {
print "no folder currently open\n";
return;
}
my $n = $_[0];
if (!defined($n)) {
my $msg = $FOLDER->get_message($FOLDER->current_message);
if (!defined($msg)) {
print "could not get current message\n";
} else {
if ($do_decrypt) {
my $won;
($won,$msg) = gpg_op($msg, "d", undef);
print "[GPG operation failed; displaying encrypted message]\n"
unless $won;
}
page_msg($msg);
}
} else {
my @tmp;
eval { @tmp = parse_range("@_"); };
@_ = @tmp unless $@;
while ($n = shift(@_)) {
if (!$FOLDER->message_exists($n)) {
print "no such message: $n\n" unless $Quiet;
$n = shift(@_);
next;
}
my $msg = $FOLDER->get_message($n);
if (!defined($msg)) {
print "$FOLDER_NAME: no message number $n\n";
return;
}
if ($do_decrypt) {
print "[Decrypting...]\n" if $Verbose;
my $won;
($won,$msg) = gpg_op($msg, "d", undef);
print "[GPG operation failed; displaying encrypted message]\n"
unless $won;
}
page_msg($msg);
$FOLDER->current_message($n);
}
}
}
sub flail_pipe {
if (!defined($FOLDER)) {
print "no folder currently open\n";
return;
}
my @msgs = ($FOLDER->current_message);
if ($_[0] =~ /^-/) {
my $seq = shift(@_);
my @tmp;
eval { @tmp = parse_range($seq); };
if ($@) {
print "failed to parse range expression \"$seq\": $@\n";
return;
}
@msgs = @tmp;
}
if (!@msgs) {
print "No messages to pipe\n";
return;
}
if (!@_) {
print "No command given\n";
}
my $cmd = "@_";
print "[Piping ".scalar(@msgs)." messages through: $cmd]\n" unless $Quiet;
pipe_cat_msg($cmd,$FOLDER->get_message($_),$OPT->{'noheader'}? 1: 0)
foreach (sort { $a <=> $b } @msgs);
}
sub flail_demung {
if (!defined($FOLDER)) {
print "no folder currently open\n";
return;
}
my $n = $_[0];
if (!defined($n)) {
print "you must specify at least one message\n";
return;
}
my @tmp;
eval { @tmp = parse_range("@_"); };
@_ = @tmp unless $@;
while (defined(my $n = shift(@_))) {
if (!$FOLDER->message_exists($n)) {
print "no such message: $n\n" unless $Quiet;
next;
}
my $msg = $FOLDER->get_message($n);
if (!defined($msg)) {
print "$FOLDER_NAME: no message number $n\n";
next;
my $x;
$hdrs->add("From", $use_from);
if (defined($_[0])) {
$hdrs->add("To", join(", ", @_));
} elsif (!$HeadersFromStdin) {
($x = get_header("To")) and $hdrs->add("To", $x);
}
if (!$HeadersFromStdin) {
$x = $DefaultSubject || get_header("Subject");
}
$hdrs->add("Subject", $x) if defined($x);
if (!$NoDefaultCC) {
while ($x = get_header("Cc")) {
last if ($x eq "");
$hdrs->add("Cc", $x);
}
}
$newmsg = new Mail::Internet(Header => $hdrs);
say "new, empty message:";
$newmsg->print(\*STDOUT) if $Verbose;
}
EDIT:
$hdrs = $newmsg->head();
get_default_header("Fcc", $hdrs);
get_default_header("Bcc", $hdrs);
say "before editing:";
print $newmsg->as_string if $Verbose;
my $edited = edit_msg($newmsg);
if (!$edited) {
print "send aborted\n";
return;
}
if ($AskBeforeSending) {
my $done = 0;
my $first_time = 1;
my $def_ans_str = "";
$def_ans_str = "<" . $DEF_COMPOSER_ACTION . "> "
if defined($DEF_COMPOSER_ACTION);
while (!$done) {
my $def = "";
$def = $def_ans_str if $first_time;
my $yorn =
$REPL->readline(colored_("Action? [y=send,n=abort,h=help] $def", "cyan"));
chomp($yorn);
$yorn = $DEF_COMPOSER_ACTION
if ($first_time && !length($yorn) && defined($DEF_COMPOSER_ACTION));
$first_time = 0;
my $won = 0;
while (defined($yorn)) {
($yorn =~ /^[h\?]/) && print $ComposerActionHelp;
($yorn =~ /^[yY]/) && ($done = 1,$yorn=undef);
($yorn =~ /^[nN]/) && ($done = -1,$yorn=undef);
($yorn =~ /^d/) &&(save_msg($edited,$DraftsFolder,"draft"),$done=-1,$yorn=undef);
($yorn =~ /^e/) && ($done = 2,$yorn=undef);
($yorn =~ /^[pP]/) && page_msg($edited);
($yorn =~ /^s/) && sign_msg($edited);
($yorn =~ /^[aA]/) && filter_addresses($edited,$AskAddressBook);
($yorn =~ /^S/ && !$HaveGPGMP) &&
($edited = pipe_msg($CryptoSignCmd, $edited, 1));
($yorn =~ /^S/ && $HaveGPGMP)&&
(($won,$edited)=gpg_op($edited, "s", undef));
($yorn =~ /^E/ && !$HaveGPGMP) &&
($edited = pipe_msg($CryptoCryptCmd, $edited, 1));
($yorn =~ /^E/ && $HaveGPGMP) &&
(($won,$edited)=gpg_op($edited,"se",undef));
($yorn =~ /^2/ && $HaveGPGMP) &&
(($won,$edited)=gpg_op($edited,"sei",undef));
($yorn =~ /^\|(.*)$/) && ($edited = pipe_msg($1, $edited),$yorn=undef);
($yorn =~ /^\:(.*)$/) && ($edited =pipe_msg($1,$edited,1),$yorn=undef);
($yorn =~ /^,(.*)$/) && (invoke_code_on_msg($edited, $1),$yorn=undef);
$yorn = substr($yorn, 1);
$yorn = undef if ($yorn eq "");
}
}
if ($done < 0) {
print "send aborted\n";
return;
}
if ($done == 2) {
$newmsg = $edited;
goto EDIT;
}
}
my @recips;
my $fccfn;
if (!$SMTPCommand) {
($fccfn,@recips) = send_via_smtp($edited);
} else {
($fccfn,@recips) = send_via_program($edited);
}
if ($#recips < 0) {
print "message not sent\n" unless $Quiet;
} else {
print "message sent to:\n " . join("\n ", @recips) . "\n"
unless $Quiet;
}
my @fcclist = split(/,/, $fccfn);
push(@fcclist, $FCCFolder) unless defined($fcclist[0]);
save_fccs($edited, @fcclist);
}
sub send_internal_old {
#dump_OPT() if $Verbose;
local($SMTPDebug) = (1) if $OPT->{debug};
local($Verbose) = (1) if $OPT->{verbose};
my $srcmsg = shift(@_);
my $newmsg = shift(@_);
my $use_from = shift(@_) || $FromAddress;
my $hdrs;
if (defined($newmsg)) {
$hdrs = $newmsg->head();
if (defined($_[0])) {
$hdrs->add("To", join(", ", @_));
} elsif (!$HeadersFromStdin) {
my $nto = $hdrs->count("To");
if (!$nto) {
my $x = get_header("To");
$hdrs->add("To", $x) if defined($x);
}
}
$hdrs->add("From", $use_from) if !$hdrs->count("From");
$hdrs->delete("Mail-From");
$hdrs->delete("Status");
} else {
say "consing up new message: @_";
$hdrs = new Mail::Header;
my $x;
$hdrs->add("From", $use_from);
if (defined($_[0])) {
$hdrs->add("To", join(", ", @_));
} elsif (!$HeadersFromStdin) {
($x = get_header("To")) and $hdrs->add("To", $x);
}
if (!$HeadersFromStdin) {
$x = $DefaultSubject || get_header("Subject");
}
$hdrs->add("Subject", $x) if defined($x);
if (!$NoDefaultCC) {
while ($x = get_header("Cc")) {
last if ($x eq "");
$hdrs->add("Cc", $x);
}
}
$newmsg = new Mail::Internet(Header => $hdrs);
say "new, empty message:";
$newmsg->print(\*STDOUT) if $Verbose;
}
EDIT:
$hdrs = $newmsg->head();
get_default_header("Fcc", $hdrs);
get_default_header("Bcc", $hdrs);
say "before editing:";
print $newmsg->as_string if $Verbose;
my $edited = edit_msg($newmsg);
if (!$edited) {
print "send aborted\n";
return;
}
if ($AskBeforeSending) {
my $done = 0;
my $first_time = 1;
my $def_ans_str = "";
$def_ans_str = "<" . $DEF_COMPOSER_ACTION . "> "
if defined($DEF_COMPOSER_ACTION);
while (!$done) {
my $def = "";
$def = $def_ans_str if $first_time;
my $yorn =
$REPL->readline(colored_("Action? [y=send,n=abort,h=help] $def", "cyan"));
chomp($yorn);
$yorn = $DEF_COMPOSER_ACTION
if ($first_time && !length($yorn) && defined($DEF_COMPOSER_ACTION));
$first_time = 0;
my $won = 0;
while (defined($yorn)) {
($yorn =~ /^[h\?]/) && print $ComposerActionHelp;
($yorn =~ /^[yY]/) && ($done = 1,$yorn=undef);
($yorn =~ /^[nN]/) && ($done = -1,$yorn=undef);
($yorn =~ /^d/) &&(save_msg($edited,$DraftsFolder,"draft"),$done=-1,$yorn=undef);
($yorn =~ /^e/) && ($done = 2,$yorn=undef);
($yorn =~ /^[pP]/) && page_msg($edited);
($yorn =~ /^s/) && sign_msg($edited);
($yorn =~ /^[aA]/) && filter_addresses($edited,$AskAddressBook);
($yorn =~ /^S/ && !$HaveGPGMP) &&
($edited = pipe_msg($CryptoSignCmd, $edited, 1));
($yorn =~ /^S/ && $HaveGPGMP)&&
(($won,$edited)=gpg_op($edited, "s", undef));
($yorn =~ /^E/ && !$HaveGPGMP) &&
($edited = pipe_msg($CryptoCryptCmd, $edited, 1));
($yorn =~ /^E/ && $HaveGPGMP) &&
(($won,$edited)=gpg_op($edited,"se",undef));
($yorn =~ /^2/ && $HaveGPGMP) &&
(($won,$edited)=gpg_op($edited,"sei",undef));
($yorn =~ /^\|(.*)$/) && ($edited = pipe_msg($1, $edited),$yorn=undef);
($yorn =~ /^\:(.*)$/) && ($edited =pipe_msg($1,$edited,1),$yorn=undef);
($yorn =~ /^,(.*)$/) && (invoke_code_on_msg($edited, $1),$yorn=undef);
$yorn = substr($yorn, 1);
$yorn = undef if ($yorn eq "");
}
}
if ($done < 0) {
print "send aborted\n";
return;
}
if ($done == 2) {
$newmsg = $edited;
goto EDIT;
}
}
say "sending message via SMTP host $SMTPHost";
my $smtp =
Net::SMTP->new(
$SMTPHost,
Port => $SMTPPort,
Hello => $Domain,
Timeout => $SMTPTout,
Debug => $SMTPDebug
);
if (!$smtp) {
flail_emit("ERROR: cannot connect to SMTP server $SMTPHost:$SMTPPort\n");
return;
}
if ($SMTPAuth) {
my $pass = $SMTPPass;
if (!defined($pass)) {
flail_emit("WARNING: No SMTP password defined for user $SMTPAuth - assuming it is empty\n")
if $SMTPDebug;
$pass = '';
}
my $okay = $smtp->auth($SMTPAuth,$pass);
if (!$okay) {
flail_emit("ERROR: SMTP authentication failed for $SMTPAuth\@$SMTPHost:$SMTPPort; try with /debug\n");
$smtp->quit();
return;
}
flail_emit("[SMTP: authenticated as $SMTPAuth to $SMTPHost:$SMTPPort]\n") if $Verbose;
}
say "smtp connection initialized to $SMTPHost: $smtp";
my @recips = ();
$hdrs = $edited->head;
$use_from = $hdrs->get("From");
$hdrs->replace("Sender", $use_from);
$hdrs->replace("X-Mailer", "flail $VERSION - http://flail.org");
$hdrs->replace("Date", POSIX::strftime($DateHeaderFmt,localtime));
my $body = $edited->body;
my $ha = $hdrs->header;
@recips = headaddrs($hdrs, "To");
my @tmp = headaddrs($hdrs, "Cc");
foreach my $t (@tmp) {
push(@recips, $t);
}
@tmp = headaddrs($hdrs, "Bcc");
foreach my $t (@tmp) {
( run in 0.600 second using v1.01-cache-2.11-cpan-df04353d9ac )