diff options
Diffstat (limited to 'lib/Net/IMAP/InterIMAP.pm')
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 70 |
1 files changed, 57 insertions, 13 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 57f002e..0762b3b 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -26,7 +26,7 @@ use IO::Select (); use Net::SSLeay (); use List::Util 'first'; use POSIX ':signal_h'; -use Socket qw/SO_KEEPALIVE SOL_SOCKET/; +use Socket qw/SOL_SOCKET SO_KEEPALIVE SOCK_STREAM IPPROTO_TCP/; use Exporter 'import'; BEGIN { @@ -45,8 +45,8 @@ my $RE_TEXT_CHAR = qr/[\x01-\x09\x0B\x0C\x0E-\x7F]/; # Map each option to a regexp validating its values. my %OPTIONS = ( - host => qr/\A([0-9a-zA-Z:.-]+)\z/, - port => qr/\A([0-9]+)\z/, + host => qr/\A(\P{Control}+)\z/, + port => qr/\A(\P{Control}+)\z/, type => qr/\A(imaps?|tunnel)\z/, STARTTLS => qr/\A(YES|NO)\z/i, username => qr/\A([\x01-\x7F]+)\z/, @@ -283,13 +283,11 @@ sub new($%) { } } else { - require 'IO/Socket/INET.pm'; - my %args = (Proto => 'tcp', Blocking => 1); - $args{PeerHost} = $self->{host} // $self->fail("Missing option host"); - $args{PeerPort} = $self->{port} // $self->fail("Missing option port"); - - my $socket = IO::Socket::INET->new(%args) or $self->fail("Cannot bind: $@"); - $socket->setsockopt(SOL_SOCKET, SO_KEEPALIVE, 1) or $self->fail("Can't setsockopt SO_KEEPALIVE: $!"); + foreach (qw/host port/) { + $self->fail("Missing option $_") unless defined $self->{$_}; + } + my $socket = $self->_tcp_connect(@$self{qw/host port/}); + setsockopt($socket, SOL_SOCKET, SO_KEEPALIVE, 1) or $self->fail("Can't setsockopt SO_KEEPALIVE: $!"); $self->_start_ssl($socket) if $self->{type} eq 'imaps'; $self->{$_} = $socket for qw/STDOUT STDIN/; @@ -459,6 +457,7 @@ sub DESTROY($) { Net::SSLeay::free($self->{_SSL}) if defined $self->{_SSL}; Net::SSLeay::CTX_free($self->{_SSL_CTX}) if defined $self->{_SSL_CTX}; + shutdown($self->{STDIN}, 2) if $self->{type} ne 'tunnel' and defined $self->{STDIN}; foreach (qw/STDIN STDOUT/) { $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened(); } @@ -1212,6 +1211,51 @@ sub _ssl_error($$@) { } +# RFC 3986 appendix A +my $RE_IPv4 = do { + my $dec = qr/[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5]/; + qr/$dec(?:\.$dec){3}/o }; +my $RE_IPv6 = do { + my $h16 = qr/[0-9A-Fa-f]{1,4}/; + my $ls32 = qr/$h16:$h16|$RE_IPv4/o; + qr/ (?: $h16 : ){6} $ls32 + | :: (?: $h16 : ){5} $ls32 + | (?: $h16 )? :: (?: $h16 : ){4} $ls32 + | (?: (?: $h16 : ){0,1} $h16 )? :: (?: $h16 : ){3} $ls32 + | (?: (?: $h16 : ){0,2} $h16 )? :: (?: $h16 : ){2} $ls32 + | (?: (?: $h16 : ){0,3} $h16 )? :: $h16 : $ls32 + | (?: (?: $h16 : ){0,4} $h16 )? :: $ls32 + | (?: (?: $h16 : ){0,5} $h16 )? :: $h16 + | (?: (?: $h16 : ){0,6} $h16 )? :: + /xo }; + + +# Opens a TCP socket to the given $host and $port. +sub _tcp_connect($$$) { + my ($self, $host, $port) = @_; + + my %hints = (socktype => SOCK_STREAM, protocol => IPPROTO_TCP); + if ($host =~ qr/\A$RE_IPv4\z/o) { + $hints{family} = AF_INET; + $hints{flags} |= AI_NUMERICHOST; + } + elsif ($host =~ qr/\A\[($RE_IPv6)\]\z/o) { + $host = $1; + $hints{family} = AF_INET6; + $hints{flags} |= AI_NUMERICHOST; + } + + my ($err, @res) = Socket::getaddrinfo($host, $port, \%hints); + $self->fail("Can't getaddrinfo: $err") if $err ne ''; + + foreach my $ai (@res) { + socket my $s, $ai->{family}, $ai->{socktype}, $ai->{protocol}; + return $s if defined $s and connect($s, $ai->{addr}); + } + $self->fail("Can't connect to $host:$port"); +} + + # $self->_start_ssl($socket) # Upgrade the $socket to SSL/TLS. sub _start_ssl($$) { @@ -1252,7 +1296,7 @@ sub _start_ssl($$) { } my $ssl = Net::SSLeay::new($ctx) or $self->fail("Can't create new SSL structure"); - Net::SSLeay::set_fd($ssl, $socket->fileno()) or $self->fail("SSL filehandle association failed"); + Net::SSLeay::set_fd($ssl, fileno $socket) or $self->fail("SSL filehandle association failed"); $self->_ssl_error("Can't initiate TLS/SSL handshake") unless Net::SSLeay::connect($ssl) == 1; if (defined (my $fpr = $self->{SSL_fingerprint})) { @@ -1296,7 +1340,7 @@ sub _getline($;$) { if (defined $ssl) { ($buf, $n) = Net::SSLeay::read($ssl, $BUFSIZE); } else { - $n = $stdout->sysread($buf, $BUFSIZE, 0); + $n = sysread($stdout, $buf, $BUFSIZE, 0); } $self->_ssl_error("Can't read: $!") unless defined $n; @@ -1495,7 +1539,7 @@ sub _cmd_flush($;$$) { while ($length > 0) { my $written = defined $ssl ? Net::SSLeay::write_partial($ssl, $offset, $length, $self->{_INBUF}) : - $stdin->syswrite($self->{_INBUF}, $length, $offset); + syswrite($stdin, $self->{_INBUF}, $length, $offset); $self->_ssl_error("Can't write: $!") unless defined $written and $written > 0; $offset += $written; |