From b37eb5ede67f8f26dcbbb0d9c60050db10b63d00 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 10 Jun 2012 22:43:02 +0200
Subject: Add `add-to-store' with recursive directory storage.

* guix/store.scm (write-file): Implement directory recursive dump.
  (add-to-store): Fix the parameter list.

* tests/derivations.scm (directory-contents): New procedure.
  ("add-to-store, recursive"): New test.
---
 guix/store.scm | 56 +++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 35 insertions(+), 21 deletions(-)

(limited to 'guix')

diff --git a/guix/store.scm b/guix/store.scm
index 1ea4d16894..1e36657d05 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -27,6 +27,7 @@ (define-module (guix store)
   #:use-module (srfi srfi-39)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 ftw)
   #:export (nix-server?
             nix-server-major-version
             nix-server-minor-version
@@ -178,25 +179,38 @@ (define buf (make-bytevector buf-size))
 (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")))))
+  (write-string %archive-version-1 p)
+
+  (let dump ((f f))
+    (let ((s (lstat f)))
+      (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))
+        ((directory)
+         (write-string "type" p)
+         (write-string "directory" p)
+         (let ((entries (remove (cut member <> '("." ".."))
+                                (scandir f))))
+           (for-each (lambda (e)
+                       (let ((f (string-append f "/" e)))
+                         (write-string "entry" p)
+                         (write-string "(" p)
+                         (write-string "name" p)
+                         (write-string e p)
+                         (write-string "node" p)
+                         (dump f)
+                         (write-string ")" p)))
+                     entries)))
+        (else
+         (error "ENOSYS")))
+      (write-string ")" p))))
 
 (define-syntax write-arg
   (syntax-rules (integer boolean file string string-list)
@@ -349,9 +363,9 @@ (define-operation (add-text-to-store (string name) (string text)
   store-path)
 
 (define-operation (add-to-store (string basename)
-                                (integer algo)
-                                (boolean sha256-and-recursive?)
+                                (boolean fixed?)  ; obsolete, must be #t
                                 (boolean recursive?)
+                                (string hash-algo)
                                 (file file-name))
   "Add the contents of FILE-NAME under BASENAME to the store."
   store-path)
-- 
cgit v1.2.3