mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-19 05:57:04 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

ui: Do not call 'port-filename' on closed file ports.

Browse source 
* guix/ui.scm (call-with-error-handling)[port-filename*]: New
procedure.
Use it in the 'nar-error?' case.
This commit is contained in:
Ludovic Courtès 2016-03-09 23:37:12 +01:00
parent 8bcdc23fd0
commit bec7f35214
1 changed files with 8 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
guix/ui.scm
View file

@ -410,6 +410,12 @@ (define unit
(define (call-with-error-handling thunk) (define (call-with-error-handling thunk)
"Call THUNK within a user-friendly error handler." "Call THUNK within a user-friendly error handler."
(define (port-filename* port)
;; 'port-filename' returns #f for non-file ports, but it raises an
;; exception for file ports that are closed. Work around that.
(and (not (port-closed? port))
(port-filename port)))
(guard (c ((package-input-error? c) (guard (c ((package-input-error? c)
(let* ((package (package-error-package c)) (let* ((package (package-error-package c))
(input (package-error-invalid-input c)) (input (package-error-invalid-input c))
@ -440,9 +446,9 @@ (define (call-with-error-handling thunk)
(port (nar-error-port c))) (port (nar-error-port c)))
(if file (if file
(leave (_ "corrupt input while restoring '~a' from ~s~%") (leave (_ "corrupt input while restoring '~a' from ~s~%")
file (or (port-filename port) port)) file (or (port-filename* port) port))
(leave (_ "corrupt input while restoring archive from ~s~%") (leave (_ "corrupt input while restoring archive from ~s~%")
(or (port-filename port) port))))) (or (port-filename* port) port)))))
((nix-connection-error? c) ((nix-connection-error? c)
(leave (_ "failed to connect to `~a': ~a~%") (leave (_ "failed to connect to `~a': ~a~%")
(nix-connection-error-file c) (nix-connection-error-file c)