From cb3b4fa24bbe271a517b50a3522bc5075d8fe6c7 Mon Sep 17 00:00:00 2001 From: Marc Cousin Date: Thu, 28 Feb 2019 14:33:29 +0200 Subject: [PATCH] Enable socket keep-alive on older Perl versions. The prior method depended on IO:Socket:SSL to push the keep-alive options down to the socket but it only worked for recent versions of the module. Instead, create the socket directly using IO::Socket::IP if available or IO:Socket:INET as a fallback. The keep-alive option is set directly on the socket before it is passed to IO:Socket:SSL. Contributed by Marc Cousin. --- doc/xml/release.xml | 13 ++++++++ lib/pgBackRest/Common/Http/Client.pm | 32 ++++++++++++------- src/perl/embed.auto.c | 31 +++++++++++------- .../Module/Storage/StorageS3CertPerlTest.pm | 4 +-- 4 files changed, 55 insertions(+), 25 deletions(-) diff --git a/doc/xml/release.xml b/doc/xml/release.xml index 568030621..b9b0b6d08 100644 --- a/doc/xml/release.xml +++ b/doc/xml/release.xml @@ -45,6 +45,14 @@

The archive-get command is implemented entirely in C.

+ + + + + +

Enable socket keep-alive on older Perl versions.

+ + @@ -6543,6 +6551,11 @@ mhagander + + Marc Cousin + marco44 + + Markus Nullmeier mnullmei diff --git a/lib/pgBackRest/Common/Http/Client.pm b/lib/pgBackRest/Common/Http/Client.pm index 2cb04654a..d6a406e02 100644 --- a/lib/pgBackRest/Common/Http/Client.pm +++ b/lib/pgBackRest/Common/Http/Client.pm @@ -97,25 +97,33 @@ sub new # Connect to the server my $oSocket; + if (eval{require IO::Socket::IP}) + { + $oSocket = IO::Socket::IP->new(PeerHost => $strHost, PeerPort => $iPort) + or confess &log(ERROR, "unable to create socket: $@", ERROR_HOST_CONNECT); + } + else + { + require IO::Socket::INET; + + $oSocket = IO::Socket::INET->new(PeerHost => $strHost, PeerPort => $iPort) + or confess &log(ERROR, "unable to create socket: $@", ERROR_HOST_CONNECT); + } + + setsockopt($oSocket, SOL_SOCKET,SO_KEEPALIVE, 1) + or confess &log(ERROR, "unable to set socket keepalive: $@", ERROR_HOST_CONNECT); + eval { - $oSocket = IO::Socket::SSL->new( - PeerHost => $strHost, PeerPort => $iPort, SSL_verify_mode => $bVerifySsl ? SSL_VERIFY_PEER : SSL_VERIFY_NONE, - SSL_ca_path => $strCaPath, SSL_ca_file => $strCaFile, Sockopts => [[SOL_SOCKET, SO_KEEPALIVE]]); - - return 1; + IO::Socket::SSL->start_SSL( + $oSocket, SSL_verify_mode => $bVerifySsl ? SSL_VERIFY_PEER : SSL_VERIFY_NONE, SSL_ca_path => $strCaPath, + SSL_ca_file => $strCaFile); } or do - { - logErrorResult(ERROR_HOST_CONNECT, $EVAL_ERROR); - }; - - # Check for errors - if (!defined($oSocket)) { logErrorResult( ERROR_HOST_CONNECT, coalesce(length($!) == 0 ? undef : $!, $SSL_ERROR), length($!) > 0 ? $SSL_ERROR : undef); - } + }; # Bless with new class $self = $class->SUPER::new( diff --git a/src/perl/embed.auto.c b/src/perl/embed.auto.c index fa93dcc97..adc6d36f3 100644 --- a/src/perl/embed.auto.c +++ b/src/perl/embed.auto.c @@ -5016,24 +5016,33 @@ static const EmbeddedModule embeddedModule[] = "\n" "my $oSocket;\n" "\n" + "if (eval{require IO::Socket::IP})\n" + "{\n" + "$oSocket = IO::Socket::IP->new(PeerHost => $strHost, PeerPort => $iPort)\n" + "or confess &log(ERROR, \"unable to create socket: $@\", ERROR_HOST_CONNECT);\n" + "}\n" + "else\n" + "{\n" + "require IO::Socket::INET;\n" + "\n" + "$oSocket = IO::Socket::INET->new(PeerHost => $strHost, PeerPort => $iPort)\n" + "or confess &log(ERROR, \"unable to create socket: $@\", ERROR_HOST_CONNECT);\n" + "}\n" + "\n" + "setsockopt($oSocket, SOL_SOCKET,SO_KEEPALIVE, 1)\n" + "or confess &log(ERROR, \"unable to set socket keepalive: $@\", ERROR_HOST_CONNECT);\n" + "\n" "eval\n" "{\n" - "$oSocket = IO::Socket::SSL->new(\n" - "PeerHost => $strHost, PeerPort => $iPort, SSL_verify_mode => $bVerifySsl ? SSL_VERIFY_PEER : SSL_VERIFY_NONE,\n" - "SSL_ca_path => $strCaPath, SSL_ca_file => $strCaFile, Sockopts => [[SOL_SOCKET, SO_KEEPALIVE]]);\n" - "\n" - "return 1;\n" + "IO::Socket::SSL->start_SSL(\n" + "$oSocket, SSL_verify_mode => $bVerifySsl ? SSL_VERIFY_PEER : SSL_VERIFY_NONE, SSL_ca_path => $strCaPath,\n" + "SSL_ca_file => $strCaFile);\n" "}\n" "or do\n" "{\n" - "logErrorResult(ERROR_HOST_CONNECT, $EVAL_ERROR);\n" - "};\n" - "\n\n" - "if (!defined($oSocket))\n" - "{\n" "logErrorResult(\n" "ERROR_HOST_CONNECT, coalesce(length($!) == 0 ? undef : $!, $SSL_ERROR), length($!) > 0 ? $SSL_ERROR : undef);\n" - "}\n" + "};\n" "\n\n" "$self = $class->SUPER::new(\n" "new pgBackRest::Common::Io::Handle('httpClient', $oSocket, $oSocket), $iProtocolTimeout, $lBufferMax);\n" diff --git a/test/lib/pgBackRestTest/Module/Storage/StorageS3CertPerlTest.pm b/test/lib/pgBackRestTest/Module/Storage/StorageS3CertPerlTest.pm index b3784229f..3e26e9d47 100644 --- a/test/lib/pgBackRestTest/Module/Storage/StorageS3CertPerlTest.pm +++ b/test/lib/pgBackRestTest/Module/Storage/StorageS3CertPerlTest.pm @@ -65,7 +65,7 @@ sub run # this bug gets fixed by Red Hat. UPDATE: The behavior changed here but it does not seems to be fixed. $self->testException( sub {storageRepo({strStanza => 'test1'})->list('/')}, ERROR_HOST_CONNECT, - 'IO::Socket::IP configuration failed error.*shutdown while in init', + 'SSL connect attempt failed with unknown error error.*certificate verify failed', 'cert verify fails on ' . VM_CO7); # It should work when verification is disabled @@ -104,7 +104,7 @@ sub run $self->testException( sub {storageRepo({strStanza => 'test4'})->list('/')}, ERROR_HOST_CONNECT, - $self->vm() eq VM_CO6 ? 'IO::Socket::INET configuration failed' : 'SSL_ca_path /bogus does not exist', + $self->vm() eq VM_CO6 ? 'SSL connect attempt failed with unknown error.*certificate verify failed' : 'No such file or directory', 'invalid ca path'); } }