ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-16 19:57:39 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

offload: Ignore EEXIST when registering a .drv as a GC root.

Browse source 
Fixes <http://bugs.gnu.org/18115>.
Reported by Mark H Weaver <mhw@netris.org>.

* guix/scripts/offload.scm (register-gc-root)[script]: Wrap 'symlink'
  call in "catch 'system-error", and ignore EEXIST errors.
This commit is contained in:
Ludovic Courtès 2014-08-29 14:53:15 +02:00
parent b1e48f222b
commit b9a31d90e9
1 changed files with 11 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
guix/scripts/offload.scm
View file

@ -316,8 +316,17 @@ (define script
(let ((root-directory (string-append %state-directory (let ((root-directory (string-append %state-directory
"/gcroots/tmp"))) "/gcroots/tmp")))
(false-if-exception (mkdir root-directory)) (false-if-exception (mkdir root-directory))
(catch 'system-error
(lambda ()
(symlink ,file (symlink ,file
(string-append root-directory "/" ,%gc-root-file))))) (string-append root-directory "/" ,%gc-root-file)))
(lambda args
;; If FILE already exists, we can assume that either it's a stale
;; reference (which is fine), or another process is already
;; building the derivation represented by FILE (which is fine
;; too.) Thus, do nothing in that case.
(unless (= EEXIST (system-error-errno args))
(apply throw args)))))))
(let ((pipe (remote-pipe machine OPEN_READ (let ((pipe (remote-pipe machine OPEN_READ
`("guile" "-c" ,(object->string script))))) `("guile" "-c" ,(object->string script)))))