diff options
author | Sergey Poznyakoff <gray@gnu.org> | 2019-07-27 17:28:00 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org> | 2019-07-27 17:28:00 +0300 |
commit | b1f09164c228341ed71e9622aeafde88c5b12b9d (patch) | |
tree | 05660f6e785865e7528ab464b68b8bddc986100c /tpnotify | |
parent | cb600e1bbcab3ddcf31bdd9f9babe30dec965420 (diff) | |
download | tpnotify-b1f09164c228341ed71e9622aeafde88c5b12b9d.tar.gz tpnotify-b1f09164c228341ed71e9622aeafde88c5b12b9d.tar.bz2 |
Rewrite the Fcc support
Allow the user to select the method to use for refiling: either "perl"
(using the Mail::Box::Manager package) or "mailutils" (using the
movemail tool from GNU mailutils).
Diffstat (limited to 'tpnotify')
-rwxr-xr-x | tpnotify | 205 |
1 files changed, 178 insertions, 27 deletions
@@ -26,12 +26,13 @@ use File::Temp qw(tempdir); use File::Path qw(remove_tree); use IPC::Open2; use Mail::Send; use Mail::Message; use Sys::Hostname;; use Data::Dumper; +use POSIX qw(strftime); my $progname = basename($0); my $progdescr = "Notifies translationproject.org about new POT file"; our $VERSION = "1.0"; my $keep; # Keep temporary directory on errors @@ -41,12 +42,13 @@ my $dry_run; # Dry-run mode my %mailer_args; # Mailer arguments my $sender; # Sender email my $fullname; # Sender real name my $localdomain; # Local domain name my $recipient; # Override recipient address my @add_headers; # Additional headers +my $refile_method; # Refiling method my $template = <<'EOT'; To: <coordinator@translationproject.org> Subject: $package_base.pot Hello, @@ -243,13 +245,13 @@ sub get_special_var { sub expand_template { join("\n", map { s/\$(signature|username)/get_special_var($1)/gex; s/(\$[a-zA-Z_][a-zA-Z0-9_]+)/eval "$1"/gex; $_ - } split(/\n/, $template)); + } split(/\n/, $template)) . "\n"; } sub read_mh_path { if (open(my $fd, '<', "$ENV{HOME}/.mh_profile")) { my $prev; while (<$fd>) { @@ -285,49 +287,146 @@ sub notify { if ($dry_run) { info("NOT sending"); return; } info("sending message") if $verbose; - + if (my $folder = $msg->get('Fcc')) { $msg->head()->delete('Fcc'); + refile($msg, $folder); + } + $msg->send(%mailer_args); - my %args = (create => 1, access => 'rw'); + my $to = $recipient || $msg->get('To'); +# info("Location of $package_base.pot sent to $to"); +} +sub mail_box_manager_supported { + eval { + require Mail::Box::Manager; + }; + return !$@; +} + +sub mail_box_manager_refile { + my ($msg,$folder) = @_; + + my %args = (create => 1, access => 'rw'); + + if ($folder =~ m#^/#) { + $args{type} = 'mbox'; + $args{folder} = $folder; + } elsif ($folder =~ s#mh:(?://)?(.+)#$1#) { + $args{type} = 'mh'; if ($folder =~ m#^/#) { - $args{type} = 'mbox'; - $args{folder} = $folder; - } elsif ($folder =~ s#mh:(?://)?(.+)#$1#) { - $args{type} = 'mh'; - if ($folder =~ m#^/#) { - $args{folder} = $folder; - } else { - $args{folder} = read_mh_path() . '/' . $folder; - } - } elsif ($folder =~ s#maildir:(?://)?(.+)#$1#) { - $args{type} = 'maildir'; $args{folder} = $folder; } else { - abend(EX_DATAERR, "unrecognized Fcc folder: $folder"); + $args{folder} = read_mh_path() . '/' . $folder; } + } elsif ($folder =~ s#maildir:(?://)?(.+)#$1#) { + $args{type} = 'maildir'; + $args{folder} = $folder; + } else { + abend(EX_DATAERR, "unrecognized Fcc folder: $folder"); + } - use Mail::Box::Manager; - my $mgr = Mail::Box::Manager->new(); - my $folder = $mgr->open(%args) - or abend(EX_CANTCREAT, "can't open folder $folder"); - $folder->addMessage($msg) - or abend(EX_CANTCREAT, "can't save message to folder $folder"); - $folder->close; + my $mgr = Mail::Box::Manager->new(); + my $folder = $mgr->open(%args) + or abend(EX_CANTCREAT, "can't open folder $folder"); + $folder->addMessage($msg) + or abend(EX_CANTCREAT, "can't save message to folder $folder"); + $folder->close; +} + +sub read_mh_path { + my $file = File::Spec->catfile($ENV{HOME}, '.mh_profile'); + my $path; + if (-f $file) { + if (open(my $fd, '<', $file)) { + while (<$fd>) { + chomp; + if (s/Path:\s*(.+)/$1/) { + $path = $1; + last; + } + } + close $path; + } + } else { + err("can't open $file: $!", prefix => 'warning'); } + return $path; +} - $msg->send(%mailer_args); +sub movemail_supported { + if (open(my $fd, '-|', 'movemail --version')) { + chomp($_ = <$fd>); + if (m{^movemail \(GNU Mailutils\) (?<maj>\d+)\.(?<min>\d+)}) { + return 1; + } + } +} - my $to = $recipient || $msg->get('To'); -# info("Location of $package_base.pot sent to $to"); +sub movemail_refile { + my ($msg,$folder) = @_; + + my $tmpname = "message"; + + open(my $fd, '>', $tmpname) + or abend(EX_CANTCREAT, "can't create temporary file: $!"); + my $sender_address = ($msg->study('From')->addresses())[0]->address(); + print $fd "From $sender_address " + . strftime("%a %b %e %H:%M:%S %Y", gmtime) + . "\n"; + $msg->write($fd); + close($fd); + + if ($folder =~ m{mh:(?://)?(.+)}) { + my $dir = $1; + if (!File::Spec->file_name_is_absolute($dir) && $dir !~ '^~') { + if (my $path = read_mh_path()) { + $folder = File::Spec->catfile($path, $dir); + } else { + err("no MH Path: assuming mh://$dir", prefix => 'warning'); + } + $folder = 'mh://' . $folder; + } + } + system("movemail $wd/$tmpname $folder"); + unlink $tmpname; +} + +my %refile_tab = ( + 'movemail' => { supported => \&movemail_supported, + refile => \&movemail_refile, + priority => 10 }, + 'perl' => { supported => \&mail_box_manager_supported, + refile => \&mail_box_manager_refile, + priority => 0 } +); + +sub refile { + unless ($refile_method) { + foreach my $meth (sort { + $refile_tab{$a}{priority} <=> $refile_tab{$b}{priority} } + keys %refile_tab) { + if (&{$refile_tab{$meth}{supported}}) { + $refile_method = $meth; + last; + } + } + unless ($refile_method) { + err("no method is available to refile the message"); + return; + } + } + info("using $refile_method for refiling"); + &{$refile_tab{$refile_method}{refile}}(@_); } + END { chdir("/"); if (!($? && $keep)) { remove_tree($wd, {error => \my $err}); if (@$err) { @@ -384,13 +483,14 @@ my %kw = ( from => \$sender, sender => \$sender, fullname => \$fullname, domain => \$localdomain, to => \$recipient, add => \@add_headers, - 'add-header' => \@add_headers + 'add-header' => \@add_headers, + 'refile-method' => \$refile_method ); sub read_config { my $config_file = shift; open(FILE, "<", $config_file) or abend(EX_NOINPUT, "cannot open $config_file: $!"); @@ -494,13 +594,14 @@ GetOptions("keep|k" => \$keep, exit(EX_USAGE) unless set_mailer($_[1]) }, "from|f=s" => \$sender, "fullname|F=s" => \$fullname, "domain|D=s" => \$localdomain, "to=s" => \$recipient, - "add|a=s@" => \@add_headers + "add|a=s@" => \@add_headers, + "refile-method=s" => \$refile_method ) or exit(EX_USAGE); ++$verbose if $dry_run; if ($debug && exists($mailer_args{via})) { if ($mailer_args{via} eq 'sendmail') { $mailer_args{sendmail_options} = [] @@ -532,12 +633,18 @@ if ($recipient) { #print Dumper([\%mailer_args]); $url = shift; abend(EX_USAGE, "not enough arguments") unless defined $url; abend(EX_USAGE, "too many arguments") unless $#ARGV == -1; +if ($refile_method) { + abend(EX_USAGE, "unknown refiling method") + unless exists($refile_tab{$refile_method}); + abend(EX_USAGE, "refiling method not supported") + unless (&{$refile_tab{$refile_method}{supported}}); +} $wd = tempdir() or abend(EX_CANTCREAT, "can't create temporary directory: $!"); chdir($wd) or abend(EX_OSERR, "can't change to temporary directory $wd: $!"); download($url); @@ -571,12 +678,13 @@ B<tpnotify> [B<--from=>I<EMAIL>] [B<--fullname=>I<NAME>] [B<--keep>] [B<--mailer=>I<SPEC>] [B<--no-config>] [B<--no-signature>] +[B<--refile-method=>B<perl> | B<mailutils>] [B<--signature=>I<FILE>] [B<--stable>] [B<--template=>I<FILE>] [B<--to=>I<EMAIL>] [B<--verbose>] I<URL> @@ -635,12 +743,20 @@ defined, the B<~/Mail> directory is assumed. Maildir folder at I<PATHNAME>. Relative pathnames are relative to the current user's home directory. =back +Two methods can be used to support B<Fcc> refiling: the B<perl> method, which +uses the B<Mail::Box::Manager> Perl package, and the B<mailutils> method, +which uses GNU mailutils. By default, B<tpnotify> attempts to use B<perl>, +and falls back to B<mailutils> if that's not possible. If the latter is not +available as well, it issues an error message and terminates. The user can +select the refiling method using the B<--refile-method> option. See the +B<BUGS> section for details. + Additional configuration is supplied in configuration file and command line. The latter overrides the former. See the section B<CONFIGURATION> for a detailed discussion of the configuration file format. The B<-v> (B<--verbose>) command line option instructs the tool to verbosely list each step being executed. Additionally, the B<-d> (B<--debug>) option @@ -734,12 +850,22 @@ Sets the recipient address to be used instead of the emails from B<To:>, B<Cc:>, and B<Bcc:> headers of the constructed message. =item B<add=>I<HDR>B<:>I<VAL> Adds the given header to the message. See also the B<--add> command line option. + +=item B<refile-method=>B<perl> | B<mailutils> + +Selects the method to implement B<Fcc>. The value B<perl> means to use +B<Mail::Box::Manager> perl package (L<https://metacpan.org/release/Mail-Box>). +The value B<mailutils> means to use the B<movemail> program from B<GNU +mailutils> (L<https://mailutils.org>). + +By default, the first available method is used. See the +B<BUGS> section for possible reasons to use this setting. =back An example of the configuration file follows: # Example configuration file for tpnotify @@ -921,12 +1047,18 @@ requires authentication. =item B<-n>, B<--dry-run> Don't actually send the message. Verbosely print what is being done (see the B<--verbose> option) and display the content of the message that whould have been sent. + +=item B<--refile-method=>B<perl> | B<mailutils> + +Select the method to implement B<Fcc>. Refer to the description of +the B<refile-method> setting in the B<CONFIGURATION> chapter for a +detailed discussion. =item B<-s>, B<--signature=>I<FILE> Read signature from I<FILE>. The content of the file is available as the value of the B<$signature> template variable. @@ -994,12 +1126,31 @@ Required output file cannot be created or written. =item B<78> Configuration error. =back + +=head1 BUGS + +If your temlate file contains an B<Fcc> header pointing to a B<MH> folder, +you will get the following message: + + WARNING: Folder already locked with file <FILENAME> + +This is not a B<tpnotify> bug, but a bug of B<Mail::Box::Manager>. It has +been reported (see L<https://rt.cpan.org/Public/Bug/Display.html?id=130193>) +and hopefully it will be fixed in one of the future versions of +B<Mail::Box::Manager>. + +This is only a warning and can safely be ignored. If it does bother you, +you can switch to GNU mailutils for refiling the message. To do so, first +install movemail from GNU mailutils (the exact instructions vary depending +on the distro you are using), and then use the +B<--refile-method=mailutils> option or B<refile-method=mailutils> statement +in your F<~/.tpnotify> configuration file. =head1 AUTHOR Sergey Poznyakoff <gray@gnu.org> =cut |