guix/serialization.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix serialization)
  20   #:use-module (guix utils)
  21   #:use-module (rnrs bytevectors)
  22   #:use-module (rnrs io ports)
  23   #:use-module (srfi srfi-1)
  24   #:use-module (srfi srfi-26)
  25   #:export (write-int read-int
  26             write-long-long read-long-long
  27             write-padding
  28             write-string read-string read-latin1-string
  29             write-string-list read-string-list
  30             write-store-path read-store-path
  31             write-store-path-list read-store-path-list))
  32
  33 ;;; Comment:
  34 ;;;
  35 ;;; Serialization procedures used by the RPCs and the Nar format.  This module
  36 ;;; is for internal consumption.
  37 ;;;
  38 ;;; Code:
  39
  40 ;; Similar to serialize.cc in Nix.
  41
  42 (define (write-int n p)
  43   (let ((b (make-bytevector 8 0)))
  44     (bytevector-u32-set! b 0 n (endianness little))
  45     (put-bytevector p b)))
  46
  47 (define (read-int p)
  48   (let ((b (get-bytevector-n p 8)))
  49     (bytevector-u32-ref b 0 (endianness little))))
  50
  51 (define (write-long-long n p)
  52   (let ((b (make-bytevector 8 0)))
  53     (bytevector-u64-set! b 0 n (endianness little))
  54     (put-bytevector p b)))
  55
  56 (define (read-long-long p)
  57   (let ((b (get-bytevector-n p 8)))
  58     (bytevector-u64-ref b 0 (endianness little))))
  59
  60 (define write-padding
  61   (let ((zero (make-bytevector 8 0)))
  62     (lambda (n p)
  63       (let ((m (modulo n 8)))
  64         (or (zero? m)
  65             (put-bytevector p zero 0 (- 8 m)))))))
  66
  67 (define (write-string s p)
  68   (let* ((s (string->utf8 s))
  69          (l (bytevector-length s))
  70          (m (modulo l 8))
  71          (b (make-bytevector (+ 8 l (if (zero? m) 0 (- 8 m))))))
  72     (bytevector-u32-set! b 0 l (endianness little))
  73     (bytevector-copy! s 0 b 8 l)
  74     (put-bytevector p b)))
  75
  76 (define (read-string p)
  77   (let* ((len (read-int p))
  78          (m   (modulo len 8))
  79          (bv  (get-bytevector-n p len))
  80          (str (utf8->string bv)))
  81     (or (zero? m)
  82         (get-bytevector-n p (- 8 m)))
  83     str))
  84
  85 (define (read-latin1-string p)
  86   (let* ((len (read-int p))
  87          (m   (modulo len 8))
  88          (str (get-string-n p len)))
  89     (or (zero? m)
  90         (get-bytevector-n p (- 8 m)))
  91     str))
  92
  93 (define (write-string-list l p)
  94   (write-int (length l) p)
  95   (for-each (cut write-string <> p) l))
  96
  97 (define (read-string-list p)
  98   (let ((len (read-int p)))
  99     (unfold (cut >= <> len)
 100             (lambda (i)
 101               (read-string p))
 102             1+
 103             0)))
 104
 105 (define (write-store-path f p)
 106   (write-string f p))                             ; TODO: assert path
 107
 108 (define (read-store-path p)
 109   (read-string p))                                ; TODO: assert path
 110
 111 (define write-store-path-list write-string-list)
 112 (define read-store-path-list read-string-list)
 113
 114 ;;; serialization.scm ends here