01/04: store: 'GUIX_DAEMON_SOCKET' can now be a URI.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 1397b422e254929de1805aaf1d0759cd5da6a60b
Author: Ludovic Courtès <address@hidden>
Date:   Fri Apr 21 11:39:49 2017 +0200

    store: 'GUIX_DAEMON_SOCKET' can now be a URI.
    
    * guix/store.scm (%daemon-socket-file): Rename to...
    (%daemon-socket-uri): ... this.
    (connect-to-daemon): New procedure.
    (open-connection): Rename 'file' to 'uri'.  Use 'connect-to-daemon'
    instead of 'open-unix-domain-socket'.
    * guix/tests.scm (open-connection-for-tests): Rename 'file' to 'uri'.
    * tests/guix-build.sh: Add tests.
    * tests/store.scm ("open-connection with file:// URI"): New tests.
---
 doc/guix.texi       | 26 +++++++++++++++++++++++---
 guix/store.scm      | 36 ++++++++++++++++++++++++++++--------
 guix/tests.scm      |  6 +++---
 tests/guix-build.sh |  8 ++++++++
 tests/store.scm     |  8 ++++++++
 5 files changed, 70 insertions(+), 14 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 753c399..5f973e2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3666,10 +3666,30 @@ accidental modifications.
 @end quotation
 
 The @code{(guix store)} module provides procedures to connect to the
-daemon, and to perform RPCs.  These are described below.
+daemon, and to perform RPCs.  These are described below.  By default,
address@hidden, and thus all the @command{guix} commands,
+connect to the local daemon or to the URI specified by the
address@hidden environment variable.
 
address@hidden {Scheme Procedure} open-connection address@hidden 
[#:reserve-space? #t]
-Connect to the daemon over the Unix-domain socket at @var{file}.  When
address@hidden {Environment Variable} GUIX_DAEMON_SOCKET
+When set, the value of this variable should be a file name or a URI
+designating the daemon endpoint.  When it is a file name, it denotes a
+Unix-domain socket to connect to.  In addition to file names, the
+supported URI schemes are:
+
address@hidden @code
address@hidden file
address@hidden unix
+These are for Unix-domain sockets.
address@hidden:///var/guix/daemon-socket/socket} is equivalent to
address@hidden/var/guix/daemon-socket/socket}.
address@hidden table
+
+Additional URI schemes may be supported in the future.
address@hidden defvr
+
address@hidden {Scheme Procedure} open-connection address@hidden 
[#:reserve-space? #t]
+Connect to the daemon over the Unix-domain socket at @var{uri} (a string).  
When
 @var{reserve-space?} is true, instruct it to reserve a little bit of
 extra space on the file system so that the garbage collector can still
 operate should the disk become full.  Return a server object.
diff --git a/guix/store.scm b/guix/store.scm
index 2f05351..bd07976 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -39,7 +39,8 @@
   #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 popen)
-  #:export (%daemon-socket-file
+  #:use-module (web uri)
+  #:export (%daemon-socket-uri
             %gc-roots-directory
             %default-substitute-urls
 
@@ -216,8 +217,8 @@
 (define %default-socket-path
   (string-append %state-directory "/daemon-socket/socket"))
 
-(define %daemon-socket-file
-  ;; File name of the socket the daemon listens too.
+(define %daemon-socket-uri
+  ;; URI or file name of the socket the daemon listens too.
   (make-parameter (or (getenv "GUIX_DAEMON_SOCKET")
                       %default-socket-path)))
 
@@ -369,10 +370,29 @@
                              (file file)
                              (errno errno)))))))))
 
-(define* (open-connection #:optional (file (%daemon-socket-file))
+(define (connect-to-daemon uri)
+  "Connect to the daemon at URI, a string that may be an actual URI or a file
+name."
+  (define connect
+    (match (string->uri uri)
+      (#f                                         ;URI is a file name
+       open-unix-domain-socket)
+      ((? uri? uri)
+       (match (uri-scheme uri)
+         ((or #f 'file 'unix)
+          (lambda (_)
+            (open-unix-domain-socket (uri-path uri))))
+         (x
+          (raise (condition (&nix-connection-error
+                             (file (uri->string uri))
+                             (errno ENOTSUP)))))))))
+
+  (connect uri))
+
+(define* (open-connection #:optional (uri (%daemon-socket-uri))
                           #:key port (reserve-space? #t) cpu-affinity)
-  "Connect to the daemon over the Unix-domain socket at FILE, or, if PORT is
-not #f, use it as the I/O port over which to communicate to a build daemon.
+  "Connect to the daemon at URI (a string), or, if PORT is not #f, use it as
+the I/O port over which to communicate to a build daemon.
 
 When RESERVE-SPACE? is true, instruct it to reserve a little bit of extra
 space on the file system so that the garbage collector can still operate,
@@ -383,10 +403,10 @@ for this connection will be pinned.  Return a server 
object."
              ;; One of the 'write-' or 'read-' calls below failed, but this is
              ;; really a connection error.
              (raise (condition
-                     (&nix-connection-error (file (or port file))
+                     (&nix-connection-error (file (or port uri))
                                             (errno EPROTO))
                      (&message (message "build daemon handshake failed"))))))
-    (let ((port (or port (open-unix-domain-socket file))))
+    (let ((port (or port (connect-to-daemon uri))))
       (write-int %worker-magic-1 port)
       (let ((r (read-int port)))
         (and (eqv? r %worker-magic-2)
diff --git a/guix/tests.scm b/guix/tests.scm
index 5110075..34e3e0f 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56,13 +56,13 @@
    (or (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") list)
        '())))
 
-(define* (open-connection-for-tests #:optional (file (%daemon-socket-file)))
+(define* (open-connection-for-tests #:optional (uri (%daemon-socket-uri)))
   "Open a connection to the build daemon for tests purposes and return it."
   (guard (c ((nix-error? c)
              (format (current-error-port)
                      "warning: build daemon error: ~s~%" c)
              #f))
-    (let ((store (open-connection file)))
+    (let ((store (open-connection uri)))
       ;; Make sure we build everything by ourselves.
       (set-build-options store
                          #:use-substitutes? #f
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index ab911b7..9494e73 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -36,6 +36,14 @@ guix build -e '(@@ (gnu packages bootstrap) 
%bootstrap-guile)' |     \
 guix build hello -d |                          \
     grep -e '-hello-[0-9\.]\+\.drv$'
 
+# Passing a URI.
+GUIX_DAEMON_SOCKET="file://$NIX_STATE_DIR/daemon-socket/socket"        \
+guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
+
+( if GUIX_DAEMON_SOCKET="weird://uri"                                  \
+     guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)';   \
+  then exit 1; fi )
+
 # Check --sources option with its arguments
 module_dir="t-guix-build-$$"
 mkdir "$module_dir"
diff --git a/tests/store.scm b/tests/store.scm
index 45150d3..3eb8b7b 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -48,6 +48,14 @@
 
 (test-begin "store")
 
+(test-assert "open-connection with file:// URI"
+  (let ((store (open-connection (string-append "file://"
+                                               (%daemon-socket-uri)))))
+    (and (add-text-to-store store "foo" "bar")
+         (begin
+           (close-connection store)
+           #t))))
+
 (test-equal "connection handshake error"
   EPROTO
   (let ((port (%make-void-port "rw")))