summaryrefslogtreecommitdiff
path: root/guix/nar.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-04 22:29:08 +0200
committerLudovic Courtès <ludo@gnu.org>2013-04-04 22:29:08 +0200
commit0f41c26f9b9c981d5d5ecaa8c2ccda4f4c6ab147 (patch)
tree544dd679b33fff3159d9d64a65ec76b93a05ce60 /guix/nar.scm
parent462f8e9f332b3e89bd8b0ebd4c618447b8558560 (diff)
Add (guix nar) and (guix serialization).
* guix/store.scm (write-int, read-int, write-long-long, read-long-long, write-padding, write-string, read-string, read-latin1-string, write-string-list, read-string-list, write-store-path, read-store-path, write-store-path-list, read-store-path-list): Move to serialization.scm. (write-contents, write-file): Move to nar.scm. * guix/nar.scm, guix/serialization.scm: New files. * Makefile.am (MODULES): Add them.
Diffstat (limited to 'guix/nar.scm')
-rw-r--r--guix/nar.scm110
1 files changed, 110 insertions, 0 deletions
diff --git a/guix/nar.scm b/guix/nar.scm
new file mode 100644
index 0000000000..b42f03c514
--- /dev/null
+++ b/guix/nar.scm
@@ -0,0 +1,110 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU 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.
+;;;
+;;; GNU 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix nar)
+ #:use-module (guix utils)
+ #:use-module (guix serialization)
+ #:use-module (rnrs bytevectors)
+ #:use-module (rnrs io ports)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 ftw)
+ #:export (write-file))
+
+;;; Comment:
+;;;
+;;; Read and write Nix archives, aka. ‘nar’.
+;;;
+;;; Code:
+
+(define (write-contents file p size)
+ "Write SIZE bytes from FILE to output port P."
+ (define (call-with-binary-input-file file proc)
+ ;; Open FILE as a binary file. This avoids scan-for-encoding, and thus
+ ;; avoids any initial buffering. Disable file name canonicalization to
+ ;; avoid stat'ing like crazy.
+ (with-fluids ((%file-port-name-canonicalization #f))
+ (let ((port (open-file file "rb")))
+ (catch #t (cut proc port)
+ (lambda args
+ (close-port port)
+ (apply throw args))))))
+
+ (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))))))))
+
+ (write-string "contents" p)
+ (write-long-long size p)
+ (call-with-binary-input-file file
+ ;; Use `sendfile' when available (Guile 2.0.8+).
+ (if (compile-time-value (defined? 'sendfile))
+ (cut sendfile p <> size 0)
+ (cut dump <> size)))
+ (write-padding size p))
+
+(define (write-file file port)
+ "Write the contents of FILE to PORT in Nar format, recursing into
+sub-directories of FILE as needed."
+ (define %archive-version-1 "nix-archive-1")
+ (define p port)
+
+ (write-string %archive-version-1 p)
+
+ (let dump ((f file))
+ (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 (stat:size s)))
+ ((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))))
+
+;;; nar.scm ends here