From d3648e01185dbb3afed85a630b2f8934c68ea143 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 9 Dec 2012 23:50:17 +0100 Subject: store: Add `add-temp-root'. * guix/store.scm (add-temp-root): New procedure. --- guix/store.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'guix/store.scm') diff --git a/guix/store.scm b/guix/store.scm index 9aafb332dc..67620a1767 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -424,6 +424,11 @@ FIXED? is for backward compatibility with old Nix versions and must be #t." Return #t on success." boolean) +(define-operation (add-temp-root (store-path path)) + "Make PATH a temporary root for the duration of the current session. +Return #t." + boolean) + (define-operation (add-indirect-root (string file-name)) "Make FILE-NAME an indirect root for the garbage collector; FILE-NAME can be anywhere on the file system, but it must be an absolute file -- cgit v1.2.3 From 3259877d3563ac022633fbd8b73134a10567331e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 9 Dec 2012 23:52:59 +0100 Subject: store: Add GC-related operations. * guix/store.scm (gc-action): New enumerate type. (read-long-long, read-string-list, write-store-path, write-store-path-list, read-store-path-list): New procedures. (write-arg): Add support for `store-path' and `store-path-list'. (read-arg): Add support for `store-path-list'. (define-operation): Add support for multiple-value returns. (run-gc, live-paths, dead-paths, collect-garbage, delete-paths): New procedures. (%long-long-max): New macro. * tests/store.scm: New file. * Makefile.am (TESTS): Add it. --- guix/store.scm | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 98 insertions(+), 4 deletions(-) (limited to 'guix/store.scm') diff --git a/guix/store.scm b/guix/store.scm index 67620a1767..204364f319 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -50,8 +50,14 @@ add-text-to-store add-to-store build-derivations + add-temp-root add-indirect-root + live-paths + dead-paths + collect-garbage + delete-paths + current-build-output-port %store-prefix @@ -111,8 +117,16 @@ (sha1 2) (sha256 3)) +(define-enumerate-type gc-action + ;; store-api.hh + (return-live 0) + (return-dead 1) + (delete-dead 2) + (delete-specific 3)) + (define %nix-state-dir (or (getenv "NIX_STATE_DIR") "/nix/var/nix")) + (define %default-socket-path (string-append %nix-state-dir "/daemon-socket/socket")) @@ -133,6 +147,10 @@ (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) @@ -159,9 +177,23 @@ (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) + (define (write-contents file p) "Write the contents of FILE to output port P." (define (dump in size) @@ -223,7 +255,8 @@ (write-string ")" p)))) (define-syntax write-arg - (syntax-rules (integer boolean file string string-list base16) + (syntax-rules (integer boolean file string string-list + store-path store-path-list base16) ((_ integer arg p) (write-int arg p)) ((_ boolean arg p) @@ -234,11 +267,15 @@ (write-string arg p)) ((_ string-list arg p) (write-string-list arg p)) + ((_ store-path arg p) + (write-store-path arg p)) + ((_ store-path-list arg p) + (write-store-path-list arg p)) ((_ base16 arg p) (write-string (bytevector->base16-string arg) p)))) (define-syntax read-arg - (syntax-rules (integer boolean string store-path base16) + (syntax-rules (integer boolean string store-path store-path-list base16) ((_ integer p) (read-int p)) ((_ boolean p) @@ -247,6 +284,8 @@ (read-string p)) ((_ store-path p) (read-store-path p)) + ((_ store-path-list p) + (read-store-path-list p)) ((_ hash p) (base16-string->bytevector (read-string p))))) @@ -385,7 +424,7 @@ again until #t is returned or an error is raised." (define-syntax define-operation (syntax-rules () - ((_ (name (type arg) ...) docstring return) + ((_ (name (type arg) ...) docstring return ...) (define (name server arg ...) docstring (let ((s (nix-server-socket server))) @@ -395,7 +434,7 @@ again until #t is returned or an error is raised." ;; Loop until the server is done sending error output. (let loop ((done? (process-stderr server))) (or done? (loop (process-stderr server)))) - (read-arg return s)))))) + (values (read-arg return s) ...)))))) (define-operation (valid-path? (string path)) "Return #t when PATH is a valid store path." @@ -436,6 +475,61 @@ name--it is the caller's responsibility to ensure that it is an absolute file name. Return #t on success." boolean) +(define (run-gc server action to-delete min-freed) + "Perform the garbage-collector operation ACTION, one of the +`gc-action' values. When ACTION is `delete-specific', the TO-DELETE is +the list of store paths to delete. IGNORE-LIVENESS? should always be +#f. MIN-FREED is the minimum amount of disk space to be freed, in +bytes, before the GC can stop. Return the list of store paths delete, +and the number of bytes freed." + (let ((s (nix-server-socket server))) + (write-int (operation-id collect-garbage) s) + (write-int action s) + (write-store-path-list to-delete s) + (write-arg boolean #f s) ; ignore-liveness? + (write-long-long min-freed s) + (write-int 0 s) ; obsolete + (when (>= (nix-server-minor-version server) 5) + ;; Obsolete `use-atime' and `max-atime' parameters. + (write-int 0 s) + (write-int 0 s)) + + ;; Loop until the server is done sending error output. + (let loop ((done? (process-stderr server))) + (or done? (loop (process-stderr server)))) + + (let ((paths (read-store-path-list s)) + (freed (read-long-long s)) + (obsolete (read-long-long s))) + (values paths freed)))) + +(define-syntax-rule (%long-long-max) + ;; Maximum unsigned 64-bit integer. + (- (expt 2 64) 1)) + +(define (live-paths server) + "Return the list of live store paths---i.e., store paths still +referenced, and thus not subject to being garbage-collected." + (run-gc server (gc-action return-live) '() (%long-long-max))) + +(define (dead-paths server) + "Return the list of dead store paths---i.e., store paths no longer +referenced, and thus subject to being garbage-collected." + (run-gc server (gc-action return-dead) '() (%long-long-max))) + +(define* (collect-garbage server #:optional (min-freed (%long-long-max))) + "Collect garbage from the store at SERVER. If MIN-FREED is non-zero, +then collect at least MIN-FREED bytes. Return the paths that were +collected, and the number of bytes freed." + (run-gc server (gc-action delete-dead) '() min-freed)) + +(define* (delete-paths server paths #:optional (min-freed (%long-long-max))) + "Delete PATHS from the store at SERVER, if they are no longer +referenced. If MIN-FREED is non-zero, then stop after at least +MIN-FREED bytes have been collected. Return the paths that were +collected, and the number of bytes freed." + (run-gc server (gc-action delete-specific) paths min-freed)) + ;;; ;;; Store paths. -- cgit v1.2.3