diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-05-25 00:25:15 +0200 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-05-25 00:25:15 +0200 |
commit | 57df83e07d4b5e78d9a54c1a88d05b4a9ed65714 (patch) | |
tree | 76684e63965e9ad6e37d9d45bc3159e6c9782cd0 /guix/scripts/processes.scm | |
parent | 43d9ed7792808638eabb43aa6133f1d6186c520b (diff) | |
parent | 136b7d81f0eb713783e9ea7cf7f260a2b6252dfd (diff) | |
download | guix-patches-57df83e07d4b5e78d9a54c1a88d05b4a9ed65714.tar guix-patches-57df83e07d4b5e78d9a54c1a88d05b4a9ed65714.tar.gz |
Merge branch 'staging' into core-updates
Diffstat (limited to 'guix/scripts/processes.scm')
-rw-r--r-- | guix/scripts/processes.scm | 40 |
1 files changed, 27 insertions, 13 deletions
diff --git a/guix/scripts/processes.scm b/guix/scripts/processes.scm index 6a2f603599..a2ab017490 100644 --- a/guix/scripts/processes.scm +++ b/guix/scripts/processes.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -103,9 +103,16 @@ processes." (let ((directory (string-append "/proc/" (number->string (process-id process)) "/fd"))) - (map (lambda (fd) - (readlink (string-append directory "/" fd))) - (or (scandir directory string->number) '())))) + (filter-map (lambda (fd) + ;; There's a TOCTTOU race here, hence the 'catch'. + (catch 'system-error + (lambda () + (readlink (string-append directory "/" fd))) + (lambda args + (if (= ENOENT (system-error-errno args)) + #f + (apply throw args))))) + (or (scandir directory string->number) '())))) ;; Daemon session. (define-record-type <daemon-session> @@ -151,15 +158,22 @@ active sessions, and the master 'guix-daemon' process." (= pid (process-parent-id process)))) processes)) - (values (map (lambda (process) - (match (process-command process) - ((argv0 (= string->number client) _ ...) - (let ((files (process-open-files process))) - (daemon-session process - (lookup-process client) - (lookup-children (process-id process)) - (filter lock-file? files)))))) - children) + (define (child-process->session process) + (match (process-command process) + ((argv0 (= string->number client) _ ...) + (let ((files (process-open-files process)) + (client (lookup-process client))) + ;; After a client has died, there's a window during which its + ;; corresponding 'guix-daemon' process is still alive, in which + ;; case 'lookup-process' returns #f. In that case ignore the + ;; session. + (and client + (daemon-session process client + (lookup-children + (process-id process)) + (filter lock-file? files))))))) + + (values (filter-map child-process->session children) master))) (define (daemon-session->recutils session port) |