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

store: 'register-path' no longer swallows 'system-error' exceptions.

Browse source 
* guix/store.scm (register-path): Do not catch 'system-error'.
This commit is contained in:
Ludovic Courtès 2016-06-19 21:29:43 +02:00
parent e0b47290a7
commit 95fa173ed1
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
guix/store.scm
View file

@ -1061,24 +1061,19 @@ (define* (register-path path
Use with care as it directly modifies the store! This is primarily meant to
be used internally by the daemon's build hook."
;; Currently this is implemented by calling out to the fine C++ blob.
(catch 'system-error
(lambda ()
(let ((pipe (apply open-pipe* OPEN_WRITE %guix-register-program
`(,@(if prefix
`("--prefix" ,prefix)
'())
,@(if state-directory
`("--state-directory" ,state-directory)
'())))))
(and pipe
(begin
(format pipe "~a~%~a~%~a~%"
path (or deriver "") (length references))
(for-each (cut format pipe "~a~%" <>) references)
(zero? (close-pipe pipe))))))
(lambda args
;; Failed to run %GUIX-REGISTER-PROGRAM.
#f)))
(let ((pipe (apply open-pipe* OPEN_WRITE %guix-register-program
`(,@(if prefix
`("--prefix" ,prefix)
'())
,@(if state-directory
`("--state-directory" ,state-directory)
'())))))
(and pipe
(begin
(format pipe "~a~%~a~%~a~%"
path (or deriver "") (length references))
(for-each (cut format pipe "~a~%" <>) references)
(zero? (close-pipe pipe))))))
;;;