aboutsummaryrefslogtreecommitdiffstats
path: root/pullimap
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2019-01-22 12:14:46 +0100
committerGuilhem Moulin <guilhem@fripost.org>2019-01-22 12:14:46 +0100
commitdf6bf1c10b29464b579b83944aae1cce67a082b5 (patch)
treee5f62256b4c15d4ed3db80d65d7d228cad04ca1d /pullimap
parent18c5d6aec9e9dab83e96edeb8890e8cd9ef63b66 (diff)
parent41a6694c6d0582c7fffd682926e964ff3fa39b7b (diff)
Merge tag 'upstream/0.4' into debian
Upstream version 0.4
Diffstat (limited to 'pullimap')
-rwxr-xr-xpullimap69
1 files changed, 42 insertions, 27 deletions
diff --git a/pullimap b/pullimap
index dca8c49..495b99e 100755
--- a/pullimap
+++ b/pullimap
@@ -2,7 +2,7 @@
#----------------------------------------------------------------------
# Pull mails from an IMAP mailbox and deliver them to a SMTP session
-# Copyright © 2016 Guilhem Moulin <guilhem@fripost.org>
+# Copyright © 2016-2018 Guilhem Moulin <guilhem@fripost.org>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -21,7 +21,8 @@
use strict;
use warnings;
-our $VERSION = '0.3';
+use v5.20.2;
+our $VERSION = '0.4';
my $NAME = 'pullimap';
use Errno 'EINTR';
@@ -31,7 +32,7 @@ use List::Util 'first';
use Socket qw/PF_INET PF_INET6 SOCK_STREAM/;
use lib 'lib';
-use Net::IMAP::InterIMAP qw/read_config compact_set/;
+use Net::IMAP::InterIMAP 0.0.4 qw/xdg_basedir read_config compact_set/;
# Clean up PATH
$ENV{PATH} = join ':', qw{/usr/bin /bin};
@@ -59,15 +60,19 @@ usage(1) unless $#ARGV == 0 and $ARGV[0] ne '_';
#######################################################################
# Read and validate configuration
#
-my $CONF = read_config( delete $CONFIG{config} // $NAME,
- , [$ARGV[0]]
- , statefile => qr/\A(\P{Control}+)\z/
- , mailbox => qr/\A([\x01-\x7F]+)\z/
- , 'deliver-method' => qr/\A([ls]mtp:\[.*\]:\d+)\z/
- , 'deliver-ehlo' => qr/\A(\P{Control}+)\z/
- , 'deliver-rcpt' => qr/\A(\P{Control}+)\z/
- , 'purge-after' => qr/\A(\d*)\z/
- )->{$ARGV[0]};
+my $CONF = do {
+ my $conffile = delete($CONFIG{config}) // "config";
+ $conffile = xdg_basedir( XDG_CONFIG_HOME => ".config", $NAME, $conffile );
+ read_config( $conffile
+ , [$ARGV[0]]
+ , statefile => qr/\A(\P{Control}+)\z/
+ , mailbox => qr/\A([\x01-\x7F]+)\z/
+ , 'deliver-method' => qr/\A([ls]mtp:\[.*\]:\d+)\z/
+ , 'deliver-ehlo' => qr/\A(\P{Control}+)\z/
+ , 'deliver-rcpt' => qr/\A(\P{Control}+)\z/
+ , 'purge-after' => qr/\A(\d*)\z/
+ )->{$ARGV[0]};
+};
my ($MAILBOX, $STATE);
do {
@@ -75,23 +80,23 @@ do {
my $statefile = $CONF->{statefile} // $ARGV[0];
die "Missing option statefile" unless defined $statefile;
- $statefile = $statefile =~ /\A(\p{Print}+)\z/ ? $1 : die "Insecure $statefile";
-
- unless ($statefile =~ /\A\//) {
- my $dir = ($ENV{XDG_DATA_HOME} // "$ENV{HOME}/.local/share") .'/'. $NAME;
- $dir = $dir =~ /\A(\/\p{Print}+)\z/ ? $1 : die "Insecure $dir";
- $statefile = $dir .'/'. $statefile;
- unless (-d $dir) {
- mkdir $dir, 0700 or die "Can't mkdir $dir: $!\n";
- }
- }
+ $statefile = xdg_basedir( XDG_DATA_HOME => ".local/share", $NAME, $statefile );
+
+ my $mode = O_RDWR | O_DSYNC;
+ # don't auto-create in long-lived mode
+ $mode |= O_CREAT unless defined $CONFIG{idle};
- sysopen($STATE, $statefile, O_CREAT|O_RDWR|O_DSYNC, 0600) or die "Can't open $statefile: $!";
+ sysopen($STATE, $statefile, $mode, 0600) or die "Can't open $statefile: $!";
# XXX we need to pack the struct flock manually: not portable!
my $struct_flock = pack('s!s!l!l!i!', F_WRLCK, SEEK_SET, 0, 0, 0);
fcntl($STATE, F_SETLK, $struct_flock) or die "Can't lock $statefile: $!";
my $flags = fcntl($STATE, F_GETFD, 0) or die "fcntl F_GETFD: $!";
fcntl($STATE, F_SETFD, $flags | FD_CLOEXEC) or die "fcntl F_SETFD: $!";
+
+ # We have no version number in the statefile, but if we ever need a
+ # migration, we'll add a 1-byte header for the version number, and
+ # assume version 1.0 if the size of the file is a multiple of 4
+ # bytes. (We can also use the fact that bytes 5 to 8 are never all 0.)
};
@@ -249,10 +254,20 @@ sub purge() {
my @now = gmtime($now - $days*86400);
my @m = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; # RFC 3501's date-month
my $date = sprintf("%02d-%s-%04d", $now[3], $m[$now[4]], $now[5]+1900);
- my @uid = $IMAP->search("UID $set BEFORE $date");
-
- $set = @uid ? compact_set(@uid) : undef;
- $IMAP->log("Removing ".($#uid+1)." UID(s) $set") if defined $set and !$CONFIG{quiet};
+ my $ext = $IMAP->incapable('ESEARCH') ? undef : [qw/COUNT ALL/];
+ my @uid = $IMAP->search((defined $ext ? "RETURN (".join(' ', @$ext).') ' : '')
+ ."UID $set BEFORE $date");
+ my $count;
+ if (defined $ext) {
+ my ($uid_indicator, %resp) = @uid;
+ $IMAP->panic() unless defined $uid_indicator and $uid_indicator = 'UID';
+ $count = $resp{COUNT} // $IMAP->panic();
+ $set = $resp{ALL}; # MUST NOT be present if there are no matches
+ } else {
+ $count = $#uid+1;
+ $set = $count == 0 ? undef : compact_set(@uid);
+ }
+ $IMAP->log("Removing $count UID(s) $set") if $count > 0 and !$CONFIG{quiet};
}
if (defined $set) {