Split (guix) in (guix store) and (guix derivations).

* guix.scm: Move contents to other files.  Just aggregate these.
* guix/derivations.scm, guix/store.scm: New files.

3 files changed, 585 insertions, 504 deletions

diff --git a/guix.scm b/guix.scm
index 2e5c008310..8a55f43444 100644
--- a/guix.scm
+++ b/guix.scm
@@ -16,510 +16,17 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-(define-module (guix)
-  #:use-module (rnrs bytevectors)
-  #:use-module (rnrs io ports)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-26)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 rdelim)
-  #:export (nix-server?
-            nix-server-major-version
-            nix-server-minor-version
-            nix-server-socket
+(define-module (guix))
 
-            open-connection
-            set-build-options
-            add-text-to-store
-            add-to-store))
+;; The composite module that re-exports everything from the public modules.
 
-(define %protocol-version #x109)
+(eval-when (eval load compile)
+  (begin
+    (define %public-modules
+      '(store
+        derivations))
 
-(define %worker-magic-1 #x6e697863)
-(define %worker-magic-2 #x6478696f)
-
-(define (protocol-major magic)
-  (logand magic #xff00))
-(define (protocol-minor magic)
-  (logand magic #x00ff))
-
-(define-syntax define-enumerate-type
-  (syntax-rules ()
-    ((_ name->int (name id) ...)
-     (define-syntax name->int
-       (syntax-rules (name ...)
-         ((_ name) id) ...)))))
-
-(define-enumerate-type operation-id
-  ;; operation numbers from worker-protocol.hh
-  (quit 0)
-  (valid-path? 1)
-  (has-substitutes? 3)
-  (query-path-hash 4)
-  (query-references 5)
-  (query-referrers 6)
-  (add-to-store 7)
-  (add-text-to-store 8)
-  (build-derivations 9)
-  (ensure-path 10)
-  (add-temp-root 11)
-  (add-indirect-root 12)
-  (sync-with-gc 13)
-  (find-roots 14)
-  (export-path 16)
-  (query-deriver 18)
-  (set-options 19)
-  (collect-garbage 20)
-  (query-substitutable-path-info 21)
-  (query-derivation-outputs 22)
-  (query-valid-paths 23)
-  (query-failed-paths 24)
-  (clear-failed-paths 25)
-  (query-path-info 26)
-  (import-paths 27)
-  (query-derivation-output-names 28))
-
-(define-enumerate-type hash-algo
-  ;; hash.hh
-  (md5 1)
-  (sha1 2)
-  (sha256 3))
-
-(define %nix-state-dir "/nix/var/nix")
-(define %default-socket-path
-  (string-append %nix-state-dir "/daemon-socket/socket"))
-
-
-;; serialize.cc
-
-(define (write-int n p)
-  (let ((b (make-bytevector 8 0)))
-    (bytevector-u32-set! b 0 n (endianness little))
-    (put-bytevector p b)))
-
-(define (read-int p)
-  (let ((b (get-bytevector-n p 8)))
-    (bytevector-u32-ref b 0 (endianness little))))
-
-(define (write-long-long n p)
-  (let ((b (make-bytevector 8 0)))
-    (bytevector-u64-set! b 0 n (endianness little))
-    (put-bytevector p b)))
-
-(define write-padding
-  (let ((zero (make-bytevector 8 0)))
-    (lambda (n p)
-      (let ((m (modulo n 8)))
-        (or (zero? m)
-            (put-bytevector p zero 0 (- 8 m)))))))
-
-(define (write-string s p)
-  (let ((b (string->utf8 s)))
-    (write-int (bytevector-length b) p)
-    (put-bytevector p b)
-    (write-padding (bytevector-length b) p)))
-
-(define (read-string p)
-  (let* ((len (read-int p))
-         (m   (modulo len 8))
-         (bv  (get-bytevector-n p len))
-         (str (utf8->string bv)))
-    (or (zero? m)
-        (get-bytevector-n p (- 8 m)))
-    str))
-
-(define (write-string-list l p)
-  (write-int (length l) p)
-  (for-each (cut write-string <> p) l))
-
-(define (read-store-path p)
-  (read-string p))                                ; TODO: assert path
-
-(define (write-contents file p)
-  "Write the contents of FILE to output port P."
-  (define (dump in size)
-    (define buf-size 65536)
-    (define buf (make-bytevector buf-size))
-
-    (let loop ((left size))
-      (if (<= left 0)
-          0
-          (let ((read (get-bytevector-n! in buf 0 buf-size)))
-            (if (eof-object? read)
-                left
-                (begin
-                  (put-bytevector p buf 0 read)
-                  (loop (- left read))))))))
-
-  (let ((size (stat:size (lstat file))))
-    (write-string "contents" p)
-    (write-long-long size p)
-    (call-with-input-file file
-      (lambda (p)
-        (dump p size)))
-    (write-padding size p)))
-
-(define (write-file f p)
-  (define %archive-version-1 "nix-archive-1")
-
-  (let ((s (lstat f)))
-    (write-string %archive-version-1 p)
-    (write-string "(" p)
-    (case (stat:type s)
-      ((regular)
-       (write-string "type" p)
-       (write-string "regular" p)
-       (if (not (zero? (logand (stat:mode s) #o100)))
-           (begin
-             (write-string "executable" p)
-             (write-string "" p)))
-       (write-contents f p)
-       (write-string ")" p))
-      ((directory)
-       (write-string "type" p)
-       (write-string "directory" p)
-       (error "ENOSYS"))
-      (else
-       (error "ENOSYS")))))
-
-(define-syntax write-arg
-  (syntax-rules (integer boolean file string string-list)
-    ((_ integer arg p)
-     (write-int arg p))
-    ((_ boolean arg p)
-     (write-int (if arg 1 0) p))
-    ((_ file arg p)
-     (write-file arg p))
-    ((_ string arg p)
-     (write-string arg p))
-    ((_ string-list arg p)
-     (write-string-list arg p))))
-
-(define-syntax read-arg
-  (syntax-rules (integer boolean string store-path)
-    ((_ integer p)
-     (read-int p))
-    ((_ boolean p)
-     (not (zero? (read-int p))))
-    ((_ string p)
-     (read-string p))
-    ((_ store-path p)
-     (read-store-path p))))
-
-
-;; remote-store.cc
-
-(define-record-type <nix-server>
-  (%make-nix-server socket major minor)
-  nix-server?
-  (socket nix-server-socket)
-  (major  nix-server-major-version)
-  (minor  nix-server-minor-version))
-
-(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.
-             (socket PF_UNIX SOCK_STREAM 0)))
-        (a (make-socket-address PF_UNIX file)))
-    (connect s a)
-    (write-int %worker-magic-1 s)
-    (let ((r (read-int s)))
-      (and (eqv? r %worker-magic-2)
-           (let ((v (read-int s)))
-             (and (eqv? (protocol-major %protocol-version)
-                        (protocol-major v))
-                  (begin
-                    (write-int %protocol-version s)
-                    (let ((s (%make-nix-server s
-                                               (protocol-major v)
-                                               (protocol-minor v))))
-                      (process-stderr s)
-                      s))))))))
-
-(define (process-stderr server)
-  (define p
-    (nix-server-socket server))
-
-  ;; magic cookies from worker-protocol.hh
-  (define %stderr-next  #x6f6c6d67)
-  (define %stderr-read  #x64617461)               ; data needed from source
-  (define %stderr-write #x64617416)               ; data for sink
-  (define %stderr-last  #x616c7473)
-  (define %stderr-error #x63787470)
-
-  (let ((k (read-int p)))
-    (cond ((= k %stderr-write)
-           (read-string p))
-          ((= k %stderr-read)
-           (let ((len (read-int p)))
-             (read-string p)                      ; FIXME: what to do?
-             ))
-          ((= k %stderr-next)
-           (let ((s (read-string p)))
-             (display s (current-error-port))
-             s))
-          ((= k %stderr-error)
-           (let ((error  (read-string p))
-                 (status (if (>= (nix-server-minor-version server) 8)
-                             (read-int p)
-                             1)))
-             (format (current-error-port) "error: ~a (status: ~a)~%"
-                     error status)
-             error))
-          ((= k %stderr-last)
-           #t)
-          (else
-           (error "invalid standard error code" k)))))
-
-(define* (set-build-options server
-                            #:key keep-failed? keep-going? try-fallback?
-                            (verbosity 0)
-                            (max-build-jobs (current-processor-count))
-                            (max-silent-time 3600)
-                            (use-build-hook? #t)
-                            (build-verbosity 0)
-                            (log-type 0)
-                            (print-build-trace #t))
-  ;; Must be called after `open-connection'.
-
-  (define socket
-    (nix-server-socket server))
-
-  (let-syntax ((send (syntax-rules ()
-                       ((_ option ...)
-                        (for-each (lambda (i)
-                                    (cond ((boolean? i)
-                                           (write-int (if i 1 0) socket))
-                                          ((integer? i)
-                                           (write-int i socket))
-                                          (else
-                                           (error "invalid build option"
-                                                  i))))
-                                  (list option ...))))))
-    (send (operation-id set-options)
-          keep-failed? keep-going? try-fallback? verbosity
-          max-build-jobs max-silent-time)
-    (if (>= (nix-server-minor-version server) 2)
-        (send use-build-hook?))
-    (if (>= (nix-server-minor-version server) 4)
-        (send build-verbosity log-type print-build-trace))
-    (process-stderr server)))
-
-(define-syntax define-operation
-  (syntax-rules ()
-    ((_ (name (type arg) ...) docstring return)
-     (define (name server arg ...)
-       docstring
-       (let ((s (nix-server-socket server)))
-         (write-int (operation-id name) s)
-         (write-arg type arg s)
-         ...
-         (process-stderr server)
-         (read-arg return s))))))
-
-(define-operation (add-text-to-store (string name) (string text)
-                                     (string-list references))
-  "Add TEXT under file NAME in the store."
-  store-path)
-
-(define-operation (add-to-store (string basename)
-                                (integer algo)
-                                (boolean sha256-and-recursive?)
-                                (boolean recursive?)
-                                (file file-name))
-  "Add the contents of FILE-NAME under BASENAME to the store."
-  store-path)
-
-(define-operation (build-derivations (string-list derivations))
-  "Build DERIVATIONS; return #t on success."
-  boolean)
-
-
-;; derivations
-
-(define-record-type <derivation>
-  (make-derivation outputs inputs sources system builder args env-vars)
-  derivation?
-  (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
-  (inputs   derivation-inputs)       ; list of <derivation-input>
-  (sources  derivation-sources)      ; list of store paths
-  (system   derivation-system)       ; string
-  (builder  derivation-builder)      ; store path
-  (args     derivation-builder-arguments)         ; list of strings
-  (env-vars derivation-builder-environment-vars)) ; list of name/value pairs
-
-(define-record-type <derivation-output>
-  (make-derivation-output path hash-algo hash)
-  derivation-output?
-  (path       derivation-output-path)             ; store path
-  (hash-algo  derivation-output-hash-algo)        ; symbol | #f
-  (hash       derivation-output-hash))            ; symbol | #f
-
-(define-record-type <derivation-input>
-  (make-derivation-input path sub-derivations)
-  derivation-input?
-  (path            derivation-input-path)             ; store path
-  (sub-derivations derivation-input-sub-derivations)) ; list of strings
-
-(define (fixed-output-derivation? drv)
-  "Return #t if DRV is a fixed-output derivation, such as the result of a
-download with a fixed hash (aka. `fetchurl')."
-  (match drv
-    (($ <derivation>
-        (($ <derivation-output> _ (? symbol?) (? string?))))
-     #t)
-    (_ #f)))
-
-(define (read-derivation drv-port)
-  "Read the derivation from DRV-PORT and return the corresponding
-<derivation> object."
-
-  (define comma (string->symbol ","))
-
-  (define (ununquote x)
-    (match x
-      (('unquote x) (ununquote x))
-      ((x ...)      (map ununquote x))
-      (_            x)))
-
-  (define (outputs->alist x)
-    (fold-right (lambda (output result)
-                  (match output
-                    ((name path "" "")
-                     (alist-cons name
-                                 (make-derivation-output path #f #f)
-                                 result))
-                    ((name path hash-algo hash)
-                     ;; fixed-output
-                     (let ((algo (string->symbol hash-algo)))
-                       (alist-cons name
-                                   (make-derivation-output path algo hash)
-                                   result)))))
-                '()
-                x))
-
-  (define (make-input-drvs x)
-    (fold-right (lambda (input result)
-                  (match input
-                    ((path (sub-drvs ...))
-                     (cons (make-derivation-input path sub-drvs)
-                           result))))
-                '()
-                x))
-
-  (let loop ((exp    (read drv-port))
-             (result '()))
-    (match exp
-      ((? eof-object?)
-       (let ((result (reverse result)))
-         (match result
-           (('Derive ((outputs ...) (input-drvs ...)
-                      (input-srcs ...)
-                      (? string? system)
-                      (? string? builder)
-                      ((? string? args) ...)
-                      ((var value) ...)))
-            (make-derivation (outputs->alist outputs)
-                             (make-input-drvs input-drvs)
-                             input-srcs
-                             system builder args
-                             (fold-right alist-cons '() var value)))
-           (_
-            (error "failed to parse derivation" drv-port result)))))
-      ((? (cut eq? <> comma))
-       (loop (read drv-port) result))
-      (_
-       (loop (read drv-port)
-             (cons (ununquote exp) result))))))
-
-(define (write-derivation drv port)
-  "Write the ATerm-like serialization of DRV to PORT."
-  (define (list->string lst)
-    (string-append "[" (string-join lst ",") "]"))
-
-  (define (write-list lst)
-    (display (list->string lst) port))
-
-  (match drv
-    (($ <derivation> outputs inputs sources
-        system builder args env-vars)
-     (display "Derive(" port)
-     (write-list (map (match-lambda
-                       ((name . ($ <derivation-output> path hash-algo hash))
-                        (format #f "(~s,~s,~s,~s)"
-                                name path (or hash-algo "")
-                                (or hash ""))))
-                      outputs))
-     (display "," port)
-     (write-list (map (match-lambda
-                       (($ <derivation-input> path sub-drvs)
-                        (format #f "(~s,~a)" path
-                                (list->string (map object->string sub-drvs)))))
-                      inputs))
-     (display "," port)
-     (write-list sources)
-     (format port ",~s,~s," system builder)
-     (write-list (map object->string args))
-     (display "," port)
-     (write-list (map (match-lambda
-                       ((name . value)
-                        (format #f "(~s,~s)" name value)))
-                      env-vars))
-     (display ")" port))))
-
-(define (sha256 bv)
-  "Return the SHA256 of BV as an string of hexadecimal digits."
-  ;; XXX: Poor programmer's implementation that uses Coreutils.
-  (let ((in  (pipe))
-        (out (pipe))
-        (pid (primitive-fork)))
-    (if (= 0 pid)
-        (begin                                      ; child
-          (close (cdr in))
-          (close (car out))
-          (close 0)
-          (close 1)
-          (dup2 (fileno (car in)) 0)
-          (dup2 (fileno (cdr out)) 1)
-          (execlp "sha256sum" "sha256sum"))
-        (begin                                      ; parent
-          (close (car in))
-          (close (cdr out))
-          (put-bytevector (cdr in) bv)
-          (close (cdr in))                        ; EOF
-          (let ((line (car (string-tokenize (read-line (car out))))))
-            (close (car out))
-            (and (and=> (status:exit-val (cdr (waitpid pid)))
-                        zero?)
-                 line))))))
-
-(define (derivation-hash drv)      ; `hashDerivationModulo' in derivations.cc
-  (match drv
-    (($ <derivation> ((_ . ($ <derivation-output> path
-                              (? symbol? hash-algo) (? string? hash)))))
-     ;; A fixed-output derivation.
-     (sha256
-      (string->utf8
-       (string-append "fixed:out:" hash-algo ":" hash ":" path))))
-    (($ <derivation> outputs inputs sources
-        system builder args env-vars)
-     ;; A regular derivation: replace that path of each input with that
-     ;; inputs hash; return the hash of serialization of the resulting
-     ;; derivation.
-     (let* ((inputs (map (match-lambda
-                          (($ <derivation-input> path sub-drvs)
-                           (let ((hash (call-with-input-file path
-                                         (compose derivation-hash
-                                                  read-derivation))))
-                             (make-derivation-input hash sub-drvs))))
-                         inputs))
-            (drv     (make-derivation outputs inputs sources
-                                      system builder args env-vars)))
-       (sha256
-        (string->utf8 (call-with-output-string
-                       (cut write-derivation drv <>))))))))
-
-(define (instantiate server derivation)
-  #f
-  )
+    (for-each (let ((i (module-public-interface (current-module))))
+                (lambda (m)
+                  (module-use! i (resolve-interface `(guix ,m)))))
+              %public-modules)))
diff --git a/guix/derivations.scm b/guix/derivations.scm
new file mode 100644
index 0000000000..81fc21565d
--- /dev/null
+++ b/guix/derivations.scm
@@ -0,0 +1,237 @@
+;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
+;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of Guix.
+;;;
+;;; Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix derivations)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (rnrs io ports)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:export (derivation?
+            derivation-outputs
+            derivation-inputs
+            derivation-sources
+            derivation-system
+            derivation-builder-arguments
+            derivation-builder-environment-vars
+
+            derivation-output?
+            derivation-output-path
+            derivation-output-hash-algo
+            derivation-output-hash
+
+            derivation-input?
+            derivation-input-path
+            derivation-input-sub-derivations
+
+            fixed-output-derivation?
+            derivation-hash))
+
+;;;
+;;; Nix derivations, as implemented in Nix's `derivations.cc'.
+;;;
+
+(define-record-type <derivation>
+  (make-derivation outputs inputs sources system builder args env-vars)
+  derivation?
+  (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
+  (inputs   derivation-inputs)       ; list of <derivation-input>
+  (sources  derivation-sources)      ; list of store paths
+  (system   derivation-system)       ; string
+  (builder  derivation-builder)      ; store path
+  (args     derivation-builder-arguments)         ; list of strings
+  (env-vars derivation-builder-environment-vars)) ; list of name/value pairs
+
+(define-record-type <derivation-output>
+  (make-derivation-output path hash-algo hash)
+  derivation-output?
+  (path       derivation-output-path)             ; store path
+  (hash-algo  derivation-output-hash-algo)        ; symbol | #f
+  (hash       derivation-output-hash))            ; symbol | #f
+
+(define-record-type <derivation-input>
+  (make-derivation-input path sub-derivations)
+  derivation-input?
+  (path            derivation-input-path)             ; store path
+  (sub-derivations derivation-input-sub-derivations)) ; list of strings
+
+(define (fixed-output-derivation? drv)
+  "Return #t if DRV is a fixed-output derivation, such as the result of a
+download with a fixed hash (aka. `fetchurl')."
+  (match drv
+    (($ <derivation>
+        (($ <derivation-output> _ (? symbol?) (? string?))))
+     #t)
+    (_ #f)))
+
+(define (read-derivation drv-port)
+  "Read the derivation from DRV-PORT and return the corresponding
+<derivation> object."
+
+  (define comma (string->symbol ","))
+
+  (define (ununquote x)
+    (match x
+      (('unquote x) (ununquote x))
+      ((x ...)      (map ununquote x))
+      (_            x)))
+
+  (define (outputs->alist x)
+    (fold-right (lambda (output result)
+                  (match output
+                    ((name path "" "")
+                     (alist-cons name
+                                 (make-derivation-output path #f #f)
+                                 result))
+                    ((name path hash-algo hash)
+                     ;; fixed-output
+                     (let ((algo (string->symbol hash-algo)))
+                       (alist-cons name
+                                   (make-derivation-output path algo hash)
+                                   result)))))
+                '()
+                x))
+
+  (define (make-input-drvs x)
+    (fold-right (lambda (input result)
+                  (match input
+                    ((path (sub-drvs ...))
+                     (cons (make-derivation-input path sub-drvs)
+                           result))))
+                '()
+                x))
+
+  (let loop ((exp    (read drv-port))
+             (result '()))
+    (match exp
+      ((? eof-object?)
+       (let ((result (reverse result)))
+         (match result
+           (('Derive ((outputs ...) (input-drvs ...)
+                      (input-srcs ...)
+                      (? string? system)
+                      (? string? builder)
+                      ((? string? args) ...)
+                      ((var value) ...)))
+            (make-derivation (outputs->alist outputs)
+                             (make-input-drvs input-drvs)
+                             input-srcs
+                             system builder args
+                             (fold-right alist-cons '() var value)))
+           (_
+            (error "failed to parse derivation" drv-port result)))))
+      ((? (cut eq? <> comma))
+       (loop (read drv-port) result))
+      (_
+       (loop (read drv-port)
+             (cons (ununquote exp) result))))))
+
+(define (write-derivation drv port)
+  "Write the ATerm-like serialization of DRV to PORT.  See Section 2.4 of
+Eelco Dolstra's PhD dissertation for an overview of a previous version of
+that form."
+  (define (list->string lst)
+    (string-append "[" (string-join lst ",") "]"))
+
+  (define (write-list lst)
+    (display (list->string lst) port))
+
+  (match drv
+    (($ <derivation> outputs inputs sources
+        system builder args env-vars)
+     (display "Derive(" port)
+     (write-list (map (match-lambda
+                       ((name . ($ <derivation-output> path hash-algo hash))
+                        (format #f "(~s,~s,~s,~s)"
+                                name path (or hash-algo "")
+                                (or hash ""))))
+                      outputs))
+     (display "," port)
+     (write-list (map (match-lambda
+                       (($ <derivation-input> path sub-drvs)
+                        (format #f "(~s,~a)" path
+                                (list->string (map object->string sub-drvs)))))
+                      inputs))
+     (display "," port)
+     (write-list sources)
+     (format port ",~s,~s," system builder)
+     (write-list (map object->string args))
+     (display "," port)
+     (write-list (map (match-lambda
+                       ((name . value)
+                        (format #f "(~s,~s)" name value)))
+                      env-vars))
+     (display ")" port))))
+
+(define (sha256 bv)
+  "Return the SHA256 of BV as an string of hexadecimal digits."
+  ;; XXX: Poor programmer's implementation that uses Coreutils.
+  (let ((in  (pipe))
+        (out (pipe))
+        (pid (primitive-fork)))
+    (if (= 0 pid)
+        (begin                                      ; child
+          (close (cdr in))
+          (close (car out))
+          (close 0)
+          (close 1)
+          (dup2 (fileno (car in)) 0)
+          (dup2 (fileno (cdr out)) 1)
+          (execlp "sha256sum" "sha256sum"))
+        (begin                                      ; parent
+          (close (car in))
+          (close (cdr out))
+          (put-bytevector (cdr in) bv)
+          (close (cdr in))                        ; EOF
+          (let ((line (car (string-tokenize (read-line (car out))))))
+            (close (car out))
+            (and (and=> (status:exit-val (cdr (waitpid pid)))
+                        zero?)
+                 line))))))
+
+(define (derivation-hash drv)      ; `hashDerivationModulo' in derivations.cc
+  (match drv
+    (($ <derivation> ((_ . ($ <derivation-output> path
+                              (? symbol? hash-algo) (? string? hash)))))
+     ;; A fixed-output derivation.
+     (sha256
+      (string->utf8
+       (string-append "fixed:out:" hash-algo ":" hash ":" path))))
+    (($ <derivation> outputs inputs sources
+        system builder args env-vars)
+     ;; A regular derivation: replace that path of each input with that
+     ;; inputs hash; return the hash of serialization of the resulting
+     ;; derivation.
+     (let* ((inputs (map (match-lambda
+                          (($ <derivation-input> path sub-drvs)
+                           (let ((hash (call-with-input-file path
+                                         (compose derivation-hash
+                                                  read-derivation))))
+                             (make-derivation-input hash sub-drvs))))
+                         inputs))
+            (drv     (make-derivation outputs inputs sources
+                                      system builder args env-vars)))
+       (sha256
+        (string->utf8 (call-with-output-string
+                       (cut write-derivation drv <>))))))))
+
+(define (instantiate server derivation)
+  #f
+  )
diff --git a/guix/store.scm b/guix/store.scm
new file mode 100644
index 0000000000..db5679caf2
--- /dev/null
+++ b/guix/store.scm
@@ -0,0 +1,337 @@
+;;; Guix --- Nix package management from Guile.         -*- coding: utf-8 -*-
+;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of Guix.
+;;;
+;;; Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix store)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:export (nix-server?
+            nix-server-major-version
+            nix-server-minor-version
+            nix-server-socket
+
+            open-connection
+            set-build-options
+            add-text-to-store
+            add-to-store
+            build-derivations))
+
+(define %protocol-version #x109)
+
+(define %worker-magic-1 #x6e697863)
+(define %worker-magic-2 #x6478696f)
+
+(define (protocol-major magic)
+  (logand magic #xff00))
+(define (protocol-minor magic)
+  (logand magic #x00ff))
+
+(define-syntax define-enumerate-type
+  (syntax-rules ()
+    ((_ name->int (name id) ...)
+     (define-syntax name->int
+       (syntax-rules (name ...)
+         ((_ name) id) ...)))))
+
+(define-enumerate-type operation-id
+  ;; operation numbers from worker-protocol.hh
+  (quit 0)
+  (valid-path? 1)
+  (has-substitutes? 3)
+  (query-path-hash 4)
+  (query-references 5)
+  (query-referrers 6)
+  (add-to-store 7)
+  (add-text-to-store 8)
+  (build-derivations 9)
+  (ensure-path 10)
+  (add-temp-root 11)
+  (add-indirect-root 12)
+  (sync-with-gc 13)
+  (find-roots 14)
+  (export-path 16)
+  (query-deriver 18)
+  (set-options 19)
+  (collect-garbage 20)
+  (query-substitutable-path-info 21)
+  (query-derivation-outputs 22)
+  (query-valid-paths 23)
+  (query-failed-paths 24)
+  (clear-failed-paths 25)
+  (query-path-info 26)
+  (import-paths 27)
+  (query-derivation-output-names 28))
+
+(define-enumerate-type hash-algo
+  ;; hash.hh
+  (md5 1)
+  (sha1 2)
+  (sha256 3))
+
+(define %nix-state-dir "/nix/var/nix")
+(define %default-socket-path
+  (string-append %nix-state-dir "/daemon-socket/socket"))
+
+
+;; serialize.cc
+
+(define (write-int n p)
+  (let ((b (make-bytevector 8 0)))
+    (bytevector-u32-set! b 0 n (endianness little))
+    (put-bytevector p b)))
+
+(define (read-int p)
+  (let ((b (get-bytevector-n p 8)))
+    (bytevector-u32-ref b 0 (endianness little))))
+
+(define (write-long-long n p)
+  (let ((b (make-bytevector 8 0)))
+    (bytevector-u64-set! b 0 n (endianness little))
+    (put-bytevector p b)))
+
+(define write-padding
+  (let ((zero (make-bytevector 8 0)))
+    (lambda (n p)
+      (let ((m (modulo n 8)))
+        (or (zero? m)
+            (put-bytevector p zero 0 (- 8 m)))))))
+
+(define (write-string s p)
+  (let ((b (string->utf8 s)))
+    (write-int (bytevector-length b) p)
+    (put-bytevector p b)
+    (write-padding (bytevector-length b) p)))
+
+(define (read-string p)
+  (let* ((len (read-int p))
+         (m   (modulo len 8))
+         (bv  (get-bytevector-n p len))
+         (str (utf8->string bv)))
+    (or (zero? m)
+        (get-bytevector-n p (- 8 m)))
+    str))
+
+(define (write-string-list l p)
+  (write-int (length l) p)
+  (for-each (cut write-string <> p) l))
+
+(define (read-store-path p)
+  (read-string p))                                ; TODO: assert path
+
+(define (write-contents file p)
+  "Write the contents of FILE to output port P."
+  (define (dump in size)
+    (define buf-size 65536)
+    (define buf (make-bytevector buf-size))
+
+    (let loop ((left size))
+      (if (<= left 0)
+          0
+          (let ((read (get-bytevector-n! in buf 0 buf-size)))
+            (if (eof-object? read)
+                left
+                (begin
+                  (put-bytevector p buf 0 read)
+                  (loop (- left read))))))))
+
+  (let ((size (stat:size (lstat file))))
+    (write-string "contents" p)
+    (write-long-long size p)
+    (call-with-input-file file
+      (lambda (p)
+        (dump p size)))
+    (write-padding size p)))
+
+(define (write-file f p)
+  (define %archive-version-1 "nix-archive-1")
+
+  (let ((s (lstat f)))
+    (write-string %archive-version-1 p)
+    (write-string "(" p)
+    (case (stat:type s)
+      ((regular)
+       (write-string "type" p)
+       (write-string "regular" p)
+       (if (not (zero? (logand (stat:mode s) #o100)))
+           (begin
+             (write-string "executable" p)
+             (write-string "" p)))
+       (write-contents f p)
+       (write-string ")" p))
+      ((directory)
+       (write-string "type" p)
+       (write-string "directory" p)
+       (error "ENOSYS"))
+      (else
+       (error "ENOSYS")))))
+
+(define-syntax write-arg
+  (syntax-rules (integer boolean file string string-list)
+    ((_ integer arg p)
+     (write-int arg p))
+    ((_ boolean arg p)
+     (write-int (if arg 1 0) p))
+    ((_ file arg p)
+     (write-file arg p))
+    ((_ string arg p)
+     (write-string arg p))
+    ((_ string-list arg p)
+     (write-string-list arg p))))
+
+(define-syntax read-arg
+  (syntax-rules (integer boolean string store-path)
+    ((_ integer p)
+     (read-int p))
+    ((_ boolean p)
+     (not (zero? (read-int p))))
+    ((_ string p)
+     (read-string p))
+    ((_ store-path p)
+     (read-store-path p))))
+
+
+;; remote-store.cc
+
+(define-record-type <nix-server>
+  (%make-nix-server socket major minor)
+  nix-server?
+  (socket nix-server-socket)
+  (major  nix-server-major-version)
+  (minor  nix-server-minor-version))
+
+(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.
+             (socket PF_UNIX SOCK_STREAM 0)))
+        (a (make-socket-address PF_UNIX file)))
+    (connect s a)
+    (write-int %worker-magic-1 s)
+    (let ((r (read-int s)))
+      (and (eqv? r %worker-magic-2)
+           (let ((v (read-int s)))
+             (and (eqv? (protocol-major %protocol-version)
+                        (protocol-major v))
+                  (begin
+                    (write-int %protocol-version s)
+                    (let ((s (%make-nix-server s
+                                               (protocol-major v)
+                                               (protocol-minor v))))
+                      (process-stderr s)
+                      s))))))))
+
+(define (process-stderr server)
+  (define p
+    (nix-server-socket server))
+
+  ;; magic cookies from worker-protocol.hh
+  (define %stderr-next  #x6f6c6d67)
+  (define %stderr-read  #x64617461)               ; data needed from source
+  (define %stderr-write #x64617416)               ; data for sink
+  (define %stderr-last  #x616c7473)
+  (define %stderr-error #x63787470)
+
+  (let ((k (read-int p)))
+    (cond ((= k %stderr-write)
+           (read-string p))
+          ((= k %stderr-read)
+           (let ((len (read-int p)))
+             (read-string p)                      ; FIXME: what to do?
+             ))
+          ((= k %stderr-next)
+           (let ((s (read-string p)))
+             (display s (current-error-port))
+             s))
+          ((= k %stderr-error)
+           (let ((error  (read-string p))
+                 (status (if (>= (nix-server-minor-version server) 8)
+                             (read-int p)
+                             1)))
+             (format (current-error-port) "error: ~a (status: ~a)~%"
+                     error status)
+             error))
+          ((= k %stderr-last)
+           #t)
+          (else
+           (error "invalid standard error code" k)))))
+
+(define* (set-build-options server
+                            #:key keep-failed? keep-going? try-fallback?
+                            (verbosity 0)
+                            (max-build-jobs (current-processor-count))
+                            (max-silent-time 3600)
+                            (use-build-hook? #t)
+                            (build-verbosity 0)
+                            (log-type 0)
+                            (print-build-trace #t))
+  ;; Must be called after `open-connection'.
+
+  (define socket
+    (nix-server-socket server))
+
+  (let-syntax ((send (syntax-rules ()
+                       ((_ option ...)
+                        (for-each (lambda (i)
+                                    (cond ((boolean? i)
+                                           (write-int (if i 1 0) socket))
+                                          ((integer? i)
+                                           (write-int i socket))
+                                          (else
+                                           (error "invalid build option"
+                                                  i))))
+                                  (list option ...))))))
+    (send (operation-id set-options)
+          keep-failed? keep-going? try-fallback? verbosity
+          max-build-jobs max-silent-time)
+    (if (>= (nix-server-minor-version server) 2)
+        (send use-build-hook?))
+    (if (>= (nix-server-minor-version server) 4)
+        (send build-verbosity log-type print-build-trace))
+    (process-stderr server)))
+
+(define-syntax define-operation
+  (syntax-rules ()
+    ((_ (name (type arg) ...) docstring return)
+     (define (name server arg ...)
+       docstring
+       (let ((s (nix-server-socket server)))
+         (write-int (operation-id name) s)
+         (write-arg type arg s)
+         ...
+         (process-stderr server)
+         (read-arg return s))))))
+
+(define-operation (add-text-to-store (string name) (string text)
+                                     (string-list references))
+  "Add TEXT under file NAME in the store."
+  store-path)
+
+(define-operation (add-to-store (string basename)
+                                (integer algo)
+                                (boolean sha256-and-recursive?)
+                                (boolean recursive?)
+                                (file file-name))
+  "Add the contents of FILE-NAME under BASENAME to the store."
+  store-path)
+
+(define-operation (build-derivations (string-list derivations))
+  "Build DERIVATIONS; return #t on success."
+  boolean)