summaryrefslogtreecommitdiff
path: root/guix/serialization.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/serialization.scm
parent462f8e9f332b3e89bd8b0ebd4c618447b8558560 (diff)
downloadgnu-guix-0f41c26f9b9c981d5d5ecaa8c2ccda4f4c6ab147.tar
gnu-guix-0f41c26f9b9c981d5d5ecaa8c2ccda4f4c6ab147.tar.gz
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/serialization.scm')
-rw-r--r--guix/serialization.scm114
1 files changed, 114 insertions, 0 deletions
diff --git a/guix/serialization.scm b/guix/serialization.scm
new file mode 100644
index 0000000000..474dc69de5
--- /dev/null
+++ b/guix/serialization.scm
@@ -0,0 +1,114 @@
+;;; 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 serialization)
+ #:use-module (guix utils)
+ #:use-module (rnrs bytevectors)
+ #:use-module (rnrs io ports)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:export (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))
+
+;;; Comment:
+;;;
+;;; Serialization procedures used by the RPCs and the Nar format. This module
+;;; is for internal consumption.
+;;;
+;;; Code:
+
+;; Similar to serialize.cc in Nix.
+
+(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 (read-long-long p)
+ (let ((b (get-bytevector-n p 8)))
+ (bytevector-u64-ref b 0 (endianness little))))
+
+(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* ((s (string->utf8 s))
+ (l (bytevector-length s))
+ (m (modulo l 8))
+ (b (make-bytevector (+ 8 l (if (zero? m) 0 (- 8 m))))))
+ (bytevector-u32-set! b 0 l (endianness little))
+ (bytevector-copy! s 0 b 8 l)
+ (put-bytevector p b)))
+
+(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 (read-latin1-string p)
+ (let* ((len (read-int p))
+ (m (modulo len 8))
+ (str (get-string-n p len)))
+ (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-string-list p)
+ (let ((len (read-int p)))
+ (unfold (cut >= <> len)
+ (lambda (i)
+ (read-string p))
+ 1+
+ 0)))
+
+(define (write-store-path f p)
+ (write-string f p)) ; TODO: assert path
+
+(define (read-store-path p)
+ (read-string p)) ; TODO: assert path
+
+(define write-store-path-list write-string-list)
+(define read-store-path-list read-string-list)
+
+;;; serialization.scm ends here