Add timeout functionality to various phases (#255)

Allows a --fetch-timeout option which will end any downloading once X number of seconds have elapsed since the download was initially attempted. Defaults to 10 minutes for the general case, and 3 minutes when fetching the ecosystem. There is currently no way to override the ecosystem timeout yet though. Also allows --build-timeout, --extract-timeout, and --test-timeout which follow similar rules to the above but default to 60 minutes.
ugexe · Jun 5, 2018 · 5e1bd4c · 5e1bd4c
1 parent 8a3536a
commit 5e1bd4c
Show file tree

Hide file tree

Showing 10 changed files with 141 additions and 38 deletions.
diff --git a/README.pod b/README.pod
@@ -128,6 +128,15 @@ B<Options>
     # or set the default to all unset --force-* flags to True
     --force
 
+    # Set the timeout for corresponding phases
+    --fetch-timeout=600
+    --extract-timeout=3600
+    --build-timeout=3600
+    --test-timeout=3600
+
+    # or set the default to all unset --*-timeout flags to 0
+    --timeout=0
+
     # Do everything except the actual installations
     --dry
 

diff --git a/lib/Zef/Build.pm6 b/lib/Zef/Build.pm6
@@ -4,7 +4,7 @@ class Zef::Build does Pluggable {
     method needs-build($dist) {
         [||] self.plugins.map(*.needs-build($dist))
     }
-    method build($dist, :@includes, Supplier :$logger, :$meta) {
+    method build($dist, :@includes, Supplier :$logger, Int :$timeout, :$meta) {
         die "Can't build non-existent path: {$dist.path}" unless $dist.path.IO.e;
         my $builder = self.plugins.first(*.build-matcher($dist));
         die "No building backend available" unless ?$builder;
@@ -17,7 +17,13 @@ class Zef::Build does Pluggable {
             $builder.stderr.Supply.grep(*.defined).act: -> $err { $stdmerge ~= $err; $logger.emit({ level => ERROR,   stage => BUILD, phase => LIVE, message => $err }) }
         }
 
-        my @got = try $builder.build($dist, :@includes);
+        my $todo    = start { try $builder.build($dist, :@includes) };
+        my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new);
+        await Promise.anyof: $todo, $time-up;
+        $logger.emit({ level => DEBUG, stage => FETCH, phase => LIVE, message => "Building {$dist.path} timed out" })
+            if $time-up.so && $todo.not;
+
+        my @got = $todo.so ?? $todo.result !! False;
 
         $builder.stdout.done;
         $builder.stderr.done;

diff --git a/lib/Zef/CLI.pm6 b/lib/Zef/CLI.pm6
@@ -18,8 +18,13 @@ package Zef::CLI {
     @*ARGS = @*ARGS.map: { $_ eq '--depsonly' ?? '--deps-only' !! $_ }
 
     #| Download specific distributions
-    multi MAIN('fetch', Bool :force(:$force-fetch), *@identities ($, *@)) is export {
-        my $client = get-client(:config($CONFIG) :$force-fetch);
+    multi MAIN(
+        'fetch',
+        Bool :force(:$force-fetch),
+        Int  :timeout(:$fetch-timeout),
+        *@identities ($, *@)
+    ) is export {
+        my $client = get-client(:config($CONFIG), :$force-fetch, :$fetch-timeout);
         my @candidates = |$client.find-candidates(|@identities>>.&str2identity);
         abort "Failed to resolve any candidates. No reason to proceed" unless +@candidates;
         my @fetched    = |$client.fetch(|@candidates);
@@ -31,8 +36,13 @@ package Zef::CLI {
     }
 
     #| Run tests
-    multi MAIN('test', Bool :force(:$force-test), *@paths ($, *@)) is export {
-        my $client     = get-client(:config($CONFIG) :$force-test);
+    multi MAIN(
+        'test',
+        Bool :force(:$force-test),
+        Int  :timeout(:$test-timeout),
+        *@paths ($, *@)
+    ) is export {
+        my $client     = get-client(:config($CONFIG), :$force-test, :$test-timeout);
         my @candidates = |$client.link-candidates( @paths.map(*.&path2candidate) );
         abort "Failed to resolve any candidates. No reason to proceed" unless +@candidates;
         my @tested = |$client.test(|@candidates);
@@ -44,13 +54,18 @@ package Zef::CLI {
     }
 
     #| Run Build.pm
-    multi MAIN('build', Bool :force(:$force-build), *@paths ($, *@)) is export {
-        my $client = get-client(:config($CONFIG) :$force-build);
+    multi MAIN(
+        'build',
+        Bool :force(:$force-build),
+        Int  :timeout(:$build-timeout),
+        *@paths ($, *@)
+    ) is export {
+        my $client = get-client(:config($CONFIG), :$force-build, :$build-timeout);
         my @candidates = |$client.link-candidates( @paths.map(*.&path2candidate) );
         abort "Failed to resolve any candidates. No reason to proceed" unless +@candidates;
 
         my @built = |$client.build(|@candidates);
-        my (:@pass, :@fail) := @built.classify: {$_.?build-results !=== False ?? <pass> !! <fail> }
+        my (:@pass, :@fail) := @built.classify: {.?build-results.grep(*.so).elems ?? <pass> !! <fail> }
 
         say "!!!> Build failure: {.as}{?($verbosity >= VERBOSE)??' at '~.dist.path!!''}" for @fail;
 
@@ -73,6 +88,11 @@ package Zef::CLI {
         Bool :$force-build   = $force,
         Bool :$force-test    = $force,
         Bool :$force-install = $force,
+        Int  :$timeout,
+        Int  :$fetch-timeout   = $timeout,
+        Int  :$extract-timeout = $timeout,
+        Int  :$build-timeout   = $timeout,
+        Int  :$test-timeout    = $timeout,
         Bool :$dry,
         Bool :$update,
         Bool :$upgrade,
@@ -93,10 +113,12 @@ package Zef::CLI {
 
         my @excluded =  $exclude.map(*.&identity2spec);
         my $client   = get-client(
-            :config($CONFIG) :exclude(|@excluded),
-            :$depends,       :$test-depends, :$build-depends,
-            :$force-resolve, :$force-fetch,  :$force-extract,
-            :$force-build,   :$force-test,   :$force-install,
+            :config($CONFIG), :exclude(|@excluded),
+            :$depends,        :$test-depends,    :$build-depends,
+            :$force-resolve,  :$force-fetch,     :$force-extract,
+            :$force-build,    :$force-test,      :$force-install,
+            :$fetch-timeout,  :$extract-timeout, :$build-timeout,
+            :$test-timeout,
         );
 
         # LOCAL PATHS
@@ -219,12 +241,40 @@ package Zef::CLI {
     }
 
     #| Upgrade installed distributions (BETA)
-    multi MAIN('upgrade', :to(:$install-to) = $CONFIG<DefaultCUR>, *@identities) is export {
+    multi MAIN(
+        'upgrade',
+        Bool :$depends       = True,
+        Bool :$test-depends  = True,
+        Bool :$build-depends = True,
+        Bool :$force,
+        Bool :$force-resolve = $force,
+        Bool :$force-fetch   = $force,
+        Bool :$force-extract = $force,
+        Bool :$force-build   = $force,
+        Bool :$force-test    = $force,
+        Bool :$force-install = $force,
+        Int  :$timeout,
+        Int  :$fetch-timeout   = $timeout,
+        Int  :$extract-timeout = $timeout,
+        Int  :$build-timeout   = $timeout,
+        Int  :$test-timeout    = $timeout,
+        Bool :$dry,
+        :$exclude is copy,
+        :to(:$install-to) = $CONFIG<DefaultCUR>,
+        *@identities
+    ) is export {
         # XXX: This is a very inefficient prototype. Not sure how to handle an 'upgrade' when
         # multiple versions are already installed, so for now an 'upgrade' always means we
         # leave the previous version installed.
-
-        my $client = get-client(:config($CONFIG));
+        my @excluded =  $exclude.map(*.&identity2spec);
+        my $client   = get-client(
+            :config($CONFIG), :exclude(|@excluded),
+            :$depends,        :$test-depends,  :$build-depends,
+            :$force-resolve,  :$force-fetch,   :$force-extract,
+            :$force-build,    :$force-test,    :$force-install,
+            :$fetch-timeout,  :$extract-timeout, :$build-timeout,
+            :$test-timeout,
+        );
 
         my @missing = @identities.grep: { not $client.is-installed($_) };
         abort "Can't upgrade identities that aren't installed: {@missing.join(', ')}" if +@missing;
@@ -251,7 +301,7 @@ package Zef::CLI {
         say "===> Updating: " ~ @sorted-candidates.map(*.dist.identity).join(', ');
         my (:@upgraded, :@failed) := @sorted-candidates.map(*.uri).classify: -> $uri {
             my &*EXIT = sub ($code) { return $code == 0 ?? True !! False };
-            try { &MAIN('install', $uri) } ?? <upgraded> !! <failed>;
+            try { &MAIN('install', $uri, :$dry) } ?? <upgraded> !! <failed>;
         }
         abort "!!!> Failed upgrading *all* modules" unless +@upgraded;
 
@@ -507,6 +557,11 @@ package Zef::CLI {
         Bool :$force-build   = $force,
         Bool :$force-test    = $force,
         Bool :$force-install = $force,
+        Int  :$timeout,
+        Int  :$fetch-timeout   = $timeout,
+        Int  :$extract-timeout = $timeout,
+        Int  :$build-timeout   = $timeout,
+        Int  :$test-timeout    = $timeout,
         Bool :$update,
         Bool :$upgrade,
         Bool :$deps-only,
@@ -515,10 +570,11 @@ package Zef::CLI {
     ) is export {
         my @excluded = $exclude.map(*.&identity2spec);
         my $client   = get-client(
-            :config($CONFIG) :exclude(|@excluded),
-            :$depends,       :$test-depends, :$build-depends,
-            :$force-resolve, :$force-fetch,  :$force-extract,
-            :$force-build,   :$force-test,   :$force-install,
+            :config($CONFIG), :exclude(|@excluded),
+            :$depends,        :$test-depends,  :$build-depends,
+            :$force-resolve,  :$force-fetch,   :$force-extract,
+            :$force-build,    :$force-test,    :$force-install,
+            :$fetch-timeout,  :$build-timeout, :$test-timeout,
         );
 
         my @identities = $client.list-available.map(*.dist.identity).unique;
@@ -533,12 +589,20 @@ package Zef::CLI {
             :$test,
             :$fetch,
             :$build,
-            :$force,
             :$update,
             :$upgrade,
             :$deps-only,
             :$exclude,
             :$install-to,
+            :$force-resolve,
+            :$force-fetch,
+            :$force-build,
+            :$force-test,
+            :$force-install,
+            :$fetch-timeout,
+            :$extract-timeout,
+            :$build-timeout,
+            :$test-timeout,
         );
 
         for @identities -> $identity {
@@ -627,6 +691,7 @@ package Zef::CLI {
 
                 --install-to=[name]     Short name or spec of CompUnit::Repository to install to
                 --config-path=[path]    Load a specific Zef config file
+                --[phase]-timeout=[int] Set a timeout (in seconds) for the corresponding phase ( phase: fetch, extract, build, test )
 
             VERBOSITY LEVEL (from least to most verbose)
                 --error, --warn, --info (default), --verbose, --debug
@@ -647,9 +712,6 @@ package Zef::CLI {
                 Ignore errors occuring during the corresponding phase:
                 --force-resolve --force-fetch --force-extract --force-build --force-test --force-install
 
-                or enable all unset --force-* flags with:
-                --force
-
             CONFIGURATION {$CONFIG.IO.absolute}
                 Enable or disable plugins that match the configuration that has field `short-name` that matches <short-name>
 

diff --git a/lib/Zef/Client.pm6 b/lib/Zef/Client.pm6
@@ -33,6 +33,11 @@ class Zef::Client {
     has Bool $.force-test    is rw = False;
     has Bool $.force-install is rw = False;
 
+    has Int $.fetch-timeout   is rw = 600;
+    has Int $.extract-timeout is rw = 3600;
+    has Int $.build-timeout   is rw = 3600;
+    has Int $.test-timeout    is rw = 3600;
+
     has Bool $.depends       is rw = True;
     has Bool $.build-depends is rw = True;
     has Bool $.test-depends  is rw = True;
@@ -211,7 +216,7 @@ class Zef::Client {
             # It could be a file or url; $dist.source-url contains where the source was
             # originally located but we may want to use a local copy (while retaining
             # the original source-url for some other purpose like updating)
-            my $save-to    = $!fetcher.fetch($candi.uri, $stage-at, :$!logger);
+            my $save-to    = $!fetcher.fetch($candi.uri, $stage-at, :$!logger, :timeout($!fetch-timeout));
             my $relpath    = $stage-at.relative($tmp);
             my $extract-to = $!cache.IO.child($relpath);
 
@@ -265,7 +270,7 @@ class Zef::Client {
                 message => "Extraction: Failed to find a META6.json file for {$candi.dist.?identity // $candi.as} -- failure is likely",
             }) unless $meta6-prefix;
 
-            my $extracted-to = $!extractor.extract($candi.uri, $extract-to, :$!logger);
+            my $extracted-to = $!extractor.extract($candi.uri, $extract-to, :$!logger, :timeout($!extract-timeout));
 
             if !$extracted-to {
                 self.logger.emit({
@@ -319,7 +324,7 @@ class Zef::Client {
                 message => "Building: {$candi.dist.?identity // $candi.as}",
             });
 
-            my $result := $!builder.build($candi.dist, :includes($candi.dist.metainfo<includes> // []), :$!logger);
+            my $result := $!builder.build($candi.dist, :includes($candi.dist.metainfo<includes> // []), :$!logger, :timeout($!build-timeout)).cache;
 
             $candi does role :: { has $.build-results is rw = $result; };
 
@@ -360,7 +365,7 @@ class Zef::Client {
                 message => "Testing: {$candi.dist.?identity // $candi.as}",
             });
 
-            my $result := $!tester.test($candi.dist.path, :includes($candi.dist.metainfo<includes> // []), :$!logger).cache;
+            my $result := $!tester.test($candi.dist.path, :includes($candi.dist.metainfo<includes> // []), :$!logger, :timeout($!test-timeout)).cache;
 
             $candi does role :: { has $.test-results is rw = $result; };
 

diff --git a/lib/Zef/Extract.pm6 b/lib/Zef/Extract.pm6
@@ -2,7 +2,7 @@ use Zef;
 use Zef::Utils::FileSystem;
 
 class Zef::Extract does Pluggable {
-    method extract($path, $extract-to, Supplier :$logger) {
+    method extract($path, $extract-to, Supplier :$logger, Int :$timeout) {
         die "Can't extract non-existent path: {$path}" unless $path.IO.e;
         die "Can't extract to non-existent path: {$extract-to}" unless $extract-to.IO.e || $extract-to.IO.mkdir;
 
@@ -13,7 +13,14 @@ class Zef::Extract does Pluggable {
                 $extractor.stderr.Supply.act: -> $err { $logger.emit({ level => ERROR,   stage => EXTRACT, phase => LIVE, message => $err }) }
             }
 
-            my $out = lock-file-protect("{$extract-to}.lock", -> { try $extractor.extract($path, $extract-to) });
+            my $out = lock-file-protect("{$extract-to}.lock", -> {
+                my $todo    = start { try $extractor.extract($path, $extract-to) };
+                my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new);
+                await Promise.anyof: $todo, $time-up;
+                $logger.emit({ level => DEBUG, stage => FETCH, phase => LIVE, message => "Testing $path timed out" })
+                    if $time-up.so && $todo.not;
+                $todo.so ?? $todo.result !! Nil
+            });
 
             $extractor.stdout.done;
             $extractor.stderr.done;

diff --git a/lib/Zef/Fetch.pm6 b/lib/Zef/Fetch.pm6
@@ -3,7 +3,7 @@ use Zef::Utils::FileSystem;
 use Zef::Utils::URI;
 
 class Zef::Fetch does Pluggable {
-    method fetch($uri, $save-to, Supplier :$logger) {
+    method fetch($uri, $save-to, Supplier :$logger, Int :$timeout) {
         my $fetchers := self.plugins.grep(*.fetch-matcher($uri)).cache;
 
         unless +$fetchers {
@@ -21,7 +21,14 @@ class Zef::Fetch does Pluggable {
                 $fetcher.stderr.Supply.act: -> $err { $logger.emit({ level => ERROR,   stage => FETCH, phase => LIVE, message => $err }) }
             }
 
-            my $ret = lock-file-protect("{$save-to}.lock", -> { try $fetcher.fetch($uri, $save-to) });
+            my $ret = lock-file-protect("{$save-to}.lock", -> {
+                my $todo    = start { try $fetcher.fetch($uri, $save-to) };
+                my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new);
+                await Promise.anyof: $todo, $time-up;
+                $logger.emit({ level => DEBUG, stage => FETCH, phase => LIVE, message => "Fetching $uri timed out" })
+                    if $time-up.so && $todo.not;
+                $todo.so ?? $todo.result !! Nil;
+            });
 
             $fetcher.stdout.done;
             $fetcher.stderr.done;

diff --git a/lib/Zef/Repository/Ecosystems.pm6 b/lib/Zef/Repository/Ecosystems.pm6
@@ -38,7 +38,7 @@ class Zef::Repository::Ecosystems does Repository {
             KEEP self!gather-dists;
 
             my $save-as  = $!cache.IO.child($uri.IO.basename);
-            my $saved-as = try $!fetcher.fetch($uri, $save-as);
+            my $saved-as = try $!fetcher.fetch($uri, $save-as, :timeout(180));
             next unless $saved-as.?chars && $saved-as.IO.e;
 
             # this is kinda odd, but if $path is a file, then its fetching via http from p6c.org

diff --git a/lib/Zef/Repository/MetaCPAN.pm6 b/lib/Zef/Repository/MetaCPAN.pm6
@@ -77,7 +77,7 @@ class Zef::Repository::MetaCPAN does Repository {
             my $search-save-as = self.IO.child('search').IO.child("{time}.{$*THREAD.id}.json")
                 andthen {.parent.mkdir unless .parent.e};
 
-            my $response-path  = $!fetcher.fetch($search-url, ~$search-save-as);
+            my $response-path  = $!fetcher.fetch($search-url, ~$search-save-as, :timeout(180));
             next() R, note "!!!> MetaCPAN query failed to fetch [$search-url]"
                 unless $response-path && $response-path.IO.e;
             note "===> MetaCPAN query responded [$search-url]";

diff --git a/lib/Zef/Test.pm6 b/lib/Zef/Test.pm6
@@ -1,7 +1,7 @@
 use Zef;
 
 class Zef::Test does Pluggable {
-    method test($path, :@includes, Supplier :$logger) {
+    method test($path, :@includes, Supplier :$logger, Int :$timeout) {
         die "Can't test non-existent path: {$path}" unless $path.IO.e;
         my $testers := self.plugins.grep(*.test-matcher($path)).cache;
 
@@ -26,7 +26,13 @@ class Zef::Test does Pluggable {
             $tester.stderr.Supply.grep(*.defined).act: -> $err { save-test-output($err); $logger.emit({ level => ERROR,   stage => TEST, phase => LIVE, message => $err }) }
         }
 
-        my @got = try $tester.test($path, :@includes);
+        my $todo    = start { try $tester.test($path, :@includes) };
+        my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new);
+        await Promise.anyof: $todo, $time-up;
+        $logger.emit({ level => DEBUG, stage => FETCH, phase => LIVE, message => "Testing $path timed out" })
+            if $time-up.so && $todo.not;
+
+        my @got = $todo.so ?? $todo.result !! False;
 
         $tester.stdout.done;
         $tester.stderr.done;

diff --git a/resources/config.json b/resources/config.json
@@ -52,7 +52,8 @@
                 "mirrors" : [
                     "http://ecosystem-api.p6c.org/projects1.json",
                     "http://ecosystem-api.p6c.org/projects.json",
-                    "git://github.com/ugexe/Perl6-ecosystems.git"
+                    "git://github.com/ugexe/Perl6-ecosystems.git",
+                    "https://raw.githubusercontent.com/ugexe/Perl6-ecosystems/master/p6c1.json"
                 ]
             }
         },