You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

125 lines
3.7 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013, 2014 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. (define-module (guix serialization)
  19. #:use-module (guix utils)
  20. #:use-module (rnrs bytevectors)
  21. #:use-module (rnrs io ports)
  22. #:use-module (srfi srfi-1)
  23. #:use-module (srfi srfi-26)
  24. #:use-module (ice-9 match)
  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-string-pairs
  31. write-store-path read-store-path
  32. write-store-path-list read-store-path-list))
  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. ;; Similar to serialize.cc in Nix.
  40. (define (write-int n p)
  41. (let ((b (make-bytevector 8 0)))
  42. (bytevector-u32-set! b 0 n (endianness little))
  43. (put-bytevector p b)))
  44. (define (read-int p)
  45. (let ((b (get-bytevector-n p 8)))
  46. (bytevector-u32-ref b 0 (endianness little))))
  47. (define (write-long-long n p)
  48. (let ((b (make-bytevector 8 0)))
  49. (bytevector-u64-set! b 0 n (endianness little))
  50. (put-bytevector p b)))
  51. (define (read-long-long p)
  52. (let ((b (get-bytevector-n p 8)))
  53. (bytevector-u64-ref b 0 (endianness little))))
  54. (define write-padding
  55. (let ((zero (make-bytevector 8 0)))
  56. (lambda (n p)
  57. (let ((m (modulo n 8)))
  58. (or (zero? m)
  59. (put-bytevector p zero 0 (- 8 m)))))))
  60. (define (write-string s p)
  61. (let* ((s (string->utf8 s))
  62. (l (bytevector-length s))
  63. (m (modulo l 8))
  64. (b (make-bytevector (+ 8 l (if (zero? m) 0 (- 8 m))))))
  65. (bytevector-u32-set! b 0 l (endianness little))
  66. (bytevector-copy! s 0 b 8 l)
  67. (put-bytevector p b)))
  68. (define (read-string p)
  69. (let* ((len (read-int p))
  70. (m (modulo len 8))
  71. (bv (get-bytevector-n p len))
  72. (str (utf8->string bv)))
  73. (or (zero? m)
  74. (get-bytevector-n p (- 8 m)))
  75. str))
  76. (define (read-latin1-string p)
  77. (let* ((len (read-int p))
  78. (m (modulo len 8))
  79. (str (get-string-n p len)))
  80. (or (zero? m)
  81. (get-bytevector-n p (- 8 m)))
  82. str))
  83. (define (write-string-list l p)
  84. (write-int (length l) p)
  85. (for-each (cut write-string <> p) l))
  86. (define (write-string-pairs l p)
  87. (write-int (length l) p)
  88. (for-each (match-lambda
  89. ((first . second)
  90. (write-string first p)
  91. (write-string second p)))
  92. l))
  93. (define (read-string-list p)
  94. (let ((len (read-int p)))
  95. (unfold (cut >= <> len)
  96. (lambda (i)
  97. (read-string p))
  98. 1+
  99. 0)))
  100. (define (write-store-path f p)
  101. (write-string f p)) ; TODO: assert path
  102. (define (read-store-path p)
  103. (read-string p)) ; TODO: assert path
  104. (define write-store-path-list write-string-list)
  105. (define read-store-path-list read-string-list)
  106. ;;; serialization.scm ends here