02/04: store: Add 'system-error-to-connection-error' macro.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 3b5cd17a975d18ec200fa8cb835bcb58d3a61af8
Author: Ludovic Courtès <address@hidden>
Date:   Fri Apr 21 11:48:57 2017 +0200

    store: Add 'system-error-to-connection-error' macro.
    
    * guix/store.scm (system-error-to-connection-error): New macro.
    (open-unix-domain-socket): Use it instead of 'catch'.
---
 guix/store.scm | 29 +++++++++++++++++++----------
 1 file changed, 19 insertions(+), 10 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index bd07976..9eac220 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -351,6 +351,18 @@
   (message nix-protocol-error-message)
   (status  nix-protocol-error-status))
 
+(define-syntax-rule (system-error-to-connection-error file exp ...)
+  "Catch 'system-error' exceptions and translate them to
+'&nix-connection-error'."
+  (catch 'system-error
+    (lambda ()
+      exp ...)
+    (lambda args
+      (let ((errno (system-error-errno args)))
+        (raise (condition (&nix-connection-error
+                           (file file)
+                           (errno errno))))))))
+
 (define (open-unix-domain-socket file)
   "Connect to the Unix-domain socket at FILE and return it.  Raise a
 '&nix-connection-error' upon error."
@@ -359,16 +371,9 @@
              (socket PF_UNIX SOCK_STREAM 0)))
         (a (make-socket-address PF_UNIX file)))
 
-    (catch 'system-error
-      (lambda ()
-        (connect s a)
-        s)
-      (lambda args
-        ;; Translate the error to something user-friendly.
-        (let ((errno (system-error-errno args)))
-          (raise (condition (&nix-connection-error
-                             (file file)
-                             (errno errno)))))))))
+    (system-error-to-connection-error file
+      (connect s a)
+      s)))
 
 (define (connect-to-daemon uri)
   "Connect to the daemon at URI, a string that may be an actual URI or a file
@@ -1350,3 +1355,7 @@ must be an absolute store file name, or a derivation file 
name."
             ;; Return the first that works.
             (any (cut log-file store <>) derivers))
            (_ #f)))))
+
+;;; Local Variables:
+;;; eval: (put 'system-error-to-connection-error 'scheme-indent-function 1)
+;;; End: