summaryrefslogtreecommitdiffabout
path: root/tpnotify
authorSergey Poznyakoff <gray@gnu.org>2019-07-27 14:28:00 (GMT)
committer Sergey Poznyakoff <gray@gnu.org>2019-07-27 14:28:00 (GMT)
commitb1f09164c228341ed71e9622aeafde88c5b12b9d (patch) (side-by-side diff)
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') (more/less context) (ignore whitespace changes)
-rwxr-xr-xtpnotify205
1 files changed, 178 insertions, 27 deletions
diff --git a/tpnotify b/tpnotify
index 68acc00..63f379a 100755
--- a/tpnotify
+++ b/tpnotify
@@ -29,6 +29,7 @@ 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";
@@ -44,6 +45,7 @@ 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>
@@ -246,7 +248,7 @@ sub expand_template {
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 {
@@ -288,43 +290,140 @@ sub notify {
}
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("/");
@@ -387,7 +486,8 @@ my %kw = (
domain => \$localdomain,
to => \$recipient,
add => \@add_headers,
- 'add-header' => \@add_headers
+ 'add-header' => \@add_headers,
+ 'refile-method' => \$refile_method
);
sub read_config {
@@ -497,7 +597,8 @@ GetOptions("keep|k" => \$keep,
"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;
@@ -535,6 +636,12 @@ if ($recipient) {
$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: $!");
@@ -574,6 +681,7 @@ B<tpnotify>
[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>]
@@ -638,6 +746,14 @@ 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.
@@ -737,6 +853,16 @@ B<To:>, B<Cc:>, and B<Bcc:> headers of the constructed message.
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
@@ -924,6 +1050,12 @@ requires authentication.
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>
@@ -997,6 +1129,25 @@ Required output file cannot be created or written.
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

Return to:

Send suggestions and report system problems to the System administrator.