summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-05-20 18:14:55 +0200
committerLudovic Courtès <ludo@gnu.org>2013-05-20 18:29:26 +0200
commit969e678ed9f907764e6412386432dfbddf493f71 (patch)
tree1e03fb0df41eb9d278dd4d75cc57fdf34c79327e
parentd8482ad0d613758b85fdff90c5d6d6d2785564bf (diff)
downloadguix-969e678ed9f907764e6412386432dfbddf493f71.tar.gz
Add `--max-silent-time' to `guix build' and `guix package'.
* guix/scripts/build.scm (%default-options): Add default
  `max-silent-time' value.
  (show-help, %options):  Add `--max-silent-time'.
  (guix-build): Pass `max-silent-time' to `set-build-options'.
* guix/scripts/package.scm (%default-options): Add default
  `max-silent-time' value.
  (show-help, %options):  Add `--max-silent-time'.
  (guix-package): Pass `max-silent-time' to `set-build-options'.
* guix/ui.scm (string->number*): New procedure.
* tests/derivations.scm ("build-expression->derivation and
  max-silent-time"): New test.
* doc/guix.texi (Invoking guix package, Invoking guix build): Document
  `--max-silent-time'.
-rw-r--r--doc/guix.texi7
-rw-r--r--guix/scripts/build.scm9
-rw-r--r--guix/scripts/package.scm12
-rw-r--r--guix/ui.scm6
-rw-r--r--tests/derivations.scm15
5 files changed, 47 insertions, 2 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 54325a5b16..c3aab812e2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 4464d84dfc..ca2fe46e98 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -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?)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 7fda71e7e9..e68d0dd902 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -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)
diff --git a/guix/ui.scm b/guix/ui.scm
index 6d81475812..cf94aa0818 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -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)
diff --git a/tests/derivations.scm b/tests/derivations.scm
index a50c1af878..0cba98e1e8 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -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)