diff options
author | Leo Famulari <leo@famulari.name> | 2016-06-12 22:02:04 -0400 |
---|---|---|
committer | Leo Famulari <leo@famulari.name> | 2016-06-12 22:09:26 -0400 |
commit | ee86e7e14859533045e1f7727ae731ba6ba72daf (patch) | |
tree | a5f51a9c4859a3242b46876797b98e77a5a7506e /guix/serialization.scm | |
parent | 8af5cac527eee03005f3809578a0d8258a878f95 (diff) | |
parent | fe585be9aa8f5158a7dfb6477d19ece3d643dec3 (diff) | |
download | guix-patches-ee86e7e14859533045e1f7727ae731ba6ba72daf.tar guix-patches-ee86e7e14859533045e1f7727ae731ba6ba72daf.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/serialization.scm')
-rw-r--r-- | guix/serialization.scm | 78 |
1 files changed, 41 insertions, 37 deletions
diff --git a/guix/serialization.scm b/guix/serialization.scm index 286b4cbf30..f17f516c09 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -256,53 +256,57 @@ the size in bytes." ;; Magic cookie for Nix archives. "nix-archive-1") -(define (write-file file port) +(define* (write-file file port + #:key (select? (const #t))) "Write the contents of FILE to PORT in Nar format, recursing into -sub-directories of FILE as needed." +sub-directories of FILE as needed. For each directory entry, call (SELECT? +FILE STAT), where FILE is the entry's absolute file name and STAT is the +result of 'lstat'; exclude entries for which SELECT? does not return true." (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 - ;; 'scandir' defaults to 'string-locale<?' to sort files, but - ;; this happens to be case-insensitive (at least in 'en_US' - ;; locale on libc 2.18.) Conversely, we want files to be - ;; sorted in a case-sensitive fashion. - (scandir f (negate (cut member <> '("." ".."))) string<?))) - (for-each (lambda (e) - (let ((f (string-append f "/" e))) + (let dump ((f file) (s (lstat file))) + (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 + ;; 'scandir' defaults to 'string-locale<?' to sort files, but + ;; this happens to be case-insensitive (at least in 'en_US' + ;; locale on libc 2.18.) Conversely, we want files to be + ;; sorted in a case-sensitive fashion. + (scandir f (negate (cut member <> '("." ".."))) string<?))) + (for-each (lambda (e) + (let* ((f (string-append f "/" e)) + (s (lstat f))) + (when (select? f s) (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))) - ((symlink) - (write-string "type" p) - (write-string "symlink" p) - (write-string "target" p) - (write-string (readlink f) p)) - (else - (raise (condition (&message (message "unsupported file type")) - (&nar-error (file f) (port port)))))) - (write-string ")" p)))) + (dump f s) + (write-string ")" p)))) + entries))) + ((symlink) + (write-string "type" p) + (write-string "symlink" p) + (write-string "target" p) + (write-string (readlink f) p)) + (else + (raise (condition (&message (message "unsupported file type")) + (&nar-error (file f) (port port)))))) + (write-string ")" p))) (define (restore-file port file) "Read a file (possibly a directory structure) in Nar format from PORT. |