diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | config-daemon.ac | 3 | ||||
| -rw-r--r-- | daemon.am | 4 | ||||
| -rw-r--r-- | nix/scripts/list-runtime-roots.in | 116 | ||||
| -rwxr-xr-x | nix/sync-with-upstream | 4 | ||||
| -rw-r--r-- | tests/guix-daemon.sh | 4 |
6 files changed, 131 insertions, 1 deletions
diff --git a/.gitignore b/.gitignore index d39ad6ed96..3ef17152ba 100644 --- a/.gitignore +++ b/.gitignore @@ -61,3 +61,4 @@ stamp-h[0-9] /libutil.a /guix-daemon /test-tmp +/nix/scripts/list-runtime-roots diff --git a/config-daemon.ac b/config-daemon.ac index a10be14632..946f6e453d 100644 --- a/config-daemon.ac +++ b/config-daemon.ac @@ -91,6 +91,9 @@ if test "x$guix_build_daemon" = "xyes"; then dnl Check for <linux/fs.h> (for immutable file support). AC_CHECK_HEADERS([linux/fs.h]) + + AC_CONFIG_FILES([nix/scripts/list-runtime-roots], + [chmod +x nix/scripts/list-runtime-roots]) fi AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"]) diff --git a/daemon.am b/daemon.am index 48b0871a97..f5d58ea275 100644 --- a/daemon.am +++ b/daemon.am @@ -146,6 +146,9 @@ nix/libstore/schema.sql.hh: nix/libstore/schema.sql (lambda (in) \ (write (get-string-all in) out)))))" +nodist_pkglibexec_SCRIPTS = \ + nix/scripts/list-runtime-roots + EXTRA_DIST += \ nix/sync-with-upstream \ nix/libstore/schema.sql \ @@ -156,6 +159,7 @@ EXTRA_DIST += \ test_root = $(abs_top_builddir)/test-tmp AM_TESTS_ENVIRONMENT += \ + top_builddir="$(abs_top_builddir)" \ TEST_ROOT="$(test_root)" TESTS += \ diff --git a/nix/scripts/list-runtime-roots.in b/nix/scripts/list-runtime-roots.in new file mode 100644 index 0000000000..5c21ae543d --- /dev/null +++ b/nix/scripts/list-runtime-roots.in @@ -0,0 +1,116 @@ +#!@GUILE@ -ds +!# +;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of Guix. +;;; +;;; Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Guix. If not, see <http://www.gnu.org/licenses/>. + +;;; +;;; List files being used at run time; these files are garbage collector +;;; roots. This is equivalent to `find-runtime-roots.pl' in Nix. +;;; + +(use-modules (ice-9 ftw) + (ice-9 regex) + (ice-9 rdelim) + (ice-9 popen) + (srfi srfi-1) + (srfi srfi-26)) + +(define %proc-directory + ;; Mount point of Linuxish /proc file system. + "/proc") + +(define (proc-file-roots dir file) + "Return a one-element list containing the file pointed to by DIR/FILE, +or the empty list." + (or (and=> (false-if-exception (readlink (string-append dir "/" file))) + list) + '())) + +(define proc-exe-roots (cut proc-file-roots <> "exe")) +(define proc-cwd-roots (cut proc-file-roots <> "cwd")) + +(define (proc-fd-roots dir) + "Return the list of store files referenced by DIR, which is a +/proc/XYZ directory." + (let ((dir (string-append dir "/fd"))) + (filter-map (lambda (file) + (let ((target (false-if-exception + (readlink (string-append dir "/" file))))) + (and target + (string-prefix? "/" target) + target))) + (scandir dir string->number)))) + +(define (proc-maps-roots dir) + "Return the list of store files referenced by DIR, which is a +/proc/XYZ directory." + (define %file-mapping-line + (make-regexp "^.*[[:blank:]]+/([^ ]+)$")) + + (call-with-input-file (string-append dir "/maps") + (lambda (maps) + (let loop ((line (read-line maps)) + (roots '())) + (cond ((eof-object? line) + roots) + ((regexp-exec %file-mapping-line line) + => + (lambda (match) + (let ((file (string-append "/" + (match:substring match 1)))) + (loop (read-line maps) + (cons file roots))))) + (else + (loop (read-line maps) roots))))))) + +(define (lsof-roots) + "Return the list of roots as found by calling `lsof'." + (catch 'system + (lambda () + (let ((pipe (open-pipe* OPEN_READ "lsof" "-n" "-w" "-F" "n"))) + (define %file-rx + (make-regexp "^n/(.*)$")) + + (let loop ((line (read-line pipe)) + (roots '())) + (cond ((eof-object? line) + (begin + (close-pipe pipe) + roots)) + ((regexp-exec %file-rx line) + => + (lambda (match) + (loop (read-line pipe) + (cons (string-append "/" + (match:substring match 1)) + roots)))) + (else + (loop (read-line pipe) roots)))))) + (lambda _ + '()))) + +(let ((proc (format #f "~a/~a" %proc-directory (getpid)))) + (for-each (cut simple-format #t "~a~%" <>) + (delete-duplicates + (let ((proc-roots (if (file-exists? proc) + (append (proc-exe-roots proc) + (proc-cwd-roots proc) + (proc-fd-roots proc) + (proc-maps-roots proc)) + '()))) + (append proc-roots (lsof-roots)))))) diff --git a/nix/sync-with-upstream b/nix/sync-with-upstream index 324dcb27c9..69bd1fbee7 100755 --- a/nix/sync-with-upstream +++ b/nix/sync-with-upstream @@ -62,3 +62,7 @@ do done cp -v "$top_srcdir/nix-upstream/"{COPYING,AUTHORS} "$top_srcdir/nix" + +# Substitutions. +sed -i "$top_srcdir/nix/libstore/gc.cc" \ + -e 's|/nix/find-runtime-roots\.pl|/guix/list-runtime-roots|g' diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index d7926b2376..b6b92a78d4 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -29,8 +29,10 @@ NIX_LOCALSTATE_DIR="$TEST_ROOT/var" NIX_LOG_DIR="$TEST_ROOT/var/log/nix" NIX_STATE_DIR="$TEST_ROOT/var/nix" NIX_DB_DIR="$TEST_ROOT/db" +NIX_ROOT_FINDER="$top_builddir/nix/scripts/list-runtime-roots" export NIX_SUBSTITUTERS NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR \ - NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR + NIX_LOCALSTATE_DIR NIX_LOG_DIR NIX_STATE_DIR NIX_DB_DIR \ + NIX_ROOT_FINDER guix-daemon --version guix-build --version |