aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net/IMAP/InterIMAP.pm
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2020-12-13 15:07:30 +0100
committerGuilhem Moulin <guilhem@fripost.org>2020-12-13 15:11:11 +0100
commitb70d9b261a6d2849efeb670b53e0ab726a58fb59 (patch)
tree41aa9f8fd1464060f249437b41a74d0f728d2bd8 /lib/Net/IMAP/InterIMAP.pm
parent2d301be3df763be39d12d214779cf2320b426696 (diff)
Make error messages more uniform and consistent.
Diffstat (limited to 'lib/Net/IMAP/InterIMAP.pm')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm52
1 files changed, 26 insertions, 26 deletions
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;