diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-10-29 00:08:15 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-10-29 00:08:44 +0100 |
commit | cb558fcd9c3818c20232305630acd6a18039318b (patch) | |
tree | a28ab8b628dc35eaa35934a22654c7d8006ceca2 /nix/scripts/list-runtime-roots.in | |
parent | 72e25e35a53e2833ac1d1d9c312d36ed78b239d6 (diff) | |
download | guix-cb558fcd9c3818c20232305630acd6a18039318b.tar.gz guix-cb558fcd9c3818c20232305630acd6a18039318b.zip |
list-runtime-roots: List files referenced by environment variables.
Inspired by <https://github.com/NixOS/nix/compare/772b70952f75...4ddd077bfa9a>.
* nix/scripts/list-runtime-roots.in (%store-directory): New variable.
(proc-environ-roots): New procedure.
(<top-level>): Use it.
Diffstat (limited to 'nix/scripts/list-runtime-roots.in')
-rw-r--r-- | nix/scripts/list-runtime-roots.in | 36 |
1 files changed, 33 insertions, 3 deletions
diff --git a/nix/scripts/list-runtime-roots.in b/nix/scripts/list-runtime-roots.in index 45fa0733d5..4d329c5ff5 100644 --- a/nix/scripts/list-runtime-roots.in +++ b/nix/scripts/list-runtime-roots.in @@ -1,7 +1,7 @@ #!@GUILE@ -ds !# ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,12 +28,17 @@ (ice-9 rdelim) (ice-9 popen) (srfi srfi-1) - (srfi srfi-26)) + (srfi srfi-26) + (rnrs io ports)) (define %proc-directory ;; Mount point of Linuxish /proc file system. "/proc") +(define %store-directory + (or (getenv "NIX_STORE_DIR") + "@storedir@")) + (define (proc-file-roots dir file) "Return a one-element list containing the file pointed to by DIR/FILE, or the empty list." @@ -78,6 +83,30 @@ or the empty list." (else (loop (read-line maps) roots))))))) +(define (proc-environ-roots dir) + "Return the list of store files referenced by DIR/environ, where DIR is a +/proc/XYZ directory." + (define split-on-nul + (cute string-tokenize <> + (char-set-complement (char-set #\nul)))) + + (define (rhs-file-names str) + (let ((equal (string-index str #\=))) + (if equal + (let* ((str (substring str (+ 1 equal))) + (rx (string-append (regexp-quote %store-directory) + "/[0-9a-z]{32}-[a-zA-Z0-9\\._+-]+"))) + (map match:substring (list-matches rx str))) + '()))) + + (define environ + (string-append dir "/environ")) + + (append-map rhs-file-names + (split-on-nul + (call-with-input-file environ + get-string-all)))) + (define (lsof-roots) "Return the list of roots as found by calling `lsof'." (catch 'system @@ -111,6 +140,7 @@ or the empty list." (append (proc-exe-roots proc) (proc-cwd-roots proc) (proc-fd-roots proc) - (proc-maps-roots proc)) + (proc-maps-roots proc) + (proc-environ-roots proc)) '()))) (append proc-roots (lsof-roots)))))) |