5 files changed, 47 insertions(+), 2 deletions(-)

M doc/guix.texi
M guix/scripts/build.scm
M guix/scripts/package.scm
M guix/ui.scm
M tests/derivations.scm

@@ 596,7 596,8 @@ Use @var{profile} instead of the user's default profile.
 Show what would be done without actually doing it.
 
 @item --no-substitutes
-Build instead of resorting to pre-built substitutes.
+@itemx --max-silent-time=@var{seconds}
+Same as for @command{guix build} (@pxref{Invoking guix build}).
 
 @item --verbose
 Produce verbose output.  In particular, emit the environment's build log


@@ 1198,6 1199,10 @@ Do not build the derivations.
 @item --no-substitutes
 Build instead of resorting to pre-built substitutes.
 
+@item --max-silent-time=@var{seconds}
+When the build or substitution process remains silent for more than
+@var{seconds}, terminate it and report a build failure.
+
 @item --cores=@var{n}
 @itemx -c @var{n}
 Allow the use of up to @var{n} CPU cores for the build.  The special

@@ 59,6 59,7 @@ When SOURCE? is true, return the derivations of the package sources."
   ;; Alist of default option values.
   `((system . ,(%current-system))
     (substitutes? . #t)
+    (max-silent-time . 3600)
     (verbosity . 0)))
 
 (define (show-help)


@@ 79,6 80,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
   (display (_ "
       --no-substitutes   build instead of resorting to pre-built substitutes"))
   (display (_ "
+      --max-silent-time=SECONDS
+                         mark the build as failed after SECONDS of silence"))
+  (display (_ "
   -c, --cores=N          allow the use of up to N CPU cores for the build"))
   (display (_ "
   -r, --root=FILE        make FILE a symlink to the result, and register it


@@ 132,6 136,10 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                 (lambda (opt name arg result)
                   (alist-cons 'substitutes? #f
                               (alist-delete 'substitutes? result))))
+        (option '("max-silent-time") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'max-silent-time (string->number* arg)
+                              result)))
         (option '(#\r "root") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'gc-root arg result)))


@@ 246,6 254,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                              #:keep-failed? (assoc-ref opts 'keep-failed?)
                              #:build-cores (or (assoc-ref opts 'cores) 0)
                              #:use-substitutes? (assoc-ref opts 'substitutes?)
+                             #:max-silent-time (assoc-ref opts 'max-silent-time)
                              #:verbosity (assoc-ref opts 'verbosity))
 
           (if (assoc-ref opts 'derivations-only?)

@@ 413,6 413,7 @@ PACKAGES, in the context of PROFILE."
 (define %default-options
   ;; Alist of default option values.
   `((profile . ,%current-profile)
+    (max-silent-time . 3600)
     (substitutes? . #t)))
 
 (define (show-help)


@@ 439,6 440,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   (display (_ "
       --no-substitutes   build instead of resorting to pre-built substitutes"))
   (display (_ "
+      --max-silent-time=SECONDS
+                         mark the build as failed after SECONDS of silence"))
+  (display (_ "
       --bootstrap        use the bootstrap Guile to build the profile"))
   (display (_ "
       --verbose          produce verbose output"))


@@ 499,6 503,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                 (lambda (opt name arg result)
                   (alist-cons 'substitutes? #f
                               (alist-delete 'substitutes? result))))
+        (option '("max-silent-time") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'max-silent-time (string->number* arg)
+                              result)))
         (option '("bootstrap") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'bootstrap? #t result)))


@@ 902,7 910,9 @@ more information.~%"))
           (parameterize ((%store (open-connection)))
             (set-build-options (%store)
                                #:use-substitutes?
-                               (assoc-ref opts 'substitutes?))
+                               (assoc-ref opts 'substitutes?)
+                               #:max-silent-time
+                               (assoc-ref opts 'max-silent-time))
 
             (parameterize ((%guile-for-build
                             (package-derivation (%store)

@@ 38,6 38,7 @@
             leave
             show-version-and-exit
             show-bug-report-information
+            string->number*
             show-what-to-build
             call-with-error-handling
             with-error-handling


@@ 134,6 135,11 @@ Report bugs to: ~a.") %guix-bug-report-address)
 General help using GNU software: <http://www.gnu.org/gethelp/>"))
   (newline))
 
+(define (string->number* str)
+  "Like `string->number', but error out with an error message on failure."
+  (or (string->number str)
+      (leave (_ "~a: invalid number~%") str)))
+
 (define (call-with-error-handling thunk)
   "Call THUNK within a user-friendly error handler."
   (guard (c ((package-input-error? c)

@@ 353,6 353,21 @@
            (equal? '(hello guix)
                    (call-with-input-file (string-append p "/test") read))))))
 
+(test-assert "build-expression->derivation and max-silent-time"
+  (let* ((store      (let ((s (open-connection)))
+                       (set-build-options s #:max-silent-time 1)
+                       s))
+         (builder    '(sleep 100))
+         (drv-path   (build-expression->derivation %store "silent"
+                                                   (%current-system)
+                                                   builder '()))
+         (out-path   (derivation-path->output-path drv-path)))
+    (guard (c ((nix-protocol-error? c)
+               (and (string-contains (nix-protocol-error-message c)
+                                     "failed")
+                    (not (valid-path? store out-path)))))
+      (build-derivations %store (list drv-path)))))
+
 (test-assert "build-expression->derivation and derivation-prerequisites-to-build"
   (let-values (((drv-path drv)
                 (build-expression->derivation %store "fail" (%current-system)