From 42415bcc5a689f45fcb32c77857c0cb1aaf6fece Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Tue, 26 Jul 2022 09:49:46 +0900 Subject: [PATCH 1/5] Implement a standard set of error checking of system(). At least the underlying error codes from http-client should be revealed to users as-is. GH #748: https://github.com/gugod/App-perlbrew/issues/748 --- lib/App/Perlbrew/HTTP.pm | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lib/App/Perlbrew/HTTP.pm b/lib/App/Perlbrew/HTTP.pm index e0a61689..7c69f9dd 100644 --- a/lib/App/Perlbrew/HTTP.pm +++ b/lib/App/Perlbrew/HTTP.pm @@ -101,7 +101,15 @@ sub http_download { } unless ($status == 0) { $path->unlink; - return "ERROR: Failed to execute the command\n\n\t$download_command\n\nReason:\n\n\t$?"; + if ($? == -1) { + return "ERROR: Failed to execute the command\n\n\t$download_command\n\nReason:\n\n\t$!"; + } + elsif ($? & 127) { + return "ERROR: The command died with signal " . ($? & 127) . "\n\n\t$download_command\n\n"; + } + else { + return "ERROR: The command finished with error\n\n\t$download_command\n\nReason:\n\n\t" . ($? >> 8); + } } return 0; } From d27d6584ca1a0933f446f1e6b1381ee99e134ff0 Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Tue, 26 Jul 2022 21:24:27 +0900 Subject: [PATCH 2/5] mimic system() failure in order to test http_download --- t/error-curl-exit-nonzero.t | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 t/error-curl-exit-nonzero.t diff --git a/t/error-curl-exit-nonzero.t b/t/error-curl-exit-nonzero.t new file mode 100644 index 00000000..483a169a --- /dev/null +++ b/t/error-curl-exit-nonzero.t @@ -0,0 +1,29 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use Test::More; +use Test::Exception; +use File::Temp qw(tempdir); + +my $actual_status_code = 42; + +BEGIN { + *CORE::GLOBAL::system = sub { + return $? = $actual_status_code << 8; + }; +} + +use App::Perlbrew::Path; +use App::Perlbrew::HTTP qw(http_download); + +local $ENV{PERLBREW_ROOT} = $App::perlbrew::PERLBREW_ROOT = tempdir( CLEANUP => 1 ); + +subtest "The exit status code of curl", sub { + my $error = http_download( "https://example.com/whatever.tar.gz", + App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT)->child("whatever.tar.gz") ); + + like $error, qr/^ERROR .+ Reason .+ ${actual_status_code}/xs; +}; + +done_testing; From e918577a0603510f7b70a8287878db8c56b4b505 Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Tue, 26 Jul 2022 21:27:00 +0900 Subject: [PATCH 3/5] tidy-up the imports --- t/error-curl-exit-nonzero.t | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/t/error-curl-exit-nonzero.t b/t/error-curl-exit-nonzero.t index 483a169a..e5478c5a 100644 --- a/t/error-curl-exit-nonzero.t +++ b/t/error-curl-exit-nonzero.t @@ -2,9 +2,8 @@ use strict; use warnings; -use Test::More; -use Test::Exception; -use File::Temp qw(tempdir); +use Test::More import => [ qw( done_testing like subtest ) ]; +use File::Temp qw( tempdir ); my $actual_status_code = 42; From 6b6be6d21e0c9bf88c755a690f2e54db699d79ae Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Thu, 28 Jul 2022 07:14:24 +0900 Subject: [PATCH 4/5] simulate the error case when system() returns -1 --- t/error-http_download-exec-error.t | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100644 t/error-http_download-exec-error.t diff --git a/t/error-http_download-exec-error.t b/t/error-http_download-exec-error.t new file mode 100644 index 00000000..3970f545 --- /dev/null +++ b/t/error-http_download-exec-error.t @@ -0,0 +1,26 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use Test::More import => [ qw( done_testing like subtest ) ]; +use File::Temp qw( tempdir ); + +BEGIN { + *CORE::GLOBAL::system = sub { + return $? = -1 + }; +} + +use App::Perlbrew::Path; +use App::Perlbrew::HTTP qw(http_download); + +local $ENV{PERLBREW_ROOT} = $App::perlbrew::PERLBREW_ROOT = tempdir( CLEANUP => 1 ); + +subtest "The exit status code of curl", sub { + my $error = http_download( "https://example.com/whatever.tar.gz", + App::Perlbrew::Path->new($App::perlbrew::PERLBREW_ROOT)->child("whatever.tar.gz") ); + + like $error, qr/^ERROR: Failed to execute the command/; +}; + +done_testing; From b39170d4e4aa5d85c17af843e05e24599ce757dc Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Thu, 28 Jul 2022 07:14:56 +0900 Subject: [PATCH 5/5] rename properly --- ...ror-curl-exit-nonzero.t => error-http_download-exit-nonzero.t} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename t/{error-curl-exit-nonzero.t => error-http_download-exit-nonzero.t} (100%) diff --git a/t/error-curl-exit-nonzero.t b/t/error-http_download-exit-nonzero.t similarity index 100% rename from t/error-curl-exit-nonzero.t rename to t/error-http_download-exit-nonzero.t