From e9e360cbe894b5674a3ffe433e5d727cf8368715 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sat, 5 Mar 2016 15:31:36 +0100 Subject: pullimap (IMAP part only) --- pullimap | 173 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 173 insertions(+) create mode 100755 pullimap (limited to 'pullimap') 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 +# +# 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 . +#---------------------------------------------------------------------- + +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 Date: Sat, 5 Mar 2016 15:52:27 +0100 Subject: pullimap: mark downloaded messages as \Seen --- pullimap | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'pullimap') 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 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(-) (limited to 'pullimap') 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 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(-) (limited to 'pullimap') 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 Date: Sat, 5 Mar 2016 18:36:07 +0100 Subject: pullimap: add support for IMAP IDLE (RFC 2177). --- pullimap | 81 ++++++++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 48 insertions(+), 33 deletions(-) (limited to 'pullimap') 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 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(-) (limited to 'pullimap') 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 Date: Sat, 5 Mar 2016 19:49:08 +0100 Subject: Ensure the FD_CLOEXEC bit is 1 on sockets, logger and state files. --- pullimap | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'pullimap') 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 Date: Mon, 7 Mar 2016 11:40:38 +0100 Subject: typo --- pullimap | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'pullimap') 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 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(-) (limited to 'pullimap') 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 Date: Mon, 7 Mar 2016 13:32:13 +0100 Subject: pullimap: Remove "logfile" config option. --- pullimap | 20 ++++---------------- 1 file changed, 4 insertions(+), 16 deletions(-) (limited to 'pullimap') 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 Date: Mon, 7 Mar 2016 16:01:51 +0100 Subject: Add an option "purge-after" to remove old messages. --- pullimap | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) (limited to 'pullimap') 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 Date: Mon, 7 Mar 2016 17:32:29 +0100 Subject: wibble --- pullimap | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'pullimap') 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 # # 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