From a021e204e0844d81766ad13db229839436357c0e Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Mon, 28 Sep 2015 01:17:42 +0200
Subject: Bump version number.

---
 Changelog                 | 4 ++++
 interimap                 | 2 +-
 lib/Net/IMAP/InterIMAP.pm | 2 +-
 3 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/Changelog b/Changelog
index bc60b19..7a36711 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,7 @@
+interimap (0.3) upstream;
+
+ -- Guilhem Moulin <guilhem@guilhem.org>  Mon, 28 Sep 2015 01:16:47 +0200
+
 interimap (0.2) upstream;
 
   * Add support for the IMAP COMPRESS extension [RFC4978].  By default
diff --git a/interimap b/interimap
index 401bfa2..8a0afe5 100755
--- a/interimap
+++ b/interimap
@@ -21,7 +21,7 @@
 use strict;
 use warnings;
 
-our $VERSION = '0.2';
+our $VERSION = '0.3';
 my $NAME = 'interimap';
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat
                             bundling auto_version/;
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 3a6481e..721597d 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -16,7 +16,7 @@
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 #----------------------------------------------------------------------
 
-package Net::IMAP::InterIMAP v0.0.2;
+package Net::IMAP::InterIMAP v0.0.3;
 use warnings;
 use strict;
 
-- 
cgit v1.2.3


From eb6b971fbd5ef3f9bd76770262da5808cf8c506a Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Tue, 6 Oct 2015 02:25:56 +0200
Subject: Fix byte count for compression streams.

---
 Changelog                 | 2 ++
 lib/Net/IMAP/InterIMAP.pm | 4 ++--
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/Changelog b/Changelog
index 7a36711..f2b0bfc 100644
--- a/Changelog
+++ b/Changelog
@@ -1,5 +1,7 @@
 interimap (0.3) upstream;
 
+  * Fix byte count for compression streams.
+
  -- Guilhem Moulin <guilhem@guilhem.org>  Mon, 28 Sep 2015 01:16:47 +0200
 
 interimap (0.2) upstream;
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 721597d..8b1f451 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -485,11 +485,11 @@ sub stats($) {
     $msg .= ' recv '._kibi($self->{_OUTCOUNT});
     $msg .= ' (compr. '._kibi($self->{_OUTRAWCOUNT}).
             ', factor '.sprintf('%.2f', $self->{_OUTRAWCOUNT}/$self->{_OUTCOUNT}).')'
-      if defined $self->{_Z_DEFLATE} and $self->{_OUTCOUNT} > 0;
+      if exists $self->{_Z_DEFLATE} and $self->{_OUTCOUNT} > 0;
     $msg .= ' sent '._kibi($self->{_INCOUNT});
     $msg .= ' (compr. '._kibi($self->{_INRAWCOUNT}).
             ', factor '.sprintf('%.2f', $self->{_INRAWCOUNT}/$self->{_INCOUNT}).')'
-      if defined $self->{_Z_DEFLATE} and $self->{_INCOUNT} > 0;
+      if exists $self->{_Z_DEFLATE} and $self->{_INCOUNT} > 0;
     $self->log($msg);
 }
 
-- 
cgit v1.2.3


From 1aeca5f89e768df83d3f6f86e0d782e5a20fc1f6 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Mon, 19 Oct 2015 17:14:43 +0200
Subject: Add an option 'SSL_protocols'.

---
 Changelog                 |  3 +++
 interimap.1               |  9 +++++++++
 interimap.sample          |  3 ++-
 lib/Net/IMAP/InterIMAP.pm | 37 +++++++++++++++++++++++++++++++------
 4 files changed, 45 insertions(+), 7 deletions(-)

diff --git a/Changelog b/Changelog
index f2b0bfc..cf7e678 100644
--- a/Changelog
+++ b/Changelog
@@ -1,6 +1,9 @@
 interimap (0.3) upstream;
 
   * Fix byte count for compression streams.
+  * Add an option 'SSL_protocols' to list SSL protocols to enable or
+    disable.  The default value, "!SSLv2 !SSLv3", enables only TLSv1
+    and above.
 
  -- Guilhem Moulin <guilhem@guilhem.org>  Mon, 28 Sep 2015 01:16:47 +0200
 
diff --git a/interimap.1 b/interimap.1
index 60493f3..595f4a8 100644
--- a/interimap.1
+++ b/interimap.1
@@ -304,6 +304,15 @@ Whether to redirect \fIcommand\fR's standard error to \(lq/dev/null\(rq
 for type \fItype\fR=tunnel.
 (Default: \(lqNO\(rq.)
 
+.TP
+.I SSL_protocols
+A space-separated list of SSL protocols to enable or disable (if
+prefixed with an exclamation mark \(oq!\(cq).  Known protocols are
+\(lqSSLv2\(rq, \(lqSSLv3\(rq, \(lqTLSv1\(rq, \(lqTLSv1.1\(rq, and
+\(lqTLSv1.2\(rq.  Enabling a protocol is a short-hand for disabling all
+other protocols.
+(Default: \(lq!SSLv2 !SSLv3\(rq, i.e., only enable TLSv1 and above.)
+
 .TP
 .I SSL_cipher_list
 The cipher list to send to the server.  Although the server determines
diff --git a/interimap.sample b/interimap.sample
index 6d52f91..c3919ce 100644
--- a/interimap.sample
+++ b/interimap.sample
@@ -20,7 +20,8 @@ password = xxxxxxxxxxxxxxxx
 # SSL options
 SSL_CApath = /etc/ssl/certs
 #SSL_verify = YES
-#SSL_cipherlist = EECDH+AES:EDH+AES:!MEDIUM:!LOW:!EXP:!aNULL:!eNULL:!SSLv2:!SSLv3:!TLSv1:!TLSv1.1
+#SSL_protocols = !SSLv2 !SSLv3 !TLSv1 !TLSv1.1
+#SSL_cipherlist = EECDH+AESGCM:!MEDIUM:!LOW:!EXP:!aNULL:!eNULL
 #SSL_fingerprint = sha256$62E436BB329C46A628314C49BDA7C2A2E86C57B2021B9A964B8FABB6540D3605
 
 # vim:ft=dosini
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 8b1f451..95bdfa8 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -43,6 +43,8 @@ my $RE_ATOM_CHAR    = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]/;
 my $RE_ASTRING_CHAR = qr/[\x21\x23\x24\x26\x27\x2B-\x5B\x5D-\x7A\x7C-\x7E]/;
 my $RE_TEXT_CHAR    = qr/[\x01-\x09\x0B\x0C\x0E-\x7F]/;
 
+my $RE_SSL_PROTO = qr/(?:SSLv[23]|TLSv1|TLSv1\.[0-2])/;
+
 # Map each option to a regexp validating its values.
 my %OPTIONS = (
     host => qr/\A(\P{Control}+)\z/,
@@ -56,6 +58,7 @@ my %OPTIONS = (
     command => qr/\A(\P{Control}+)\z/,
     'null-stderr' => qr/\A(YES|NO)\z/i,
     compress => qr/\A($RE_ATOM_CHAR+(?: $RE_ATOM_CHAR+)*)\z/,
+    SSL_protocols => qr/\A(!?$RE_SSL_PROTO(?: !?$RE_SSL_PROTO)*)\z/,
     SSL_fingerprint => qr/\A((?:[A-Za-z0-9]+\$)?\p{AHex}+)\z/,
     SSL_cipherlist => qr/\A(\P{Control}+)\z/,
     SSL_verify => qr/\A(YES|NO)\z/i,
@@ -1460,20 +1463,42 @@ sub _ssl_verify($$$) {
     return $ok; # 1=accept cert, 0=reject
 }
 
+my %SSL_proto = (
+    'SSLv2' => Net::SSLeay::OP_NO_SSLv2(),
+    'SSLv3' => Net::SSLeay::OP_NO_SSLv3(),
+    'TLSv1' => Net::SSLeay::OP_NO_TLSv1(),
+    'TLSv1.1' => Net::SSLeay::OP_NO_TLSv1_1(),
+    'TLSv1.2' => Net::SSLeay::OP_NO_TLSv1_2()
+);
 
 # $self->_start_ssl($socket)
 #   Upgrade the $socket to SSL/TLS.
 sub _start_ssl($$) {
     my ($self, $socket) = @_;
     my $ctx = Net::SSLeay::CTX_new() or $self->panic("Failed to create SSL_CTX $!");
+    my $ssl_options = Net::SSLeay::OP_SINGLE_DH_USE() | Net::SSLeay::OP_SINGLE_ECDH_USE();
+
+    $self->{SSL_protocols} //= q{!SSLv2 !SSLv3};
+    my ($proto_include, $proto_exclude) = (0, 0);
+    foreach (split /\s+/, $self->{SSL_protocols}) {
+        my $neg = s/^!// ? 1 : 0;
+        s/\.0$//;
+        ($neg ? $proto_exclude : $proto_include) |= $SSL_proto{$_} // $self->panic("Unknown SSL protocol: $_");
+    }
+    if ($proto_include != 0) {
+        # exclude all protocols except those explictly included
+        my $x = 0;
+        $x |= $_ foreach values %SSL_proto;
+        $x &= ~ $proto_include;
+        $proto_exclude |= $x;
+    }
+    my @proto_exclude = grep { ($proto_exclude & $SSL_proto{$_}) != 0 } keys %SSL_proto;
+    $self->log("Disabling SSL protocol: ".join(', ', sort @proto_exclude)) if $self->{debug};
+    $ssl_options |= $SSL_proto{$_} foreach @proto_exclude;
+    $ssl_options |= Net::SSLeay::OP_NO_COMPRESSION();
 
     # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_options.html
-    Net::SSLeay::CTX_set_options($ctx,
-        Net::SSLeay::OP_SINGLE_ECDH_USE() |
-        Net::SSLeay::OP_SINGLE_DH_USE() |
-        Net::SSLeay::OP_NO_SSLv2() |
-        Net::SSLeay::OP_NO_SSLv3() |
-        Net::SSLeay::OP_NO_COMPRESSION() );
+    Net::SSLeay::CTX_set_options($ctx, $ssl_options);
 
     # https://www.openssl.org/docs/manmaster/ssl/SSL_CTX_set_mode.html
     Net::SSLeay::CTX_set_mode($ctx,
-- 
cgit v1.2.3


From 2c57ff750dd0ae6e3c9d72fd24eb32ff7ae235d7 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Fri, 6 Nov 2015 18:50:56 +0100
Subject: wibble

---
 README            | 2 +-
 interimap         | 2 +-
 interimap.1       | 3 +--
 interimap.service | 2 +-
 4 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/README b/README
index bf2e052..2b577a5 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-InterIMAP is a fast two-way synchronization program for QRESYNC-capable
+InterIMAP is a fast bidirectional synchronization program for QRESYNC-capable
 IMAP4rev1 servers.  Consult the manual for more information.
 
 
diff --git a/interimap b/interimap
index 8a0afe5..553586f 100755
--- a/interimap
+++ b/interimap
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -T
 
 #----------------------------------------------------------------------
-# Fast two-way synchronization program for QRESYNC-capable IMAP servers
+# Fast bidirectional synchronization for QRESYNC-capable IMAP servers
 # Copyright © 2015 Guilhem Moulin <guilhem@fripost.org>
 #
 # This program is free software: you can redistribute it and/or modify
diff --git a/interimap.1 b/interimap.1
index 595f4a8..7058f62 100644
--- a/interimap.1
+++ b/interimap.1
@@ -1,8 +1,7 @@
 .TH INTERIMAP "1" "JULY 2015" "InterIMAP" "User Commands"
 
 .SH NAME
-InterIMAP \- Fast two-way synchronization program for QRESYNC-capable
-IMAP servers
+InterIMAP \- Fast bidirectional synchronization for QRESYNC-capable IMAP servers
 
 .SH SYNOPSIS
 .B interimap\fR [\fIOPTION\fR ...] [\fICOMMAND\fR] [\fIMAILBOX\fR ...]
diff --git a/interimap.service b/interimap.service
index 2dc1506..8c685d9 100644
--- a/interimap.service
+++ b/interimap.service
@@ -1,5 +1,5 @@
 [Unit]
-Description=Fast two-way synchronization program for QRESYNC-capable IMAP servers
+Description=Fast bidirectional synchronization for QRESYNC-capable IMAP servers
 Wants=network-online.target
 After=network-online.target
 
-- 
cgit v1.2.3


From 29c40a4e26775e072c2ebcd57dcddbe66725cdbd Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Thu, 3 Mar 2016 19:05:40 +0100
Subject: Ensure the inbox is always used in upper-case internally.

RFC 3501:

    INBOX is case-insensitive.  All case variants of INBOX (e.g., "iNbOx") MUST
    be interpreted as INBOX not as an astring.  An astring which consists of
    the case-insensitive sequence "I" "N" "B" "O" "X" is considered to be INBOX
    and not an astring.
---
 lib/Net/IMAP/InterIMAP.pm | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 95bdfa8..c5b45aa 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -734,6 +734,7 @@ sub rename($$$;$) {
 #   If $try is set, print a warning but don't crash if the command fails.
 sub subscribe($$;$) {
     my ($self, $mailbox, $try) = @_;
+    $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
     my $r = $self->_send("SUBSCRIBE ".quote($mailbox));
     if ($IMAP_cond eq 'OK') {
         $self->log("Subscribe to ".$mailbox) unless $self->{quiet};
@@ -746,6 +747,7 @@ sub subscribe($$;$) {
 }
 sub unsubscribe($$;$) {
     my ($self, $mailbox, $try) = @_;
+    $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
     my $r = $self->_send("UNSUBSCRIBE ".quote($mailbox));
     if ($IMAP_cond eq 'OK') {
         $self->log("Unsubscribe to ".$mailbox) unless $self->{quiet};
@@ -834,6 +836,7 @@ sub append($$@) {
 
     # dump the cache before issuing the command if we're appending to the current mailbox
     my ($UIDNEXT, $EXISTS, $cache, %vanished);
+    $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
     if (defined $self->{_SELECTED} and $mailbox eq $self->{_SELECTED}) {
         $cache = $self->{_CACHE}->{$mailbox};
         $UIDNEXT = $cache->{UIDNEXT} // $self->panic();
@@ -973,6 +976,7 @@ sub slurp($) {
 sub set_cache($$%) {
     my $self = shift;
     my $mailbox = shift // $self->panic();
+    $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
     my $cache = $self->{_PCACHE}->{$mailbox} //= {};
 
     my %status = @_;
@@ -999,6 +1003,7 @@ sub uidvalidity($;$) {
     my $self = shift;
     my $mailbox = shift;
     if (defined $mailbox) {
+        $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
         my $cache = $self->{_CACHE}->{$mailbox} // return;
         return $cache->{UIDVALIDITY};
     }
@@ -1037,6 +1042,7 @@ sub get_cache($@) {
 #   internal cache is newer than its persistent cache.
 sub is_dirty($$) {
     my ($self, $mailbox) = @_;
+    $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
     my $cache = $self->{_CACHE}->{$mailbox}   // return 1;
     my $pcache = $self->{_PCACHE}->{$mailbox} // return 1;
 
@@ -1917,11 +1923,11 @@ sub _select_or_examine($$$;$$) {
     my $mailbox = shift;
     my ($seqs, $uids) = @_;
 
+    $mailbox = uc $mailbox eq 'INBOX' ? 'INBOX' : $mailbox; # INBOX is case-insensitive
     my $pcache = $self->{_PCACHE}->{$mailbox} //= {};
     my $cache = $self->{_CACHE}->{$mailbox} //= {};
     $cache->{UIDVALIDITY} = $pcache->{UIDVALIDITY} if defined $pcache->{UIDVALIDITY};
 
-    $mailbox = uc $mailbox eq 'INBOX' ? 'INBOX' : $mailbox; # INBOX is case-insensitive
     $command .= ' '.quote($mailbox);
     if ($self->_enabled('QRESYNC') and ($pcache->{HIGHESTMODSEQ} // 0) > 0 and ($pcache->{UIDNEXT} // 1) > 1) {
         $command .= " (QRESYNC ($pcache->{UIDVALIDITY} $pcache->{HIGHESTMODSEQ} "
-- 
cgit v1.2.3


From 84f0560ed8fb3002581b1bf96d7ea51b3136d72f Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Thu, 3 Mar 2016 22:03:48 +0100
Subject: Log and debug messages: don't prefix with a ':' for nameless clients.

---
 lib/Net/IMAP/InterIMAP.pm | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index c5b45aa..7af04e7 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -523,9 +523,10 @@ sub log($@) {
     return unless @_;
     $self->logger(@_) if defined $self->{'logger-fd'} and defined $self->{'logger-fd'}->fileno
         and $self->{'logger-fd'}->fileno != fileno STDERR;
-    my $prefix = defined $self->{name} ? $self->{name} : '';
+    my $prefix = $self->{name} // '';
     $prefix .= "($self->{_SELECTED})" if $self->{_STATE} eq 'SELECTED';
-    print STDERR $prefix, ': ', @_, "\n";
+    $prefix .= ': ' unless $prefix eq '';
+    print STDERR $prefix, @_, "\n";
 }
 sub logger($@) {
     my $self = shift;
@@ -536,9 +537,10 @@ sub logger($@) {
         my ($s, $us) = Time::HiRes::gettimeofday();
         $prefix = POSIX::strftime("%b %e %H:%M:%S", localtime($s)).".$us ";
     }
-    $prefix .= defined "$self->{name}" ? $self->{name} : '';
+    $prefix .= $self->{name} // '';
     $prefix .= "($self->{_SELECTED})" if $self->{_STATE} eq 'SELECTED';
-    $self->{'logger-fd'}->say($prefix, ': ', @_);
+    $prefix .= ': ' unless $prefix eq '';
+    $self->{'logger-fd'}->say($prefix, @_);
 }
 
 
-- 
cgit v1.2.3


From 1956ce125552752f61bbe8b578f00bd049b62512 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Thu, 3 Mar 2016 22:25:29 +0100
Subject: fix slurp(), useful for IDLE and NOTIFY.

---
 interimap                 |  2 +-
 lib/Net/IMAP/InterIMAP.pm | 31 +++++++++++++++----------------
 2 files changed, 16 insertions(+), 17 deletions(-)

diff --git a/interimap b/interimap
index 553586f..f8989dc 100755
--- a/interimap
+++ b/interimap
@@ -29,7 +29,7 @@ use DBI ();
 use List::Util 'first';
 
 use lib 'lib';
-use Net::IMAP::InterIMAP qw/read_config compact_set $IMAP_text $IMAP_cond/;
+use Net::IMAP::InterIMAP qw/read_config compact_set/;
 
 # Clean up PATH
 $ENV{PATH} = join ':', qw{/usr/local/bin /usr/bin /bin};
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 7af04e7..e3285de 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -22,7 +22,6 @@ use strict;
 
 use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
-use IO::Select ();
 use Net::SSLeay ();
 use List::Util qw/all first/;
 use POSIX ':signal_h';
@@ -933,31 +932,31 @@ sub notify($@) {
     my $command = 'NOTIFY ';
     $command .= @_ ? ('SET '. join(' ', map {"($_ ($events))"} @_)) : 'NONE';
     $self->_send($command);
-    $self->{_SEL_OUT} = IO::Select::->new($self->{STDOUT});
 }
 
 
-# $self->slurp()
+# $self->slurp([$cmd, $callback])
 #   See if the server has sent some unprocessed data; try to as many
 #   lines as possible, process them, and return the number of lines
 #   read.
 #   This is mostly useful when waiting for notifications while no
-#   command is progress, cf. RFC 5465 (NOTIFY).
-sub slurp($) {
-    my $self = shift;
-
+#   command is progress, cf. RFC 2177 (IDLE) or RFC 5465 (NOTIFY).
+sub slurp($;$$) {
+    my ($self, $cmd, $callback) = @_;
     my $ssl = $self->{_SSL};
     my $read = 0;
 
+    vec(my $rin, fileno($self->{STDOUT}), 1) = 1;
     while (1) {
-        # Unprocessed data within the current TLS record would cause
-        # select(2) to block/timeout due to the raw socket not being
-        # ready.
-        unless (defined $ssl and Net::SSLeay::pending($ssl) > 0) {
-            my ($ok) = $self->{_SEL_OUT}->can_read(0);
-            return $read unless defined $ok;
-        }
-        $self->_resp( $self->_getline() );
+        return $read unless
+            (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') or
+            # Unprocessed data within the current TLS record would cause
+            # select(2) to block/timeout due to the raw socket not being
+            # ready.
+            (defined $ssl and Net::SSLeay::pending($ssl) > 0) or
+            select($rin, undef, undef, 0) > 0;
+        my $x = $self->_getline();
+        $self->_resp($x, $cmd, undef, $callback);
         $read++;
     }
 }
@@ -2111,7 +2110,7 @@ sub _envelope($$) {
     return \@envelope;
 }
 
-# $self->_resp($buf, [$cmd, $callback] )
+# $self->_resp($buf, [$cmd, $set, $callback] )
 #   Parse an untagged response line or a continuation request line.
 #   (The trailing CRLF must be removed.)  The internal cache is
 #   automatically updated when needed.
-- 
cgit v1.2.3


From 91eb4650581ac424cc7153ed6dc47be6563182f4 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Thu, 3 Mar 2016 22:26:33 +0100
Subject: Don't modify the state when receiving an unsolicited FETCH response
 without UID

We require QRESYNC support (RFC 7162) for syncing, which requires UID
(MODSEQ) in unsolicited FETCH responses, cf RFC 7162 section 3.2.4.
---
 lib/Net/IMAP/InterIMAP.pm | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index e3285de..0405794 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -2212,16 +2212,18 @@ sub _resp($$;$$$) {
                 undef $first;
             }
 
-            my $uid = $mail{UID} // $self->panic(); # sanity check
             $self->panic() unless defined $mail{MODSEQ} or !$self->_enabled('QRESYNC'); # sanity check
+            my $uid = $mail{UID};
 
             if (!exists $mail{RFC822} and !exists $mail{ENVELOPE} and # ignore new mails
+                defined $uid and # /!\ ignore unsolicited FETCH responses without UID, cf RFC 7162 section 3.2.4
                 (!exists $self->{_MODIFIED}->{$uid} or $self->{_MODIFIED}->{$uid}->[0] < $mail{MODSEQ} or
                     ($self->{_MODIFIED}->{$uid}->[0] == $mail{MODSEQ} and !defined $self->{_MODIFIED}->{$uid}->[1]))) {
                 my $flags = join ' ', sort(grep {lc $_ ne '\recent'} @{$mail{FLAGS}}) if defined $mail{FLAGS};
                 $self->{_MODIFIED}->{$uid} = [ $mail{MODSEQ}, $flags ];
             }
-            $callback->(\%mail) if defined $callback and ($cmd eq 'FETCH' or $cmd eq 'STORE') and in_set($uid, $set);
+            $callback->(\%mail) if defined $callback and ($cmd eq 'FETCH' or $cmd eq 'STORE') and
+                                   defined $uid and in_set($uid, $set);
         }
         elsif (/\AENABLED((?: $RE_ATOM_CHAR+)+)\z/) { # RFC 5161 ENABLE
             $self->{_ENABLED} //= [];
-- 
cgit v1.2.3


From 48ddc7416f1934b6569ada559c3473de6cf6e4b8 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Thu, 3 Mar 2016 22:28:46 +0100
Subject: Relax parsing of continuation requests for for empty resp-text.

microsoft's IMAP server violates RFC 3501 by skipping the trailing space
for empty resp-text.
---
 lib/Net/IMAP/InterIMAP.pm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 0405794..745e64f 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -2249,7 +2249,8 @@ sub _resp($$;$$$) {
             }
         }
     }
-    elsif (s/\A\+ //) {
+    elsif (s/\A\+// and ($_ eq '' or s/\A //)) {
+        # microsoft's IMAP server violates RFC 3501 by skipping the trailing ' ' for empty resp-text
         if (defined $callback and $cmd eq 'AUTHENTICATE') {
             my $x = $callback->($_);
             $self->_cmd_extend(\$x);
-- 
cgit v1.2.3


From 26abdf32dcc49404729c1cd36f8c13b2d49d6c7f Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Thu, 3 Mar 2016 22:32:41 +0100
Subject: Remove dependency on IO::Select.

---
 INSTALL | 1 -
 1 file changed, 1 deletion(-)

diff --git a/INSTALL b/INSTALL
index 3b07841..458b7c2 100644
--- a/INSTALL
+++ b/INSTALL
@@ -7,7 +7,6 @@ InterIMAP depends on the following Perl modules:
   - Errno (core module)
   - Getopt::Long (core module)
   - MIME::Base64 (core module) if authentication is required
-  - IO::Select (core module)
   - List::Util (core module)
   - Net::SSLeay
   - POSIX (core module)
-- 
cgit v1.2.3


From 7e4d373d1fd60eeddf641458cc4bec115d3b5ecf Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Fri, 4 Mar 2016 11:50:00 +0100
Subject: Inspect the select(2) syscall's return value.

---
 lib/Net/IMAP/InterIMAP.pm | 18 +++++++++++-------
 1 file changed, 11 insertions(+), 7 deletions(-)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 745e64f..3957020 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -22,6 +22,7 @@ use strict;
 
 use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
+use Errno 'EINTR';
 use Net::SSLeay ();
 use List::Util qw/all first/;
 use POSIX ':signal_h';
@@ -948,13 +949,16 @@ sub slurp($;$$) {
 
     vec(my $rin, fileno($self->{STDOUT}), 1) = 1;
     while (1) {
-        return $read unless
-            (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') or
-            # Unprocessed data within the current TLS record would cause
-            # select(2) to block/timeout due to the raw socket not being
-            # ready.
-            (defined $ssl and Net::SSLeay::pending($ssl) > 0) or
-            select($rin, undef, undef, 0) > 0;
+        unless ((defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') or
+                # Unprocessed data within the current TLS record would
+                # cause select(2) to block/timeout due to the raw socket
+                # not being ready.
+                (defined $ssl and Net::SSLeay::pending($ssl) > 0)) {
+            my $r = CORE::select($rin, undef, undef, 0);
+            next if $r == -1 and $! == EINTR; # select(2) was interrupted
+            $self->panic("Can't select: $!") if $r == -1;
+            return $read if $r == 0; # nothing more to read
+        }
         my $x = $self->_getline();
         $self->_resp($x, $cmd, undef, $callback);
         $read++;
-- 
cgit v1.2.3


From e9e360cbe894b5674a3ffe433e5d727cf8368715 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 5 Mar 2016 15:31:36 +0100
Subject: pullimap (IMAP part only)

---
 lib/Net/IMAP/InterIMAP.pm |  43 ++++++++----
 pullimap                  | 173 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 203 insertions(+), 13 deletions(-)
 create mode 100755 pullimap

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 3957020..7d6e468 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -1043,22 +1043,21 @@ sub get_cache($@) {
 
 
 # $self->is_dirty($mailbox)
-#   Return true if there are pending updates for $mailbox, i.e., its
-#   internal cache is newer than its persistent cache.
+#   Return true if there are pending updates for $mailbox, i.e., if its
+#   internal cache's HIGHESTMODSEQ or UIDNEXT values differ from its
+#   persistent cache's values.
 sub is_dirty($$) {
     my ($self, $mailbox) = @_;
-    $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
-    my $cache = $self->{_CACHE}->{$mailbox}   // return 1;
-    my $pcache = $self->{_PCACHE}->{$mailbox} // return 1;
+    $self->_updated_cache($mailbox, qw/HIGHESTMODSEQ UIDNEXT/);
+}
 
-    if (defined $pcache->{HIGHESTMODSEQ} and defined $cache->{HIGHESTMODSEQ}
-            and $pcache->{HIGHESTMODSEQ} == $cache->{HIGHESTMODSEQ} and
-        defined $pcache->{UIDNEXT} and defined $cache->{UIDNEXT}
-            and $pcache->{UIDNEXT} == $cache->{UIDNEXT}) {
-        return 0
-    } else {
-        return 1
-    }
+
+# $self->has_new_mails($mailbox)
+#   Return true if there are new messages in $mailbox, i.e., if its
+#   internal cache's UIDNEXT value differs from its persistent cache's.
+sub has_new_mails($$) {
+    my ($self, $mailbox) = @_;
+    $self->_updated_cache($mailbox, 'UIDNEXT');
 }
 
 
@@ -1661,6 +1660,24 @@ sub _update_cache_for($$%) {
 }
 
 
+# $self->_updated_cache($mailbox)
+#   Return true if there are pending updates for $mailbox, i.e., if one
+#   of its internal cache's @attrs value differs from the persistent
+#   cache's value.
+sub _updated_cache($$@) {
+    my ($self, $mailbox, @attrs) = @_;
+    $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
+    my $cache  = $self->{_CACHE}->{$mailbox}  // return 1;
+    my $pcache = $self->{_PCACHE}->{$mailbox} // return 1;
+
+    foreach (@attrs) {
+        return 1 unless $pcache->{$_} and defined $cache->{$_} and
+                        $pcache->{$_} == $cache->{$_};
+    }
+    return 0;
+}
+
+
 # $self->_cmd_init($command)
 #   Generate a new tag for the given $command, push both the
 #   concatenation to the command buffer.  $command can be a scalar or a
diff --git a/pullimap b/pullimap
new file mode 100755
index 0000000..d1a2f4a
--- /dev/null
+++ b/pullimap
@@ -0,0 +1,173 @@
+#!/usr/bin/perl -T
+
+#----------------------------------------------------------------------
+# Pull mails from an IMAP mailbox and deliver them to an SMTP session
+# Copyright © 2016 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
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+#----------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+our $VERSION = '0.3';
+my $NAME = 'pullimap';
+
+use Fcntl qw/O_CREAT O_RDWR O_DSYNC LOCK_EX SEEK_SET/;
+use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
+use List::Util 'first';
+
+use lib 'lib';
+use Net::IMAP::InterIMAP 'read_config';
+
+my %CONFIG;
+sub usage(;$) {
+    my $rv = shift // 0;
+    if ($rv) {
+        print STDERR "Usage: $NAME [OPTIONS] SECTION\n"
+                    ."Try '$NAME --help' or consult the manpage for more information.\n";
+    }
+    else {
+        print STDERR "Usage: $NAME [OPTIONS] SECTION\n"
+                    ."Consult the manpage for more information.\n";
+    }
+    exit $rv;
+}
+
+usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug help|h/);
+usage(0) if $CONFIG{help};
+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/
+                      )->{$ARGV[0]};
+
+my ($MAILBOX, $STATE, $LOGGER_FD);
+do {
+    $MAILBOX = $CONF->{mailbox} // 'INBOX';
+
+    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";
+        }
+    }
+
+    sysopen($STATE, $statefile, O_CREAT|O_RDWR|O_DSYNC, 0600) or die "Can't open $statefile: $!";
+    flock($STATE, LOCK_EX) or die "Can't flock $statefile: $!";
+
+
+    if (defined (my $logfile = $CONF->{logfile})) {
+        require 'POSIX.pm';
+        require 'Time/HiRes.pm';
+        open $LOGGER_FD, '>>', $logfile or die "Can't open $logfile: $!\n";
+        $LOGGER_FD->autoflush(1);
+    }
+    elsif ($CONFIG{debug}) {
+        $LOGGER_FD = \*STDERR;
+    }
+};
+
+
+#######################################################################
+
+# Read a UID (32-bits integer) from the statefile, or undef if we're at
+# the end of the statefile
+sub readUID() {
+    my $n = sysread($STATE, my $buf, 4) // die "Can't sysread: $!";
+    return if $n == 0; # EOF
+    # file length is a multiple of 4 bytes, and we always read 4 bytes at a time
+    die "Corrupted state file!" if $n != 4;
+    unpack('N', $buf);
+}
+
+# Write a UID (32-bits integer) to the statefile
+sub writeUID($) {
+    my $uid = pack('N', shift);
+    my $offset = 0;
+    for ( my $offset = 0
+        ; $offset < 4
+        ; $offset += syswrite($STATE, $uid, 4-$offset, $offset) // die "Can't syswrite: $!"
+    ) {}
+}
+
+
+#######################################################################
+# Initialize the cache from the statefile, then pull new messages from
+# the remote mailbox
+#
+my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/}, 'logger-fd' => $LOGGER_FD );
+do {
+    my $uidvalidity = readUID();
+    my $uidnext = readUID();
+    my @ignore;
+
+    $IMAP->set_cache($MAILBOX, UIDVALIDITY => $uidvalidity, UIDNEXT => $uidnext);
+    $IMAP->select($MAILBOX);
+
+    unless (defined $uidvalidity) {
+        ($uidvalidity) = $IMAP->get_cache('UIDVALIDITY');
+        # we were at pos 0 before the write, at pos 4 afterwards
+        writeUID($uidvalidity);
+        die if defined $uidnext; # sanity check
+    }
+
+    if (!defined $uidnext) {
+        # we were at pos 4 before the write, at pos 8 afterwards
+        writeUID(1);
+    }
+    else {
+        while (defined (my $uid = readUID())) {
+            push @ignore, $uid;
+        }
+    }
+
+    my $attrs = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/;
+    my @uid;
+
+    # invariant: we're at pos 8 + 4*(1+$#ignore + 1+$#uids)
+    $IMAP->pull_new_messages($attrs, sub($) {
+        my $mail = shift;
+        return unless exists $mail->{RFC822}; # not for us
+    
+        my $uid = $mail->{UID};
+        my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4];
+        $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
+        print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
+
+        # TODO sendmail
+        push @uid, $uid;
+        writeUID($uid);
+    }, @ignore);
+
+    # TODO mark (@ignore, @uid) as seen
+
+    # update the statefile
+    sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!";
+    ($uidnext) = $IMAP->get_cache('UIDNEXT');
+    writeUID($uidnext);
+    truncate($STATE, 8) // die "Can't truncate";
+};
-- 
cgit v1.2.3


From 56e27b9e4c27fe037695515c8afa84fd8a31cf6d Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 5 Mar 2016 15:52:27 +0100
Subject: pullimap: mark downloaded messages as \Seen

---
 interimap                 |  4 ++--
 lib/Net/IMAP/InterIMAP.pm | 17 +++++++++++++++--
 pullimap                  | 10 ++++++++--
 3 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/interimap b/interimap
index f8989dc..b377d4e 100755
--- a/interimap
+++ b/interimap
@@ -2,7 +2,7 @@
 
 #----------------------------------------------------------------------
 # Fast bidirectional synchronization for QRESYNC-capable IMAP servers
-# Copyright © 2015 Guilhem Moulin <guilhem@fripost.org>
+# Copyright © 2015,2016 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
@@ -65,12 +65,12 @@ usage(1) if defined $COMMAND and defined $CONFIG{watch};
 usage(1) if $CONFIG{target} and !(defined $COMMAND and ($COMMAND eq 'delete'or $COMMAND eq 'rename'));
 $CONFIG{watch} = 60 if defined $CONFIG{watch} and $CONFIG{watch} == 0;
 @ARGV = map {uc $_ eq 'INBOX' ? 'INBOX' : $_ } @ARGV; # INBOX is case-insensitive
+die "Invalid mailbox name $_" foreach grep !/\A([\x01-\x7F]+)\z/, @ARGV;
 
 
 my $CONF = read_config( delete $CONFIG{config} // $NAME
                       , [qw/_ local remote/]
                       , database => qr/\A(\P{Control}+)\z/
-                      , logfile => qr/\A(\/\P{Control}+)\z/
                       , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/
                       , 'list-select-opts' => qr/\A([\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]+)\z/
                       , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 7d6e468..15682b3 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -58,6 +58,7 @@ my %OPTIONS = (
     command => qr/\A(\P{Control}+)\z/,
     'null-stderr' => qr/\A(YES|NO)\z/i,
     compress => qr/\A($RE_ATOM_CHAR+(?: $RE_ATOM_CHAR+)*)\z/,
+    logfile => qr/\A(\/\P{Control}+)\z/,
     SSL_protocols => qr/\A(!?$RE_SSL_PROTO(?: !?$RE_SSL_PROTO)*)\z/,
     SSL_fingerprint => qr/\A((?:[A-Za-z0-9]+\$)?\p{AHex}+)\z/,
     SSL_cipherlist => qr/\A(\P{Control}+)\z/,
@@ -535,9 +536,10 @@ sub logger($@) {
     if (defined $self->{'logger-fd'}->fileno and defined $self->{'logger-fd'}->fileno
             and $self->{'logger-fd'}->fileno != fileno STDERR) {
         my ($s, $us) = Time::HiRes::gettimeofday();
-        $prefix = POSIX::strftime("%b %e %H:%M:%S", localtime($s)).".$us ";
+        $prefix = POSIX::strftime("%b %e %H:%M:%S", localtime($s)).".$us";
+        $prefix .= ' ' if defined $self->{name} or $self->{_STATE} eq 'SELECTED';
     }
-    $prefix .= $self->{name} // '';
+    $prefix .= $self->{name} if defined $self->{name};
     $prefix .= "($self->{_SELECTED})" if $self->{_STATE} eq 'SELECTED';
     $prefix .= ': ' unless $prefix eq '';
     $self->{'logger-fd'}->say($prefix, @_);
@@ -1255,6 +1257,17 @@ sub push_flag_updates($$@) {
 }
 
 
+# $self->silent_store($set, $mod, @flags)
+#   Set / Add / Update the flags list on the UID $set.
+#   /!\ there is no check that messages flags been set!
+sub silent_store($$$@) {
+    my $self = shift;
+    my $set = shift;
+    my $mod = shift;
+    $self->_send("UID STORE $set ${mod}FLAGS.SILENT (".join(' ', @_).")");
+}
+
+
 #############################################################################
 # Private methods
 
diff --git a/pullimap b/pullimap
index d1a2f4a..e79e644 100755
--- a/pullimap
+++ b/pullimap
@@ -29,7 +29,7 @@ use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version
 use List::Util 'first';
 
 use lib 'lib';
-use Net::IMAP::InterIMAP 'read_config';
+use Net::IMAP::InterIMAP qw/read_config compact_set/;
 
 my %CONFIG;
 sub usage(;$) {
@@ -140,11 +140,16 @@ do {
         writeUID(1);
     }
     else {
+        # put the remaining UIDs in the @ignore list: these messages
+        # have already been delivered, but the process exited before the
+        # statefile was updated
         while (defined (my $uid = readUID())) {
             push @ignore, $uid;
         }
     }
 
+    # use BODY.PEEK[] so if something gets wrong, unpulled messages
+    # won't be marked as \Seen in the mailbox
     my $attrs = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/;
     my @uid;
 
@@ -163,7 +168,8 @@ do {
         writeUID($uid);
     }, @ignore);
 
-    # TODO mark (@ignore, @uid) as seen
+    # now that everything has been deliverd, mark @ignore and @uid as \Seen
+    $IMAP->silent_store(compact_set(@ignore, @uid), '+', '\Seen') if @ignore or @uid;
 
     # update the statefile
     sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!";
-- 
cgit v1.2.3


From 9975975bda94fc1ccfe898ea23a0b018c5492353 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 5 Mar 2016 17:57:08 +0100
Subject: pullimap: add sendmail feature (SMTP/LMTP client).

---
 pullimap | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 91 insertions(+), 1 deletion(-)

diff --git a/pullimap b/pullimap
index e79e644..ba48f19 100755
--- a/pullimap
+++ b/pullimap
@@ -24,9 +24,11 @@ use warnings;
 our $VERSION = '0.3';
 my $NAME = 'pullimap';
 
+use Errno 'EINTR';
 use Fcntl qw/O_CREAT O_RDWR O_DSYNC LOCK_EX SEEK_SET/;
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
 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/;
@@ -57,6 +59,9 @@ 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/
                       )->{$ARGV[0]};
 
 my ($MAILBOX, $STATE, $LOGGER_FD);
@@ -115,6 +120,90 @@ sub writeUID($) {
 }
 
 
+#######################################################################
+# SMTP/LMTP part
+#
+my $SMTP;
+sub sendmail($$) {
+    my ($from, $rfc822) = @_;
+    unless (defined $SMTP) {
+        # XXX we can be logged out while connected, so we need to be able to reconnect
+        my ($fam, $addr, $port) = (PF_INET, $CONF->{'deliver-method'}, 25);
+        $addr =~ s/^([ls]mtp):// or die;
+        my $ehlo = $1 eq 'lmtp' ? 'LHO' : $1 eq 'smtp' ? 'EHLO' : die;
+        $ehlo .= ' '. ($CONF->{'deliver-ehlo'} // 'localhost.localdomain');
+
+        $port = $1 if $addr =~ s/:(\d+)$//;
+        $addr =~ s/^\[(.*)\]$/$1/ or die;
+        $fam = PF_INET6 if $addr =~ /:/;
+        $addr = Socket::inet_pton($fam, $addr) // die "Invalid address $addr\n";
+        my $sockaddr = $fam == PF_INET  ? Socket::pack_sockaddr_in($port,  $addr)
+                     : $fam == PF_INET6 ? Socket::pack_sockaddr_in6($port, $addr)
+                     : die;
+
+        my $proto = getprotobyname("tcp") // die;
+        socket($SMTP, $fam, SOCK_STREAM, $proto) or die "socket: $!";
+        until (connect($SMTP, $sockaddr)) {
+            next if $! == EINTR; # try again if connect(2) was interrupted by a signal
+            die "connect: $!";
+        }
+
+        smtp_resp('220');
+        smtp_send1($ehlo, '250');
+    }
+    my $rcpt = $CONF->{'deliver-rcpt'} // getpwuid($>) // die;
+
+    # TODO SMTP pipelining (RFC 2920)
+
+    # return codes are from RFC 5321 section 4.3.2
+    smtp_send1("MAIL FROM:<$from>", '250');
+    smtp_send1("RCPT TO:<$rcpt>", '250');
+    smtp_send1("DATA", '354');
+    print STDERR "C: [...]\n" if $CONFIG{debug};
+
+    if ($$rfc822 eq '') {
+        # RFC 5321 section 4.1.1.4: if there was no mail data, the first
+        # "\r\n" ends the DATA command itself
+        $SMTP->printflush("\r\n.\r\n");
+    } else {
+        my $offset = 0;
+        my $length = length($$rfc822);
+        while ((my $end = index($$rfc822, "\r\n", $offset) + 2) != 1) {
+            my $line = substr($$rfc822, $offset, $end-$offset);
+            # RFC 5321 section 4.5.2: the character sequence "\r\n.\r\n"
+            # ends the mail text and cannot be sent by the user
+            $SMTP->print($line eq ".\r\n" ? "..\r\n" : $line);
+            $offset = $end;
+        }
+        if ($offset < $length) {
+            # the last line did not end with "\r\n"; add it in order to
+            # have the receiving SMTP server recognize the "end of data"
+            # condition.  See RFC 5321 section 4.1.1.4
+            my $line = substr($$rfc822, $offset);
+            $SMTP->print(($line eq "." ? ".." : $line), "\r\n");
+        }
+        $SMTP->printflush(".\r\n");
+    }
+    smtp_resp('250');
+}
+sub smtp_send1($$) {
+    my ($cmd, $code) = @_;
+    print STDERR "C: $cmd\n" if $CONFIG{debug};
+    $SMTP->printflush($cmd, "\r\n");
+    smtp_resp($code);
+}
+sub smtp_resp($) {
+    my $code = shift;
+    while(1) {
+        local $_ = $SMTP->getline() // die;
+        s/\r\n\z// or die "Invalid SMTP reply: $_";
+        print STDERR "S: $_\n" if $CONFIG{debug};
+        /\A\Q$code\E([ -])/ or die "SMTP error: Expected $code, got: $_\n";
+        return if $1 eq ' ';
+    }
+}
+
+
 #######################################################################
 # Initialize the cache from the statefile, then pull new messages from
 # the remote mailbox
@@ -163,7 +252,8 @@ do {
         $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
         print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
 
-        # TODO sendmail
+        sendmail($from, $mail->{RFC822});
+
         push @uid, $uid;
         writeUID($uid);
     }, @ignore);
-- 
cgit v1.2.3


From 836fd409e942eb715198198caacac1e64f997365 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 5 Mar 2016 18:15:25 +0100
Subject: pullimap: add support for SMTP pipelining (RFC 2920)

---
 pullimap | 48 ++++++++++++++++++++++++++++++++----------------
 1 file changed, 32 insertions(+), 16 deletions(-)

diff --git a/pullimap b/pullimap
index ba48f19..f9b9d0d 100755
--- a/pullimap
+++ b/pullimap
@@ -123,7 +123,7 @@ sub writeUID($) {
 #######################################################################
 # SMTP/LMTP part
 #
-my $SMTP;
+my ($SMTP, $SMTP_PIPELINING);
 sub sendmail($$) {
     my ($from, $rfc822) = @_;
     unless (defined $SMTP) {
@@ -149,18 +149,18 @@ sub sendmail($$) {
         }
 
         smtp_resp('220');
-        smtp_send1($ehlo, '250');
+        my @r = smtp_send($ehlo => '250');
+        $SMTP_PIPELINING = grep {$_ eq 'PIPELINING'} @r; # SMTP pipelining (RFC 2920)
     }
     my $rcpt = $CONF->{'deliver-rcpt'} // getpwuid($>) // die;
 
-    # TODO SMTP pipelining (RFC 2920)
-
     # return codes are from RFC 5321 section 4.3.2
-    smtp_send1("MAIL FROM:<$from>", '250');
-    smtp_send1("RCPT TO:<$rcpt>", '250');
-    smtp_send1("DATA", '354');
-    print STDERR "C: [...]\n" if $CONFIG{debug};
+    smtp_send( "MAIL FROM:<$from>" => '250'
+             , "RCPT TO:<$rcpt>"   => '250'
+             , "DATA"              => '354'
+             );
 
+    print STDERR "C: [...]\n" if $CONFIG{debug};
     if ($$rfc822 eq '') {
         # RFC 5321 section 4.1.1.4: if there was no mail data, the first
         # "\r\n" ends the DATA command itself
@@ -186,21 +186,37 @@ sub sendmail($$) {
     }
     smtp_resp('250');
 }
-sub smtp_send1($$) {
-    my ($cmd, $code) = @_;
-    print STDERR "C: $cmd\n" if $CONFIG{debug};
-    $SMTP->printflush($cmd, "\r\n");
-    smtp_resp($code);
-}
 sub smtp_resp($) {
     my $code = shift;
+    my @resp;
     while(1) {
         local $_ = $SMTP->getline() // die;
         s/\r\n\z// or die "Invalid SMTP reply: $_";
         print STDERR "S: $_\n" if $CONFIG{debug};
-        /\A\Q$code\E([ -])/ or die "SMTP error: Expected $code, got: $_\n";
-        return if $1 eq ' ';
+        s/\A\Q$code\E([ -])// or die "SMTP error: Expected $code, got: $_\n";
+        push @resp, $_;
+        return @resp if $1 eq ' ';
+    }
+}
+sub smtp_send(@) {
+    my (@cmd, @code, @r);
+    while (@_) {
+        push @cmd,  shift // die;
+        push @code, shift // die;
+    }
+    if ($SMTP_PIPELINING) { # SMTP pipelining (RFC 2920)
+        print STDERR join('', map {"C: $_\n"} @cmd) if $CONFIG{debug};
+        $SMTP->printflush(join('', map {"$_\r\n"} @cmd));
+        @r = smtp_resp($_) foreach @code;
+    }
+    else {
+        foreach (@cmd) {
+            print STDERR "C: $_\n" if $CONFIG{debug};
+            $SMTP->printflush("$_\r\n");
+            @r = smtp_resp(shift(@code));
+        }
     }
+    return @r;
 }
 
 
-- 
cgit v1.2.3


From e51c8899d67e5d86a868e1adced55a6c72113daa Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 5 Mar 2016 18:36:07 +0100
Subject: pullimap: add support for IMAP IDLE (RFC 2177).

---
 lib/Net/IMAP/InterIMAP.pm | 30 ++++++++++++++++++
 pullimap                  | 81 ++++++++++++++++++++++++++++-------------------
 2 files changed, 78 insertions(+), 33 deletions(-)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 15682b3..2898905 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -968,6 +968,35 @@ sub slurp($;$$) {
 }
 
 
+# $self->idle([$timeout, $stopwhen])
+#   Enter IDLE (RFC 2177) for $timout seconds (by default 29 mins), or
+#   when the callback $stopwhen returns true.
+#   Return false if the timeout was reached, and true if IDLE was
+#   stopped due the callback.
+sub idle($$$) {
+    my ($self, $timeout, $stopwhen) = @_;
+    $timeout //= 1740; # 29 mins
+
+    $self->fail("Server did not advertise IDLE (RFC 2177) capability.")
+        unless $self->_capable('IDLE');
+
+    my $tag = $self->_cmd_init('IDLE');
+    $self->_cmd_flush();
+
+    for (; $timeout > 0; $timeout--) {
+        $self->slurp('IDLE', sub() {$timeout = -1 if $stopwhen->()});
+        sleep 1 if $timeout > 0;
+    }
+
+    # done idling
+    $self->_cmd_extend('DONE');
+    $self->_cmd_flush();
+    $self->_recv($tag);
+
+    return $timeout < 0 ? 1 : 0;
+}
+
+
 # $self->set_cache( $mailbox, STATE )
 #   Initialize or update the persistent cache, that is, associate a
 #   known $mailbox with the last known (synced) state:
@@ -2294,6 +2323,7 @@ sub _resp($$;$$$) {
     else {
         $self->panic("Unexpected response: ", $_);
     }
+    $callback->() if defined $callback and $cmd eq 'IDLE';
 }
 
 
diff --git a/pullimap b/pullimap
index f9b9d0d..2c9b45d 100755
--- a/pullimap
+++ b/pullimap
@@ -47,7 +47,7 @@ sub usage(;$) {
     exit $rv;
 }
 
-usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug help|h/);
+usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug help|h idle:i/);
 usage(0) if $CONFIG{help};
 usage(1) unless $#ARGV == 0 and $ARGV[0] ne '_';
 
@@ -225,10 +225,47 @@ sub smtp_send(@) {
 # the remote mailbox
 #
 my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/}, 'logger-fd' => $LOGGER_FD );
+
+# use BODY.PEEK[] so if something gets wrong, unpulled messages
+# won't be marked as \Seen in the mailbox
+my $ATTRS = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/;
+
+# Pull new messages from IMAP and deliver them to SMTP, then update the
+# statefile
+sub pull(;$) {
+    my $ignore = shift // [];
+    my @uid;
+
+    # invariant: we're at pos 8 + 4*(1+$#ignore + 1+$#uids) in the statefile
+    $IMAP->pull_new_messages($ATTRS, sub($) {
+        my $mail = shift;
+        return unless exists $mail->{RFC822}; # not for us
+
+        my $uid = $mail->{UID};
+        my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4];
+        $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
+        print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
+
+        sendmail($from, $mail->{RFC822});
+
+        push @uid, $uid;
+        writeUID($uid);
+    }, @$ignore);
+
+    # now that everything has been deliverd, mark @ignore and @uid as \Seen
+    $IMAP->silent_store(compact_set(@$ignore, @uid), '+', '\Seen') if @$ignore or @uid;
+
+    # update the statefile
+    sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!";
+    my ($uidnext) = $IMAP->get_cache('UIDNEXT');
+    writeUID($uidnext);
+    truncate($STATE, 8) // die "Can't truncate";
+}
+
 do {
     my $uidvalidity = readUID();
     my $uidnext = readUID();
-    my @ignore;
+    my $ignore = [];
 
     $IMAP->set_cache($MAILBOX, UIDVALIDITY => $uidvalidity, UIDNEXT => $uidnext);
     $IMAP->select($MAILBOX);
@@ -249,37 +286,15 @@ do {
         # have already been delivered, but the process exited before the
         # statefile was updated
         while (defined (my $uid = readUID())) {
-            push @ignore, $uid;
+            push @$ignore, $uid;
         }
     }
-
-    # use BODY.PEEK[] so if something gets wrong, unpulled messages
-    # won't be marked as \Seen in the mailbox
-    my $attrs = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/;
-    my @uid;
-
-    # invariant: we're at pos 8 + 4*(1+$#ignore + 1+$#uids)
-    $IMAP->pull_new_messages($attrs, sub($) {
-        my $mail = shift;
-        return unless exists $mail->{RFC822}; # not for us
-    
-        my $uid = $mail->{UID};
-        my $from = first { defined $_ and @$_ } @{$mail->{ENVELOPE}}[2,3,4];
-        $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
-        print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
-
-        sendmail($from, $mail->{RFC822});
-
-        push @uid, $uid;
-        writeUID($uid);
-    }, @ignore);
-
-    # now that everything has been deliverd, mark @ignore and @uid as \Seen
-    $IMAP->silent_store(compact_set(@ignore, @uid), '+', '\Seen') if @ignore or @uid;
-
-    # update the statefile
-    sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!";
-    ($uidnext) = $IMAP->get_cache('UIDNEXT');
-    writeUID($uidnext);
-    truncate($STATE, 8) // die "Can't truncate";
+    pull($ignore);
 };
+exit 0 unless defined $CONFIG{idle};
+
+$CONFIG{idle} = 1740 if defined $CONFIG{idle} and $CONFIG{idle} == 0; # 29 mins
+while(1) {
+    my $r = $IMAP->idle($CONFIG{idle}, sub() { $IMAP->has_new_mails($MAILBOX) });
+    pull() if $r;
+}
-- 
cgit v1.2.3


From 0c21fadd7683629c50d1068106b17e9ac1addc62 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 5 Mar 2016 19:36:20 +0100
Subject: Terminate the SMTP transmission channel gracefully.

---
 pullimap | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/pullimap b/pullimap
index 2c9b45d..40f7f6f 100755
--- a/pullimap
+++ b/pullimap
@@ -127,7 +127,8 @@ my ($SMTP, $SMTP_PIPELINING);
 sub sendmail($$) {
     my ($from, $rfc822) = @_;
     unless (defined $SMTP) {
-        # XXX we can be logged out while connected, so we need to be able to reconnect
+        # TODO we need to be able to reconnect when the server closes
+        # the connection due to a timeout (RFC 5321 section 4.5.3.2)
         my ($fam, $addr, $port) = (PF_INET, $CONF->{'deliver-method'}, 25);
         $addr =~ s/^([ls]mtp):// or die;
         my $ehlo = $1 eq 'lmtp' ? 'LHO' : $1 eq 'smtp' ? 'EHLO' : die;
@@ -252,6 +253,10 @@ sub pull(;$) {
         writeUID($uid);
     }, @$ignore);
 
+    # terminate the transmission channel gracefully, cf RFC 5321 section 4.5.3.2
+    smtp_send('QUIT' => '221') if defined $SMTP;
+    undef $SMTP;
+
     # now that everything has been deliverd, mark @ignore and @uid as \Seen
     $IMAP->silent_store(compact_set(@$ignore, @uid), '+', '\Seen') if @$ignore or @uid;
 
-- 
cgit v1.2.3


From 76be3c7c47ace843ab3ebd216252c63411a1222e Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 5 Mar 2016 19:49:08 +0100
Subject: Ensure the FD_CLOEXEC bit is 1 on sockets, logger and state files.

---
 interimap                 | 3 +++
 lib/Net/IMAP/InterIMAP.pm | 9 ++++++++-
 pullimap                  | 9 +++++++--
 3 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/interimap b/interimap
index b377d4e..76174ee 100755
--- a/interimap
+++ b/interimap
@@ -26,6 +26,7 @@ my $NAME = 'interimap';
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat
                             bundling auto_version/;
 use DBI ();
+use Fcntl qw/F_GETFL F_SETFL FD_CLOEXEC/;
 use List::Util 'first';
 
 use lib 'lib';
@@ -101,6 +102,8 @@ my ($DBFILE, $LOCKFILE, $LOGGER_FD);
         open $LOGGER_FD, '>>', $CONF->{_}->{logfile}
             or die "Can't open $CONF->{_}->{logfile}: $!\n";
         $LOGGER_FD->autoflush(1);
+        my $flags = fcntl($LOGGER_FD, F_GETFL, 0)       or die "fcntl F_GETFL: $!";
+        fcntl($LOGGER_FD, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!";
     }
     elsif ($CONFIG{debug}) {
         $LOGGER_FD = \*STDERR;
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 2898905..40f4193 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -23,6 +23,7 @@ use strict;
 use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
 use Errno 'EINTR';
+use Fcntl qw/F_GETFL F_SETFL FD_CLOEXEC/;
 use Net::SSLeay ();
 use List::Util qw/all first/;
 use POSIX ':signal_h';
@@ -1354,7 +1355,13 @@ sub _tcp_connect($$$) {
 
     foreach my $ai (@res) {
         socket my $s, $ai->{family}, $ai->{socktype}, $ai->{protocol};
-        return $s if defined $s and connect($s, $ai->{addr});
+        # TODO: add a connection timeout
+        # http://devpit.org/wiki/Connect%28%29_with_timeout_%28in_Perl%29
+        if (defined $s and connect($s, $ai->{addr})) {
+            my $flags = fcntl($s, F_GETFL, 0)       or $self->panic("fcntl F_GETFL: $!");
+            fcntl($s, F_SETFL, $flags | FD_CLOEXEC) or $self->panic("fcntl F_SETFL: $!");
+            return $s;
+        }
     }
     $self->fail("Can't connect to $host:$port");
 }
diff --git a/pullimap b/pullimap
index 40f7f6f..12b2568 100755
--- a/pullimap
+++ b/pullimap
@@ -25,7 +25,7 @@ our $VERSION = '0.3';
 my $NAME = 'pullimap';
 
 use Errno 'EINTR';
-use Fcntl qw/O_CREAT O_RDWR O_DSYNC LOCK_EX SEEK_SET/;
+use Fcntl qw/O_CREAT O_RDWR O_DSYNC LOCK_EX SEEK_SET F_GETFL F_SETFL FD_CLOEXEC/;
 use Getopt::Long qw/:config posix_default no_ignore_case gnu_getopt auto_version/;
 use List::Util 'first';
 use Socket qw/PF_INET PF_INET6 SOCK_STREAM/;
@@ -82,6 +82,9 @@ do {
     }
 
     sysopen($STATE, $statefile, O_CREAT|O_RDWR|O_DSYNC, 0600) or die "Can't open $statefile: $!";
+    my $flags = fcntl($STATE, F_GETFL, 0)       or die "fcntl F_GETFL: $!";
+    fcntl($STATE, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!";
+
     flock($STATE, LOCK_EX) or die "Can't flock $statefile: $!";
 
 
@@ -90,6 +93,8 @@ do {
         require 'Time/HiRes.pm';
         open $LOGGER_FD, '>>', $logfile or die "Can't open $logfile: $!\n";
         $LOGGER_FD->autoflush(1);
+        my $flags = fcntl($LOGGER_FD, F_GETFL, 0)       or die "fcntl F_GETFL: $!";
+        fcntl($LOGGER_FD, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!";
     }
     elsif ($CONFIG{debug}) {
         $LOGGER_FD = \*STDERR;
@@ -253,7 +258,7 @@ sub pull(;$) {
         writeUID($uid);
     }, @$ignore);
 
-    # terminate the transmission channel gracefully, cf RFC 5321 section 4.5.3.2
+    # terminate the SMTP transmission channel gracefully, cf RFC 5321 section 4.5.3.2
     smtp_send('QUIT' => '221') if defined $SMTP;
     undef $SMTP;
 
-- 
cgit v1.2.3


From a3e21af7367cdd09e5260bcda90e79ae0ff00317 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Mon, 7 Mar 2016 11:40:38 +0100
Subject: typo

---
 lib/Net/IMAP/InterIMAP.pm | 2 +-
 pullimap                  | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 40f4193..0f674ac 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -1289,7 +1289,7 @@ sub push_flag_updates($$@) {
 
 # $self->silent_store($set, $mod, @flags)
 #   Set / Add / Update the flags list on the UID $set.
-#   /!\ there is no check that messages flags been set!
+#   /!\ There is no guaranty that message flags have been set!
 sub silent_store($$$@) {
     my $self = shift;
     my $set = shift;
diff --git a/pullimap b/pullimap
index 12b2568..2b81d8f 100755
--- a/pullimap
+++ b/pullimap
@@ -232,7 +232,7 @@ sub smtp_send(@) {
 #
 my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/}, 'logger-fd' => $LOGGER_FD );
 
-# use BODY.PEEK[] so if something gets wrong, unpulled messages
+# Use BODY.PEEK[] so if something gets wrong, unpulled messages
 # won't be marked as \Seen in the mailbox
 my $ATTRS = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/;
 
-- 
cgit v1.2.3


From 0955d3e95645b85fda791b2cef9c25684f7e1db4 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Mon, 7 Mar 2016 13:30:01 +0100
Subject: pullimap: add an option '--no-delivery' to prevent SMTP/LMTP
 delivery.

---
 pullimap | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/pullimap b/pullimap
index 2b81d8f..692ec38 100755
--- a/pullimap
+++ b/pullimap
@@ -47,7 +47,7 @@ sub usage(;$) {
     exit $rv;
 }
 
-usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug help|h idle:i/);
+usage(1) unless GetOptions(\%CONFIG, qw/config=s quiet|q debug help|h idle:i no-delivery/);
 usage(0) if $CONFIG{help};
 usage(1) unless $#ARGV == 0 and $ARGV[0] ne '_';
 
@@ -134,7 +134,7 @@ sub sendmail($$) {
     unless (defined $SMTP) {
         # TODO we need to be able to reconnect when the server closes
         # the connection due to a timeout (RFC 5321 section 4.5.3.2)
-        my ($fam, $addr, $port) = (PF_INET, $CONF->{'deliver-method'}, 25);
+        my ($fam, $addr, $port) = (PF_INET, $CONF->{'deliver-method'} // 'smtp:[127.0.0.1]:10024', 25);
         $addr =~ s/^([ls]mtp):// or die;
         my $ehlo = $1 eq 'lmtp' ? 'LHO' : $1 eq 'smtp' ? 'EHLO' : die;
         $ehlo .= ' '. ($CONF->{'deliver-ehlo'} // 'localhost.localdomain');
@@ -252,7 +252,7 @@ sub pull(;$) {
         $from = (defined $from and @$from) ? $from->[0]->[2].'@'.$from->[0]->[3] : '';
         print STDERR "($MAILBOX): UID $uid from <$from> ($mail->{INTERNALDATE})\n" unless $CONFIG{quiet};
 
-        sendmail($from, $mail->{RFC822});
+        sendmail($from, $mail->{RFC822}) unless $CONFIG{'no-delivery'};
 
         push @uid, $uid;
         writeUID($uid);
-- 
cgit v1.2.3


From 5d8b7a1bef1c1bb1a4efaeff9398f0ed81cb59b1 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Mon, 7 Mar 2016 13:32:13 +0100
Subject: pullimap: Remove "logfile" config option.

---
 interimap                 |  1 +
 lib/Net/IMAP/InterIMAP.pm |  1 -
 pullimap                  | 20 ++++----------------
 3 files changed, 5 insertions(+), 17 deletions(-)

diff --git a/interimap b/interimap
index 76174ee..d540686 100755
--- a/interimap
+++ b/interimap
@@ -72,6 +72,7 @@ die "Invalid mailbox name $_" foreach grep !/\A([\x01-\x7F]+)\z/, @ARGV;
 my $CONF = read_config( delete $CONFIG{config} // $NAME
                       , [qw/_ local remote/]
                       , database => qr/\A(\P{Control}+)\z/
+                      , logfile => qr/\A(\/\P{Control}+)\z/
                       , 'list-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/
                       , 'list-select-opts' => qr/\A([\x21\x23\x24\x26\x27\x2B-\x5B\x5E-\x7A\x7C-\x7E]+)\z/
                       , 'ignore-mailbox' => qr/\A([\x01-\x09\x0B\x0C\x0E-\x7F]+)\z/
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 0f674ac..efa6b92 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -59,7 +59,6 @@ my %OPTIONS = (
     command => qr/\A(\P{Control}+)\z/,
     'null-stderr' => qr/\A(YES|NO)\z/i,
     compress => qr/\A($RE_ATOM_CHAR+(?: $RE_ATOM_CHAR+)*)\z/,
-    logfile => qr/\A(\/\P{Control}+)\z/,
     SSL_protocols => qr/\A(!?$RE_SSL_PROTO(?: !?$RE_SSL_PROTO)*)\z/,
     SSL_fingerprint => qr/\A((?:[A-Za-z0-9]+\$)?\p{AHex}+)\z/,
     SSL_cipherlist => qr/\A(\P{Control}+)\z/,
diff --git a/pullimap b/pullimap
index 692ec38..cca0ee8 100755
--- a/pullimap
+++ b/pullimap
@@ -64,7 +64,7 @@ my $CONF = read_config( delete $CONFIG{config} // $NAME,
                       , 'deliver-rcpt' => qr/\A(\P{Control}+)\z/
                       )->{$ARGV[0]};
 
-my ($MAILBOX, $STATE, $LOGGER_FD);
+my ($MAILBOX, $STATE);
 do {
     $MAILBOX = $CONF->{mailbox} // 'INBOX';
 
@@ -86,19 +86,6 @@ do {
     fcntl($STATE, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!";
 
     flock($STATE, LOCK_EX) or die "Can't flock $statefile: $!";
-
-
-    if (defined (my $logfile = $CONF->{logfile})) {
-        require 'POSIX.pm';
-        require 'Time/HiRes.pm';
-        open $LOGGER_FD, '>>', $logfile or die "Can't open $logfile: $!\n";
-        $LOGGER_FD->autoflush(1);
-        my $flags = fcntl($LOGGER_FD, F_GETFL, 0)       or die "fcntl F_GETFL: $!";
-        fcntl($LOGGER_FD, F_SETFL, $flags | FD_CLOEXEC) or die "fcntl F_SETFL: $!";
-    }
-    elsif ($CONFIG{debug}) {
-        $LOGGER_FD = \*STDERR;
-    }
 };
 
 
@@ -230,11 +217,12 @@ sub smtp_send(@) {
 # Initialize the cache from the statefile, then pull new messages from
 # the remote mailbox
 #
-my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/}, 'logger-fd' => $LOGGER_FD );
+$CONF->{'logger-fd'} = \*STDERR if $CONFIG{debug};
+my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/} );
 
 # Use BODY.PEEK[] so if something gets wrong, unpulled messages
 # won't be marked as \Seen in the mailbox
-my $ATTRS = join ' ', qw/ENVELOPE INTERNALDATE BODY.PEEK[]/;
+my $ATTRS = "ENVELOPE INTERNALDATE BODY.PEEK[]";
 
 # Pull new messages from IMAP and deliver them to SMTP, then update the
 # statefile
-- 
cgit v1.2.3


From 247cc63d7710e1907b114a75125c27de946415aa Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Mon, 7 Mar 2016 16:01:51 +0100
Subject: Add an option "purge-after" to remove old messages.

---
 lib/Net/IMAP/InterIMAP.pm | 24 ++++++++++++++++++++----
 pullimap                  | 31 +++++++++++++++++++++++++++++++
 2 files changed, 51 insertions(+), 4 deletions(-)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index efa6b92..01fb6a9 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -1287,8 +1287,9 @@ sub push_flag_updates($$@) {
 
 
 # $self->silent_store($set, $mod, @flags)
-#   Set / Add / Update the flags list on the UID $set.
-#   /!\ There is no guaranty that message flags have been set!
+#   Set / Add / Remove the flags list on the UID $set, depending on the
+#   value of $mod ('' / '+' / '-').
+#   /!\ There is no guaranty that message flags are successfully updated!
 sub silent_store($$$@) {
     my $self = shift;
     my $set = shift;
@@ -1297,6 +1298,19 @@ sub silent_store($$$@) {
 }
 
 
+# $self->expunge($set)
+#   Exunge the given UID $set.
+#   /!\ There is no guaranty that messages are successfully expunged!
+sub expunge($$) {
+    my $self = shift;
+    my $set = shift;
+
+    $self->fail("Server did not advertise UIDPLUS (RFC 4315) capability.")
+        unless $self->_capable('UIDPLUS');
+    $self->_send("UID EXPUNGE $set");
+}
+
+
 #############################################################################
 # Private methods
 
@@ -2220,8 +2234,10 @@ sub _resp($$;$$$) {
         }
         elsif (/\A([0-9]+) EXPUNGE\z/) {
             # /!\ No bookkeeping since there is no internal cache mapping sequence numbers to UIDs
-            $self->panic("$1 <= $cache->{EXISTS}") if $1 <= $cache->{EXISTS}; # sanity check
-            $self->fail("RFC 7162 violation!  Got an EXPUNGE response with QRESYNC enabled.") if $self->_enabled('QRESYNC');
+            if ($self->_enabled('QRESYNC')) {
+                $self->panic("$1 <= $cache->{EXISTS}") if $1 <= $cache->{EXISTS}; # sanity check
+                $self->fail("RFC 7162 violation!  Got an EXPUNGE response with QRESYNC enabled.");
+            }
             $cache->{EXISTS}--; # explicit EXISTS responses are optional
         }
         elsif (/\ASEARCH((?: [0-9]+)*)\z/) {
diff --git a/pullimap b/pullimap
index cca0ee8..7e737f2 100755
--- a/pullimap
+++ b/pullimap
@@ -62,6 +62,7 @@ my $CONF = read_config( delete $CONFIG{config} // $NAME,
                       , '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+)d\z/
                       )->{$ARGV[0]};
 
 my ($MAILBOX, $STATE);
@@ -220,6 +221,34 @@ sub smtp_send(@) {
 $CONF->{'logger-fd'} = \*STDERR if $CONFIG{debug};
 my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/} );
 
+# Remove messages with UID < UIDNEXT and INTERNALDATE at most
+# $CONF->{'purge-after'} days ago.
+my $LAST_PURGED;
+sub purge() {
+    my $days = $CONF->{'purge-after'} // return;
+    $days =~ s/d$//;
+    my ($uidnext) = $IMAP->get_cache('UIDNEXT');
+    return unless 1<$uidnext;
+    my $set = "1:".($uidnext-1);
+
+    my $now = time;
+    return if defined $LAST_PURGED and $now - $LAST_PURGED < 6*3600;
+    $LAST_PURGED = $now;
+
+    unless ($days == 0) {
+        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");
+        return unless @uid;
+
+        $set = compact_set(@uid);
+        $IMAP->log("Removing ".($#uid+1)." UID(s) $set") unless $CONFIG{quiet};
+    }
+    $IMAP->silent_store($set, '+', '\Deleted');
+    $IMAP->expunge($set);
+}
+
 # Use BODY.PEEK[] so if something gets wrong, unpulled messages
 # won't be marked as \Seen in the mailbox
 my $ATTRS = "ENVELOPE INTERNALDATE BODY.PEEK[]";
@@ -288,6 +317,7 @@ do {
         }
     }
     pull($ignore);
+    purge();
 };
 exit 0 unless defined $CONFIG{idle};
 
@@ -295,4 +325,5 @@ $CONFIG{idle} = 1740 if defined $CONFIG{idle} and $CONFIG{idle} == 0; # 29 mins
 while(1) {
     my $r = $IMAP->idle($CONFIG{idle}, sub() { $IMAP->has_new_mails($MAILBOX) });
     pull() if $r;
+    purge();
 }
-- 
cgit v1.2.3


From 67f7ae7c82263dc3acad7f6b4df586f94f3b5e15 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Mon, 7 Mar 2016 17:32:29 +0100
Subject: wibble

---
 lib/Net/IMAP/InterIMAP.pm |  2 +-
 pullimap                  | 16 +++++++++-------
 2 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 01fb6a9..be62a9d 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -2335,7 +2335,7 @@ sub _resp($$;$$$) {
         }
     }
     elsif (s/\A\+// and ($_ eq '' or s/\A //)) {
-        # microsoft's IMAP server violates RFC 3501 by skipping the trailing ' ' for empty resp-text
+        # Microsoft Exchange Server 2010 violates RFC 3501 by skipping the trailing ' ' for empty resp-text
         if (defined $callback and $cmd eq 'AUTHENTICATE') {
             my $x = $callback->($_);
             $self->_cmd_extend(\$x);
diff --git a/pullimap b/pullimap
index 7e737f2..27226d2 100755
--- a/pullimap
+++ b/pullimap
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -T
 
 #----------------------------------------------------------------------
-# Pull mails from an IMAP mailbox and deliver them to an SMTP session
+# Pull mails from an IMAP mailbox and deliver them to a SMTP session
 # Copyright © 2016 Guilhem Moulin <guilhem@fripost.org>
 #
 # This program is free software: you can redistribute it and/or modify
@@ -59,10 +59,10 @@ 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-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+)d\z/
+                      , 'purge-after' => qr/\A(\d+)\z/
                       )->{$ARGV[0]};
 
 my ($MAILBOX, $STATE);
@@ -122,12 +122,12 @@ sub sendmail($$) {
     unless (defined $SMTP) {
         # TODO we need to be able to reconnect when the server closes
         # the connection due to a timeout (RFC 5321 section 4.5.3.2)
-        my ($fam, $addr, $port) = (PF_INET, $CONF->{'deliver-method'} // 'smtp:[127.0.0.1]:10024', 25);
+        my ($fam, $addr) = (PF_INET, $CONF->{'deliver-method'} // 'smtp:[127.0.0.1]:25');
         $addr =~ s/^([ls]mtp):// or die;
         my $ehlo = $1 eq 'lmtp' ? 'LHO' : $1 eq 'smtp' ? 'EHLO' : die;
         $ehlo .= ' '. ($CONF->{'deliver-ehlo'} // 'localhost.localdomain');
 
-        $port = $1 if $addr =~ s/:(\d+)$//;
+        my $port = $addr =~ s/:(\d+)$// ? $1 : die;
         $addr =~ s/^\[(.*)\]$/$1/ or die;
         $fam = PF_INET6 if $addr =~ /:/;
         $addr = Socket::inet_pton($fam, $addr) // die "Invalid address $addr\n";
@@ -226,7 +226,6 @@ my $IMAP = Net::IMAP::InterIMAP::->new( %$CONF, %CONFIG{qw/quiet debug/} );
 my $LAST_PURGED;
 sub purge() {
     my $days = $CONF->{'purge-after'} // return;
-    $days =~ s/d$//;
     my ($uidnext) = $IMAP->get_cache('UIDNEXT');
     return unless 1<$uidnext;
     my $set = "1:".($uidnext-1);
@@ -319,7 +318,10 @@ do {
     pull($ignore);
     purge();
 };
-exit 0 unless defined $CONFIG{idle};
+unless (defined $CONFIG{idle}) {
+    $IMAP->logout();
+    exit 0;
+}
 
 $CONFIG{idle} = 1740 if defined $CONFIG{idle} and $CONFIG{idle} == 0; # 29 mins
 while(1) {
-- 
cgit v1.2.3


From feb047ee7fcc1f93bc1e76626e16651761e0db55 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Mon, 7 Mar 2016 17:33:03 +0100
Subject: pullimap: add a manpage and a configuration file.

---
 Changelog       |   2 +
 pullimap.1      | 236 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 pullimap.sample |  32 ++++++++
 3 files changed, 270 insertions(+)
 create mode 100644 pullimap.1
 create mode 100644 pullimap.sample

diff --git a/Changelog b/Changelog
index cf7e678..a1ae59f 100644
--- a/Changelog
+++ b/Changelog
@@ -4,6 +4,8 @@ interimap (0.3) upstream;
   * Add an option 'SSL_protocols' to list SSL protocols to enable or
     disable.  The default value, "!SSLv2 !SSLv3", enables only TLSv1
     and above.
+  * New script 'pullimap', to pull mails from an IMAP mailbox and
+    deliver them to a SMTP session.
 
  -- Guilhem Moulin <guilhem@guilhem.org>  Mon, 28 Sep 2015 01:16:47 +0200
 
diff --git a/pullimap.1 b/pullimap.1
new file mode 100644
index 0000000..e0f1ec3
--- /dev/null
+++ b/pullimap.1
@@ -0,0 +1,236 @@
+.TH PULLIMAP "1" "MARCH 2016" "PullIMAP" "User Commands"
+
+.SH NAME
+PullIMAP \- Pull mails from an IMAP mailbox and deliver them to a SMTP session
+
+.SH SYNOPSIS
+.B pullimap\fR [\fB--config=\fIFILE\fR] [\fB--idle\fR[\fB=\fISECONDS\fR]]
+[\fB--no-delivery\fR] [\fB--quiet\fR] \fISECTION\fR
+
+
+.SH DESCRIPTION
+.PP
+.B PullIMAP\fR retrives messages from an IMAP mailbox and deliver them
+to a SMTP or LMTP transmission channel.
+It can also remove delivered messages after a configurable retention
+period.
+
+.PP
+A statefile is used to keep track of the mailbox's UIDVALIDITY and
+UIDNEXT values.  While \fBPullIMAP\fR is running, the statefile is also
+used to keep track of UIDs being delivered, which avoids duplicate
+deliveries if the process is interrupted.
+
+.SH OPTIONS
+.TP
+.B \-\-config=\fR\fIFILE\fR
+Specify an alternate configuration file.  Relative paths start from
+\fI$XDG_CONFIG_HOME\fR, or \fI~/.config\fR if the XDG_CONFIG_HOME
+environment variable is unset.
+
+.TP
+.B \fB\-\-idle\fR[\fB=\fR\fIseconds\fR]
+Don't exit after a successful poll; instead, keep the connection open
+and issue IDLE commands (requires an IMAP server supporting RFC 2177) to
+watch for updates in the mailbox.
+Each IDLE is terminated after at most \fIseconds\fR (29 minutes by
+default) to avoid being logged out for inactivity.
+
+.TP
+.B \fB\-\-no\-delivery
+Update the state file, but skip SMTP/LMTP delivery.  This is mostly
+useful for initializing the statefile when migrating to \fBPullIMAP\fR
+from another equivalent program such as \fIgetmail\fR(1) or
+\fIfetchmail\fR(1).
+
+.TP
+.B \-q\fR, \fB\-\-quiet\fR
+Try to be quiet.
+
+.TP
+.B \-\-debug
+Turn on debug mode.  Debug messages are written to the error output.
+Note that this include all IMAP traffic (except literals).  Depending on
+the chosen authentication mechanism, this might include authentication
+credentials.
+
+.TP
+.B \-h\fR, \fB\-\-help\fR
+Output a brief help and exit.
+
+.TP
+.B \-\-version
+Show the version number and exit.
+
+.SH CONFIGURATION FILE
+
+Unless told otherwise by the \fB\-\-config=\fR\fIFILE\fR option,
+\fBPullIMAP\fR reads its configuration from
+\fI$XDG_CONFIG_HOME/pullimap\fR (or \fI~/.config/pullimap\fR if the
+XDG_CONFIG_HOME environment variable is unset) as an INI file.
+The syntax of the configuration file is a serie of
+\fIOPTION\fR=\fIVALUE\fR lines organized under some \fI[SECTION]\fR;
+lines starting with a \(oq#\(cq or \(oq;\(cq character are ignored as
+comments.
+Valid options are:
+
+.TP
+.I statefile
+State file to use to keep track of the \fImailbox\fR's UIDVALIDITY and
+UIDNEXT values.
+Relative paths start from \fI$XDG_DATA_HOME/pullimap\fR, or
+\fI~/.local/share/pullimap\fR if the XDG_DATA_HOME environment variable
+is unset.
+(Default: \(lq\fISECTION\fR\)\(rq, where \fISECTION\fR is the section
+name of the option.)
+
+.TP
+.I mailbox
+The IMAP mailbox to pull messages from.
+Support for persistent message Unique Identifiers (UID) is required.
+(Default: \(lqINBOX\)\(rq.)
+
+.TP
+.I deliver\-method
+\fR\fIprotocol\fR:\fI[address]\fI\fR:\fIport\fR where to deliver
+messages.  Both SMTP [RFC 5321] and LMTP [RFC 2030] are supported.
+(Default: \(lqsmtp:[127.0.0.1]:25\)\(rq.)
+
+.TP
+.I deliver\-ehlo
+Hostname to use in EHLO or LHO commands.
+(Default: \(lq\fIlocalhost.localdomain\fR\)\(rq.)
+
+
+.TP
+.I deliver\-rcpt
+Message recpient.
+(Default: the username associated with the effective uid of the
+\fBpullimap\fR process.)
+
+.TP
+.I purge\-after
+Retention period (in days), after which messages are removed from the
+IMAP server.  (The value is at best 24h accurate due to IMAP SEARCH
+criterion ignoring time and timezone.)
+
+.TP
+.I type
+One of \(lqimap\(rq, \(lqimaps\(rq or \(lqtunnel\(rq.
+\fItype\fR=imap and \fItype\fR=imaps are respectively used for IMAP and
+IMAP over SSL/TLS connections over a INET socket.
+\fItype\fR=tunnel causes \fBPullIMAP\fR to open a pipe to a
+\fIcommand\fR instead of a raw socket.
+Note that specifying \fItype\fR=tunnel in the \(lq[remote]\(rq section
+makes the default \fIdatabase\fR to be \(lqlocalhost.db\(rq.
+(Default: \(lqimaps\(rq.)
+
+.TP
+.I host
+Server hostname, for \fItype\fR=imap and \fItype\fR=imaps.
+(Default: \(lqlocalhost\(rq.)
+
+.TP
+.I port
+Server port.
+(Default: \(lq143\(rq for \fItype\fR=imap, \(lq993\(rq for
+\fItype\fR=imaps.)
+
+.TP
+.I proxy
+An optional SOCKS proxy to use for TCP connections to the IMAP server
+(\fItype\fR=imap and \fItype\fR=imaps only), formatted as
+\(lq\fIprotocol\fR://[\fIuser\fR:\fIpassword\fR@]\fIproxyhost\fR[:\fIproxyport\fR]\(rq.
+If \fIproxyport\fR is omitted, it is assumed at port 1080.
+Only SOCKSv5 is supported, in two flavors: \(lqsocks5://\(rq to resolve
+\fIhostname\fR locally, and \(lqsocks5h://\(rq to let the proxy resolve
+\fIhostname\fR.
+
+.TP
+.I command
+Command to use for \fItype\fR=tunnel.  Must speak the IMAP4rev1 protocol
+on its standard output, and understand it on its standard input.
+
+.TP
+.I STARTTLS
+Whether to use the \(lqSTARTTLS\(rq directive to upgrade to a secure
+connection.  Setting this to \(lqYES\(rq for a server not advertising
+the \(lqSTARTTLS\(rq capability causes \fBPullIMAP\fR to immediately
+abort the connection.
+(Ignored for \fItype\fRs other than \(lqimap\(rq.  Default: \(lqYES\(rq.)
+
+.TP
+.I auth
+Space\-separated list of preferred authentication mechanisms.
+\fBPullIMAP\fR uses the first mechanism in that list that is also
+advertised (prefixed with \(lqAUTH=\(rq) in the server's capability list.
+Supported authentication mechanisms are \(lqPLAIN\(rq and \(lqLOGIN\(rq.
+(Default: \(lqPLAIN LOGIN\(rq.)
+
+.TP
+.I username\fR, \fIpassword\fR
+Username and password to authenticate with.  Can be required for non
+pre\-authenticated connections, depending on the chosen authentication
+mechanism.
+
+.TP
+.I compress
+Whether to use the IMAP COMPRESS extension [RFC4978] for servers
+advertizing it.
+(Default: \(lqYES\(rq.)
+
+.TP
+.I null-stderr
+Whether to redirect \fIcommand\fR's standard error to \(lq/dev/null\(rq
+for type \fItype\fR=tunnel.
+(Default: \(lqNO\(rq.)
+
+.TP
+.I SSL_protocols
+A space-separated list of SSL protocols to enable or disable (if
+prefixed with an exclamation mark \(oq!\(cq).  Known protocols are
+\(lqSSLv2\(rq, \(lqSSLv3\(rq, \(lqTLSv1\(rq, \(lqTLSv1.1\(rq, and
+\(lqTLSv1.2\(rq.  Enabling a protocol is a short-hand for disabling all
+other protocols.
+(Default: \(lq!SSLv2 !SSLv3\(rq, i.e., only enable TLSv1 and above.)
+
+.TP
+.I SSL_cipher_list
+The cipher list to send to the server.  Although the server determines
+which cipher suite is used, it should take the first supported cipher in
+the list sent by the client.  See \fBciphers\fR(1ssl) for more
+information.
+
+.TP
+.I SSL_fingerprint
+Fingerprint of the server certificate (or its public key) in the form
+\fIALGO\fR$\fIDIGEST_HEX\fR, where \fIALGO\fR is the used algorithm
+(default \(lqsha256\(rq).
+Attempting to connect to a server with a non-matching certificate
+fingerprint causes \fBPullIMAP\fR to abort the connection during the
+SSL/TLS handshake.
+
+.TP
+.I SSL_verify
+Whether to verify the server certificate chain.
+Note that using \fISSL_fingerprint\fR to specify the fingerprint of the
+server certificate is an orthogonal authentication measure as it ignores
+the CA chain.
+(Default: \(lqYES\(rq.)
+
+.TP
+.I SSL_CApath
+Directory to use for server certificate verification if
+\(lq\fISSL_verify\fR=YES\(rq.
+This directory must be in \(lqhash format\(rq, see \fBverify\fR(1ssl)
+for more information.
+
+.TP
+.I SSL_CAfile
+File containing trusted certificates to use during server certificate
+authentication if \(lq\fISSL_verify\fR=YES\(rq.
+
+.SH AUTHOR
+Written by Guilhem Moulin
+.MT guilhem@fripost.org
+.ME .
diff --git a/pullimap.sample b/pullimap.sample
new file mode 100644
index 0000000..63ff9de
--- /dev/null
+++ b/pullimap.sample
@@ -0,0 +1,32 @@
+mailbox = INBOX
+deliver-method = smtp:[127.0.0.1]:25
+#deliver-method = smtp:[127.0.0.1]:10024
+purge-after = 90
+
+# SSL options
+SSL_CApath = /etc/ssl/certs
+#SSL_verify = YES
+#SSL_protocols = !SSLv2 !SSLv3 !TLSv1 !TLSv1.1
+#SSL_cipherlist = EECDH+AESGCM:!MEDIUM:!LOW:!EXP:!aNULL:!eNULL
+
+[private]
+#type = imaps
+host = imap.guilhem.org
+#port = 993
+#proxy = socks5h://localhost:9050
+username = guilhem
+password = xxxxxxxxxxxxxxxx
+#compress = YES
+#SSL_fingerprint = sha256$62E436BB329C46A628314C49BDA7C2A2E86C57B2021B9A964B8FABB6540D3605
+
+[work]
+#type = imaps
+host = imap.example.com
+#port = 993
+#proxy = socks5h://localhost:9050
+username = guilhem
+password = xxxxxxxxxxxxxxxx
+#compress = YES
+#SSL_fingerprint = sha256$c93677ac6a4ac7d0a2b412c1bfdd83b9191c853aa8685bf5440f154e647caacf
+
+# vim:ft=dosini
-- 
cgit v1.2.3