aboutsummaryrefslogtreecommitdiff
path: root/tpnotify
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org>2019-07-27 17:28:00 +0300
committerSergey Poznyakoff <gray@gnu.org>2019-07-27 17:28:00 +0300
commitb1f09164c228341ed71e9622aeafde88c5b12b9d (patch)
tree05660f6e785865e7528ab464b68b8bddc986100c /tpnotify
parentcb600e1bbcab3ddcf31bdd9f9babe30dec965420 (diff)
downloadtpnotify-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-xtpnotify205
1 files changed, 178 insertions, 27 deletions
diff --git a/tpnotify b/tpnotify
index 68acc00..63f379a 100755
--- a/tpnotify
+++ b/tpnotify
@@ -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

Return to:

Send suggestions and report system problems to the System administrator.