Make error messages more uniform and consistent.

5 files changed, 42 insertions, 41 deletions

diff --git a/Changelog b/Changelog
index 4bc426b..931e526 100644
--- a/Changelog
+++ b/Changelog
@@ -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;
diff --git a/pullimap b/pullimap
index b691272..8142be8 100755
--- a/pullimap
+++ b/pullimap
@@ -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";
     }
 }