diff options
| -rw-r--r-- | Changelog | 1 | ||||
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 52 | ||||
| -rwxr-xr-x | pullimap | 8 | ||||
| -rwxr-xr-x | tests/preauth-plaintext/imapd | 2 | ||||
| -rwxr-xr-x | tests/starttls-injection/imapd | 20 |
5 files changed, 42 insertions, 41 deletions
@@ -12,6 +12,7 @@ interimap (0.5.5) upstream; settings bumps the required libssl version to 1.1.0. + `make release`: also bump libinterimap version and pin it in 'use' declarations. + + Make error messages more uniform and consistent. - libinterimap: make $OPENSSL_VERSION global. - libinterimap: use Net::SSLeay::get_version() to get the protocol version string. diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 6afca07..3745aad 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -328,19 +328,19 @@ sub new($%) { my $pid = fork // $self->panic("fork: $!"); unless ($pid) { # children - close($self->{S}) or $self->panic("Can't close: $!"); - open STDIN, '<&', $s or $self->panic("Can't dup: $!"); - open STDOUT, '>&', $s or $self->panic("Can't dup: $!"); + close($self->{S}) or $self->panic("close: $!"); + open STDIN, '<&', $s or $self->panic("dup: $!"); + open STDOUT, '>&', $s or $self->panic("dup: $!"); my $stderr2; if (($self->{'null-stderr'} // 0) and !($self->{debug} // 0)) { open $stderr2, '>&', *STDERR; - open STDERR, '>', '/dev/null' or $self->panic("Can't open /dev/null: $!"); + open STDERR, '>', '/dev/null' or $self->panic("open(/dev/null): $!"); } my $sigset = POSIX::SigSet::->new(SIGINT); my $oldsigset = POSIX::SigSet::->new(); - sigprocmask(SIG_BLOCK, $sigset, $oldsigset) // $self->panic("Can't block SIGINT: $!"); + sigprocmask(SIG_BLOCK, $sigset, $oldsigset) // $self->panic("sigprocmask: $!"); unless (exec $command) { my $err = $!; @@ -348,12 +348,12 @@ sub new($%) { close STDERR; open STDERR, '>&', $stderr2; } - $self->panic("Can't exec: $err"); + $self->panic("exec: $err"); } } # parent - close($s) or $self->panic("Can't close: $!"); + close($s) or $self->panic("close: $!"); } else { foreach (qw/host port/) { @@ -363,9 +363,9 @@ sub new($%) { : $self->_tcp_connect(@$self{qw/host port/}); if (defined $self->{keepalive}) { setsockopt($self->{S}, Socket::SOL_SOCKET, Socket::SO_KEEPALIVE, 1) - or $self->fail("Can't setsockopt SO_KEEPALIVE: $!"); + or $self->fail("setsockopt SO_KEEPALIVE: $!"); setsockopt($self->{S}, Socket::IPPROTO_TCP, Socket::TCP_KEEPIDLE, 60) - or $self->fail("Can't setsockopt TCP_KEEPIDLE: $!"); + or $self->fail("setsockopt TCP_KEEPIDLE: $!"); } } @@ -1493,9 +1493,9 @@ sub _tcp_connect($$$) { # https://stackoverflow.com/questions/8284243/how-do-i-set-so-rcvtimeo-on-a-socket-in-perl my $timeout = pack('l!l!', 30, 0); setsockopt($s, Socket::SOL_SOCKET, Socket::SO_RCVTIMEO, $timeout) - or $self->fail("Can't setsockopt SO_RCVTIMEO: $!"); + or $self->fail("setsockopt SO_RCVTIMEO: $!"); setsockopt($s, Socket::SOL_SOCKET, Socket::SO_SNDTIMEO, $timeout) - or $self->fail("Can't setsockopt SO_RCVTIMEO: $!"); + or $self->fail("setsockopt SO_RCVTIMEO: $!"); until (connect($s, $ai->{addr})) { next if $! == EINTR; # try again if connect(2) was interrupted by a signal @@ -1512,7 +1512,7 @@ sub _xwrite($$$) { while ($length > 0) { my $n = syswrite($_[0], $_[1], $length, $offset); - $self->fail("Can't write: $!") unless defined $n and $n > 0; + $self->fail("write: $!") unless defined $n and $n > 0; $offset += $n; $length -= $n; } @@ -1524,7 +1524,7 @@ sub _xread($$$) { my $offset = 0; my $buf; while ($length > 0) { - my $n = sysread($fh, $buf, $length, $offset) // $self->fail("Can't read: $!"); + my $n = sysread($fh, $buf, $length, $offset) // $self->fail("read: $!"); $self->fail("0 bytes read (got EOF)") unless $n > 0; # EOF $offset += $n; $length -= $n; @@ -1582,7 +1582,7 @@ sub _proxify($$$$) { my ($err, $ipaddr) = getnameinfo($_->{addr}, NI_NUMERICHOST, NIx_NOSERV); $err eq '' ? [$ipaddr,$_->{family}] : undef } @res; - $self->fail("Can't getnameinfo") unless defined $addr; + $self->fail("getnameinfo") unless defined $addr; ($hostip, $fam) = @$addr; } @@ -1704,7 +1704,7 @@ my %SSL_protocol_versions = ( # 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 $ctx = Net::SSLeay::CTX_new() or $self->panic("SSL_CTX_new(): $!"); if (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') { $self->warn("Truncating non-empty output buffer (unauthenticated response injection?)"); @@ -1749,6 +1749,7 @@ sub _start_ssl($$) { } # https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_options.html + # TODO 0.6: move SSL_CTX_set_options() and SSL_CTX_set_mode() before SSL_CTX_set_{min,max}_proto_version() Net::SSLeay::CTX_set_options($ctx, $ssl_options); # https://www.openssl.org/docs/manmaster/man3/SSL_CTX_set_mode.html @@ -1758,9 +1759,8 @@ sub _start_ssl($$) { Net::SSLeay::MODE_AUTO_RETRY() | # don't fail SSL_read on renegotiation Net::SSLeay::MODE_RELEASE_BUFFERS() ); - if (defined (my $ciphers = $self->{SSL_cipherlist})) { - Net::SSLeay::CTX_set_cipher_list($ctx, $ciphers) - or $self->_ssl_error("Can't set cipher list"); + if (defined (my $str = $self->{SSL_cipherlist})) { + $self->_ssl_error("SSL_CTX_set_cipher_list()") unless Net::SSLeay::CTX_set_cipher_list($ctx, $str) == 1; } my $vpm = Net::SSLeay::X509_VERIFY_PARAM_new() or $self->_ssl_error("X509_VERIFY_PARAM_new()"); @@ -1777,8 +1777,8 @@ sub _start_ssl($$) { # verify certificate chain my ($file, $path) = ($self->{SSL_CAfile} // '', $self->{SSL_CApath} // ''); if ($file ne '' or $path ne '') { - Net::SSLeay::CTX_load_verify_locations($ctx, $file, $path) - or $self->_ssl_error("Can't load verify locations"); + $self->_ssl_error("SSL_CTX_load_verify_locations()") + unless Net::SSLeay::CTX_load_verify_locations($ctx, $file, $path) == 1; } # verify DNS hostname or IP literal @@ -1797,14 +1797,14 @@ sub _start_ssl($$) { Net::SSLeay::CTX_set_verify($ctx, Net::SSLeay::VERIFY_PEER(), sub($$) {$self->_ssl_verify(@_)}); $self->_ssl_error("CTX_SSL_set1_param()") unless Net::SSLeay::CTX_set1_param($ctx, $vpm) == 1; - my $ssl = Net::SSLeay::new($ctx) or $self->fail("Can't create new SSL structure"); - Net::SSLeay::set_fd($ssl, fileno $socket) or $self->fail("SSL filehandle association failed"); + my $ssl = Net::SSLeay::new($ctx) or $self->fail("SSL_new()"); + $self->fail("SSL_set_fd()") unless Net::SSLeay::set_fd($ssl, fileno($socket)) == 1; - # always use 'SSL_hostname' when set, otherwise use 'host' (unless it's an IP) on OpenSSL >=0.9.8f + # always use 'SSL_hostname' when set, otherwise use 'host' (unless it's an IP) my $servername = $self->{SSL_hostname} // (defined $hostipfam ? "" : $host); if ($servername ne "") { $self->panic("Failed requirement libssl >=0.9.8f") if $OPENSSL_VERSION < 0x00908070; - $self->_ssl_error("Can't set TLS servername extension (value $servername)") + $self->_ssl_error("SSL_set_tlsext_host_name($servername)") unless Net::SSLeay::set_tlsext_host_name($ssl, $servername) == 1; $self->log("Using SNI with name $servername") if $self->{debug}; } @@ -1852,7 +1852,7 @@ sub _getline($;$) { $n = sysread($stdout, $buf, $BUFSIZE, 0); } - $self->_ssl_error("Can't read: $!") unless defined $n; + $self->_ssl_error("read: $!") unless defined $n; $self->_ssl_error("0 bytes read (got EOF)") unless $n > 0; # EOF $self->{_OUTRAWCOUNT} += $n; @@ -2065,7 +2065,7 @@ sub _cmd_flush($;$$) { my $written = defined $ssl ? Net::SSLeay::write_partial($ssl, $offset, $length, $self->{_INBUF}) : syswrite($stdin, $self->{_INBUF}, $length, $offset); - $self->_ssl_error("Can't write: $!") unless defined $written and $written > 0; + $self->_ssl_error("write: $!") unless defined $written and $written > 0; $offset += $written; $length -= $written; @@ -104,7 +104,7 @@ do { # 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: $!"; + my $n = sysread($STATE, my $buf, 4) // die "read: $!"; 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; @@ -117,7 +117,7 @@ sub writeUID($) { my $offset = 0; for ( my $offset = 0 ; $offset < 4 - ; $offset += syswrite($STATE, $uid, 4-$offset, $offset) // die "Can't syswrite: $!" + ; $offset += syswrite($STATE, $uid, 4-$offset, $offset) // die "write: $!" ) {} # no need to sync (or flush) since $STATE is opened with O_DSYNC } @@ -333,11 +333,11 @@ sub pull(;$) { undef $SMTP; # update the statefile - my $p = sysseek($STATE, 4, SEEK_SET) // die "Can't seek: $!"; + my $p = sysseek($STATE, 4, SEEK_SET) // die "seek: $!"; die "Couldn't seek to 4" unless $p == 4; # safety check my ($uidnext) = $IMAP->get_cache('UIDNEXT'); writeUID($uidnext); - truncate($STATE, 8) // die "Can't truncate"; + truncate($STATE, 8) // die "truncate: $!"; } do { diff --git a/tests/preauth-plaintext/imapd b/tests/preauth-plaintext/imapd index 6196f73..bf2ed72 100755 --- a/tests/preauth-plaintext/imapd +++ b/tests/preauth-plaintext/imapd @@ -39,6 +39,6 @@ while (1) { END { if (defined $S) { shutdown($S, SHUT_RDWR) or warn "shutdown: $!"; - close($S) or print STDERR "Can't close: $!\n"; + close($S) or print STDERR "close: $!\n"; } } diff --git a/tests/starttls-injection/imapd b/tests/starttls-injection/imapd index 15c53c7..52cbe9a 100755 --- a/tests/starttls-injection/imapd +++ b/tests/starttls-injection/imapd @@ -4,7 +4,7 @@ use warnings; use strict; use Errno qw/EINTR/; -use Net::SSLeay qw/die_now die_if_ssl_error/; +use Net::SSLeay qw/die_now/; use Socket qw/INADDR_LOOPBACK AF_INET SOCK_STREAM pack_sockaddr_in SOL_SOCKET SO_REUSEADDR SHUT_RDWR/; @@ -20,16 +20,16 @@ bind($S, pack_sockaddr_in(10143, INADDR_LOOPBACK)) or die "bind: $!\n"; listen($S, 1) or die "listen: $!"; my $CONFDIR = $ENV{HOME} =~ /\A(\p{Print}+)\z/ ? "$1/.dovecot/conf.d" : die; -my $CTX = Net::SSLeay::CTX_new() or die_now("SSL_CTX_new"); +my $CTX = Net::SSLeay::CTX_new() or die_now("SSL_CTX_new()"); Net::SSLeay::CTX_set_mode($CTX, Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE() | Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER() | Net::SSLeay::MODE_AUTO_RETRY() | # don't fail SSL_read on renegotiation Net::SSLeay::MODE_RELEASE_BUFFERS() ); Net::SSLeay::CTX_use_PrivateKey_file($CTX, "$CONFDIR/dovecot.rsa.key", &Net::SSLeay::FILETYPE_PEM) - or die_if_ssl_error("Can't load private key: $!"); + or die_now("Can't load private key: $!"); Net::SSLeay::CTX_use_certificate_file($CTX, "$CONFDIR/dovecot.rsa.crt", &Net::SSLeay::FILETYPE_PEM) - or die_if_ssl_error("Can't load certificate: $!"); + or die_now("Can't load certificate: $!"); while (1) { my $sockaddr = accept(my $conn, $S) or do { @@ -52,14 +52,14 @@ while (1) { $conn->printf("%06d OK CAPABILITY injected\r\n", $1+1); $conn->flush(); - my $ssl = Net::SSLeay::new($CTX) or die_if_ssl_error("SSL_new"); - Net::SSLeay::set_fd($ssl, $conn) or die_if_ssl_error("SSL_set_fd"); - Net::SSLeay::accept($ssl) and die_if_ssl_error("SSL_accept"); + my $ssl = Net::SSLeay::new($CTX) or die_now("SSL_new()"); + die_now("SSL_set_fd()") unless Net::SSLeay::set_fd($ssl, $conn) == 1; + die_now("SSL_accept()") unless Net::SSLeay::accept($ssl); - Net::SSLeay::ssl_read_CRLF($ssl) =~ /\A(\S+) CAPABILITY\r\n\z/ or die_now("SSL_read"); + Net::SSLeay::ssl_read_CRLF($ssl) =~ /\A(\S+) CAPABILITY\r\n\z/ or die_now("SSL_read()"); Net::SSLeay::ssl_write_CRLF($ssl, "* CAPABILITY IMAP4rev1 AUTH=LOGIN\r\n$1 OK CAPABILITY completed"); - Net::SSLeay::ssl_read_CRLF($ssl) =~ /\A(\S+) LOGIN .*\r\n\z/ or die_now("SSL_read"); + Net::SSLeay::ssl_read_CRLF($ssl) =~ /\A(\S+) LOGIN .*\r\n\z/ or die_now("SSL_read()"); Net::SSLeay::ssl_write_CRLF($ssl, "$1 OK [CAPABILITY IMAP4rev1] LOGIN completed"); Net::SSLeay::free($ssl); @@ -72,6 +72,6 @@ END { Net::SSLeay::CTX_free($CTX) if defined $CTX; if (defined $S) { shutdown($S, SHUT_RDWR) or warn "shutdown: $!"; - close($S) or print STDERR "Can't close: $!\n"; + close($S) or print STDERR "close: $!\n"; } } |