summaryrefslogtreecommitdiff
path: root/nix/scripts/list-runtime-roots.in
diff options
context:
space:
mode:
Diffstat (limited to 'nix/scripts/list-runtime-roots.in')
-rw-r--r--nix/scripts/list-runtime-roots.in147
1 files changed, 0 insertions, 147 deletions
diff --git a/nix/scripts/list-runtime-roots.in b/nix/scripts/list-runtime-roots.in
deleted file mode 100644
index 5f2660fb5e..0000000000
--- a/nix/scripts/list-runtime-roots.in
+++ /dev/null
@@ -1,147 +0,0 @@
-#!@GUILE@ -ds
-!#
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU 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.
-;;;
-;;; GNU 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 GNU 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 match)
- (srfi srfi-1)
- (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."
- (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)))
- (or (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 (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 (referenced-files)
- "Return the list of referenced store items."
- (append-map (lambda (pid)
- (let ((proc (string-append %proc-directory "/" pid)))
- (catch 'system-error
- (lambda ()
- (append (proc-exe-roots proc)
- (proc-cwd-roots proc)
- (proc-fd-roots proc)
- (proc-maps-roots proc)
- (proc-environ-roots proc)))
- (lambda args
- (let ((err (system-error-errno args)))
- (if (or (= ENOENT err) ;TOCTTOU race
- (= ESRCH err) ;ditto
- (= EACCES err)) ;not running as root
- '()
- (apply throw args)))))))
- (scandir %proc-directory string->number
- (lambda (a b)
- (< (string->number a) (string->number b))))))
-
-(define canonicalize-store-item
- (let* ((store (string-append %store-directory "/"))
- (prefix (string-length store)))
- (lambda (file)
- "Return #f if FILE is not a store item; otherwise, return the store file
-name without any sub-directory components."
- (and (string-prefix? store file)
- (string-append store
- (let ((base (string-drop file prefix)))
- (match (string-index base #\/)
- (#f base)
- (slash (string-take base slash)))))))))
-
-(for-each (cut simple-format #t "~a~%" <>)
- (delete-duplicates
- (filter-map canonicalize-store-item (referenced-files))))