1 files changed, 70 insertions, 4 deletions

diff --git a/guix/store.scm b/guix/store.scm
index 683f071a83..c94dfea959 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -23,7 +23,8 @@
   #:use-module (guix serialization)
   #:use-module (guix monads)
   #:use-module (guix base16)
-  #:autoload   (guix base32) (bytevector->base32-string)
+  #:use-module (guix base32)
+  #:use-module (guix hash)
   #:autoload   (guix build syscalls) (terminal-columns)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
@@ -133,6 +134,9 @@
             interned-file
 
             %store-prefix
+            store-path
+            output-path
+            fixed-output-path
             store-path?
             direct-store-path?
             derivation-path?
@@ -378,6 +382,11 @@
 (define (open-inet-socket host port)
   "Connect to the Unix-domain socket at HOST:PORT and return it.  Raise a
 '&nix-connection-error' upon error."
+  ;; Define 'TCP_NODELAY' on Guile 2.0.  The value is the same on all GNU
+  ;; systems.
+  (cond-expand (guile-2.2 #t)
+               (else      (define TCP_NODELAY 1)))
+
   (let ((sock (with-fluids ((%default-port-encoding #f))
                 ;; This trick allows use of the `scm_c_read' optimization.
                 (socket PF_UNIX SOCK_STREAM 0))))
@@ -398,6 +407,10 @@
            (catch 'system-error
              (lambda ()
                (connect s (addrinfo:addr ai))
+
+               ;; Setting this option makes a dramatic difference because it
+               ;; avoids the "ACK delay" on our RPC messages.
+               (setsockopt s IPPROTO_TCP TCP_NODELAY 1)
                s)
              (lambda args
                ;; Connection failed, so try one of the other addresses.
@@ -577,9 +590,7 @@ encoding conversion errors."
            (let* ((max-len (read-int p))
                   (data    (make-bytevector max-len))
                   (len     (get-bytevector-n! user-port data 0 max-len)))
-             (write-int len p)
-             (put-bytevector p data 0 len)
-             (write-padding len p)
+             (write-bytevector data p)
              #f))
           ((= k %stderr-next)
            ;; Log a string.  Build logs are usually UTF-8-encoded, but they
@@ -1237,6 +1248,10 @@ be used internally by the daemon's build hook."
 (define-alias store-return state-return)
 (define-alias store-bind state-bind)
 
+;; Instantiate templates for %STORE-MONAD since it's syntactically different
+;; from %STATE-MONAD.
+(template-directory instantiations %store-monad)
+
 (define (preserve-documentation original proc)
   "Return PROC with documentation taken from ORIGINAL."
   (set-object-property! proc 'documentation
@@ -1343,6 +1358,57 @@ connection, and return the result."
   ;; Absolute path to the Nix store.
   (make-parameter %store-directory))
 
+(define (compressed-hash bv size)                 ; `compressHash'
+  "Given the hash stored in BV, return a compressed version thereof that fits
+in SIZE bytes."
+  (define new (make-bytevector size 0))
+  (define old-size (bytevector-length bv))
+  (let loop ((i 0))
+    (if (= i old-size)
+        new
+        (let* ((j (modulo i size))
+               (o (bytevector-u8-ref new j)))
+          (bytevector-u8-set! new j
+                              (logxor o (bytevector-u8-ref bv i)))
+          (loop (+ 1 i))))))
+
+(define (store-path type hash name)               ; makeStorePath
+  "Return the store path for NAME/HASH/TYPE."
+  (let* ((s (string-append type ":sha256:"
+                           (bytevector->base16-string hash) ":"
+                           (%store-prefix) ":" name))
+         (h (sha256 (string->utf8 s)))
+         (c (compressed-hash h 20)))
+    (string-append (%store-prefix) "/"
+                   (bytevector->nix-base32-string c) "-"
+                   name)))
+
+(define (output-path output hash name)            ; makeOutputPath
+  "Return an output path for OUTPUT (the name of the output as a string) of
+the derivation called NAME with hash HASH."
+  (store-path (string-append "output:" output) hash
+              (if (string=? output "out")
+                  name
+                  (string-append name "-" output))))
+
+(define* (fixed-output-path name hash
+                            #:key
+                            (output "out")
+                            (hash-algo 'sha256)
+                            (recursive? #t))
+  "Return an output path for the fixed output OUTPUT defined by HASH of type
+HASH-ALGO, of the derivation NAME.  RECURSIVE? has the same meaning as for
+'add-to-store'."
+  (if (and recursive? (eq? hash-algo 'sha256))
+      (store-path "source" hash name)
+      (let ((tag (string-append "fixed:" output ":"
+                                (if recursive? "r:" "")
+                                (symbol->string hash-algo) ":"
+                                (bytevector->base16-string hash) ":")))
+        (store-path (string-append "output:" output)
+                    (sha256 (string->utf8 tag))
+                    name))))
+
 (define (store-path? path)
   "Return #t if PATH is a store path."
   ;; This is a lightweight check, compared to using a regexp, but this has to