From e87088c9d5fccaadb6a1b112b8791b5d0cd74a67 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Jun 2012 23:29:55 +0200 Subject: store: Raise error conditions upon protocol errors. * guix/store.scm (&nix-error, &nix-protocol-error): New SRFI-35 condition types. (process-stderr): Raise an error condition upon protocol errors instead of returning to the caller. This allows the connection to be reused for further interactions. --- guix/store.scm | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/store.scm b/guix/store.scm index db5679caf2..539aa61455 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -22,6 +22,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:export (nix-server? @@ -29,6 +31,11 @@ nix-server-minor-version nix-server-socket + &nix-error nix-error? + &nix-protocol-error nix-protocol-error? + nix-protocol-error-message + nix-protocol-error-status + open-connection set-build-options add-text-to-store @@ -218,6 +225,14 @@ (major nix-server-major-version) (minor nix-server-minor-version)) +(define-condition-type &nix-error &error + nix-error?) + +(define-condition-type &nix-protocol-error &nix-error + nix-protocol-error? + (message nix-protocol-error-message) + (status nix-protocol-error-status)) + (define* (open-connection #:optional (file %default-socket-path)) (let ((s (with-fluids ((%default-port-encoding #f)) ;; This trick allows use of the `scm_c_read' optimization. @@ -265,13 +280,15 @@ (status (if (>= (nix-server-minor-version server) 8) (read-int p) 1))) - (format (current-error-port) "error: ~a (status: ~a)~%" - error status) - error)) + (raise (condition (&nix-protocol-error + (message error) + (status status)))))) ((= k %stderr-last) #t) (else - (error "invalid standard error code" k))))) + (raise (condition (&nix-protocol-error + (message "invalid error code") + (status k)))))))) (define* (set-build-options server #:key keep-failed? keep-going? try-fallback? -- cgit v1.2.3