amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

nar: Implement restoration from Nar.

Browse source 
* guix/nar.scm (&nar-error, &nar-read-error): New condition types.
  (dump): New procedure.
  (write-contents)[dump]: Remove.  Use the one above instead.
  (read-contents, write-file, restore-file): New procedures.
  (%archive-version-1): New variable.
This commit is contained in:
Ludovic Courtès 2013-04-08 22:54:08 +02:00
parent 52e5910cdc
commit 53c63ee937
3 changed files with 228 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

150
guix/nar.scm
View file

@ -19,12 +19,23 @@
(define-module (guix nar)
#:use-module (guix utils)
#:use-module (guix serialization)
#:use-module ((guix build utils) #:select (with-directory-excursion))
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 ftw)
#:export (write-file))
#:use-module (ice-9 match)
#:export (nar-error?
nar-read-error?
nar-read-error-file
nar-read-error-port
nar-read-error-token
write-file
restore-file))
;;; Comment:
;;;
@ -32,6 +43,31 @@
;;;
;;; Code:
(define-condition-type &nar-error &error ; XXX: inherit from &nix-error ?
nar-error?)
(define-condition-type &nar-read-error &nar-error
nar-read-error?
(port nar-read-error-port) ; port from which we read
(file nar-read-error-file) ; file we were restoring, or #f
(token nar-read-error-token)) ; faulty token, or #f
(define (dump in out size)
"Copy SIZE bytes from IN to OUT."
(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 (min left buf-size))))
(if (eof-object? read)
left
(begin
(put-bytevector out buf 0 read)
(loop (- left read))))))))
(define (write-contents file p size)
"Write SIZE bytes from FILE to output port P."
(define (call-with-binary-input-file file proc)
@ -45,33 +81,55 @@
(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)))
(cut dump <> p size)))
(write-padding size p))
(define (read-contents in out)
"Read the contents of a file from the Nar at IN, write it to OUT, and return
the size in bytes."
(define executable?
(match (read-string in)
("contents"
#f)
("executable"
(match (list (read-string in) (read-string in))
(("" "contents") #t)
(x (raise
(condition (&message
(message "unexpected executable file marker"))
(&nar-read-error (port in)
(file #f)
(token x))))))
#t)
(x
(raise
(condition (&message (message "unsupported nar file type"))
(&nar-read-error (port in) (file #f) (token x)))))))
(let ((size (read-long-long in)))
;; Note: `sendfile' cannot be used here because of port buffering on IN.
(dump in out size)
(when executable?
(chmod out #o755))
(let ((m (modulo size 8)))
(unless (zero? m)
(get-bytevector-n in (- 8 m))))
size))
(define %archive-version-1
;; Magic cookie for Nix archives.
"nix-archive-1")
(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)
@ -104,7 +162,63 @@ sub-directories of FILE as needed."
(write-string ")" p)))
entries)))
(else
(error "ENOSYS")))
(raise (condition (&message (message "ENOSYS"))
(&nar-error)))))
(write-string ")" p))))
(define (restore-file port file)
"Read a file (possibly a directory structure) in Nar format from PORT.
Restore it as FILE."
(let ((signature (read-string port)))
(unless (equal? signature %archive-version-1)
(raise
(condition (&message (message "invalid nar signature"))
(&nar-read-error (port port)
(token signature)
(file #f))))))
(let restore ((file file))
(match (list (read-string port) (read-string port) (read-string port))
(("(" "type" "regular")
(call-with-output-file file (cut read-contents port <>))
(match (read-string port)
(")" #t)
(x (raise
(condition
(&message (message "invalid nar end-of-file marker"))
(&nar-read-error (port port) (file file) (token x)))))))
(("(" "type" "directory")
(let ((dir file))
(mkdir dir)
(let loop ((prefix (read-string port)))
(match prefix
("entry"
(match (list (read-string port)
(read-string port) (read-string port)
(read-string port))
(("(" "name" file "node")
(restore (string-append dir "/" file))
(match (read-string port)
(")" #t)
(x
(raise
(condition
(&message
(message "unexpected directory entry termination"))
(&nar-read-error (port port)
(file file)
(token x))))))
(loop (read-string port)))))
(")" #t) ; done with DIR
(x
(raise
(condition
(&message (message "unexpected directory inter-entry marker"))
(&nar-read-error (port port) (file file) (token x)))))))))
(x
(raise
(condition
(&message (message "unsupported nar entry type"))
(&nar-read-error (port port) (file file) (token x))))))))
;;; nar.scm ends here