offload: Better report failure to create the GC root directory.

Suggested by Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>.

* guix/scripts/offload.scm (register-gc-root)[script]: Replace
  'false-if-exception' with a finer-grain 'system-error handler.
  Provide the name of MACHINE in 'leave' error message.
This commit is contained in:
Ludovic Courtès 2015-02-05 23:36:23 +01:00
parent 7d157c652c
commit 353e34a626
1 changed files with 9 additions and 2 deletions

View File

@ -310,7 +310,14 @@ hook."
;; directory. ;; directory.
(let ((root-directory (string-append %state-directory (let ((root-directory (string-append %state-directory
"/gcroots/tmp"))) "/gcroots/tmp")))
(false-if-exception (mkdir root-directory)) (catch 'system-error
(lambda ()
(mkdir root-directory))
(lambda args
(unless (= EEXIST (system-error-errno args))
(error "failed to create remote GC root directory"
root-directory (system-error-errno args)))))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(symlink ,file (symlink ,file
@ -331,7 +338,7 @@ hook."
;; Better be safe than sorry: if we ignore the error here, then FILE ;; Better be safe than sorry: if we ignore the error here, then FILE
;; may be GC'd just before we start using it. ;; may be GC'd just before we start using it.
(leave (_ "failed to register GC root for '~a' on '~a' (status: ~a)~%") (leave (_ "failed to register GC root for '~a' on '~a' (status: ~a)~%")
file machine status))))) file (build-machine-name machine) status)))))
(define (remove-gc-roots machine) (define (remove-gc-roots machine)
"Remove from MACHINE the GC roots previously installed with "Remove from MACHINE the GC roots previously installed with