bug#38359: Guix 1.0.1-10.41b4b71 test fails on armhf

[Mathieu Othacehe]

> Mmmh, I get what's going on in tests/processes.scm. It's an issue in
> (guix scripts processes) where argv0 is checked for "guix-daemon".
>
> When using --system my-system, argv0 is "qemu-my-system". So we need to
> check both argv0 and argv1 for "guix-daemon".
>
> I'll propose a patch.

Here it is. Please tell me what you think. Another solution would be to
accept that (guix process) is broken when guix-daemon is run via binfmt
and disable the tests in that case. However, I don't know how to detect
it properly for the test suite.

WDYT?

Mathieu

>From 3b6f5708043a29343275fadf0b0e0e651bb6971e Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <address@hidden>
Date: Fri, 29 Nov 2019 10:37:12 +0100
Subject: [PATCH] process: Fix binfmt support.

Guix-daemon does fork itself for each client process. The pid of the client is
hardcoded into the clone argv[1] field. (guix process) uses this debugging
feature to detect guix-daemon clients.

This does not work when the guix-daemon is run by binfmt. In that case two
problem occurs:

* Command line parsing fails because guix-daemon command line looks like
/gnu/store/xxx-qemu-arm /gnu/store/yyy-guix-daemon ... instead of just
/gnu/store/yyy-guix-daemon ...

* The pid stuffing mechanism does not work because the memory location of argv
differs when the forked process is in reality run by qemu-arm through binfmt.

The first problem is solved by reading /proc/pid/comm instead of parsing
/proc/pid/cmdline to detect if a process is a guix-daemon.

The second problem is solved by renaming guix-daemon forked process to
"guix/<client-pid>" using PR_SET_NAME. Then, (guix process) can parse the
process name instead of the cmdline to find client pids.

* nix/nix-daemon/nix-daemon.cc (acceptConnection): Change the forked process
name to "guix/<client-pid>" with PR_SET_NAME.
* guix/scripts/processes.scm (<process>): "command" field now contains the
content of /proc/pid/comm. Add a new field "command-line" to store the process
command line.
(read-command): New procedure.
(processes): Fill "command" field with /proc/pid/comm content and
"command-line" field with /proc/pid/cmdline content. Adapt "process"
construction accordingly.
(daemon-sessions): Identify guix-daemon main processes by filtering process
with "command" field set to "guix-daemon" and guix-daemon children by
filtering process with "command" field set to "guix/...".
In "child-process->session", parse children "command" field to extract client
pids.
(daemon-session->recutils): Adapt accordingly.
* tests/processes.scm (client): Guix-daemon client process command is now
"guix/...". Adapt accordingly.
---
 guix/scripts/processes.scm   | 78 +++++++++++++++++++-----------------
 nix/nix-daemon/nix-daemon.cc | 15 +++++++
 tests/processes.scm          |  2 +-
 3 files changed, 58 insertions(+), 37 deletions(-)

diff --git a/guix/scripts/processes.scm b/guix/scripts/processes.scm
index a2ab017490..6586da5996 100644
--- a/guix/scripts/processes.scm
+++ b/guix/scripts/processes.scm
@@ -32,6 +32,7 @@
             process-id
             process-parent-id
             process-command
+            process-command-line
             processes
 
             daemon-session?
@@ -45,11 +46,12 @@
 
 ;; Process as can be found in /proc on GNU/Linux.
 (define-record-type <process>
-  (process id parent command)
+  (process id parent command command-line)
   process?
-  (id       process-id)                           ;integer
-  (parent   process-parent-id)                    ;integer | #f
-  (command  process-command))                     ;list of strings
+  (id            process-id)               ;integer
+  (parent        process-parent-id)        ;integer | #f
+  (command       process-command)          ;string
+  (command-line  process-command-line))    ;list of strings
 
 (define (write-process process port)
   (format port "#<process ~a>" (process-id process)))
@@ -67,6 +69,9 @@
            (string->number (string-trim-both (string-drop line 5)))
            (loop))))))
 
+(define (read-command port)
+  (string-trim-right (read-string port) #\newline))
+
 (define %not-nul
   (char-set-complement (char-set #\nul)))
 
@@ -89,9 +94,12 @@ processes."
                       (call-with-input-file (string-append "/proc/" pid 
"/status")
                         read-status-ppid))
                     (define command
+                      (call-with-input-file (string-append "/proc/" pid 
"/comm")
+                        read-command))
+                    (define command-line
                       (call-with-input-file (string-append "/proc/" pid 
"/cmdline")
                         read-command-line))
-                    (process (string->number pid) ppid command))
+                    (process (string->number pid) ppid command command-line))
                   (lambda args
                     (if (= ENOENT (system-error-errno args))
                         #f
@@ -131,21 +139,17 @@ active sessions, and the master 'guix-daemon' process."
          (string-suffix? ".lock" file)))
 
   (let* ((processes (processes))
-         (daemons   (filter (lambda (process)
-                              (match (process-command process)
-                                ((argv0 _ ...)
-                                 (string=? (basename argv0) "guix-daemon"))
-                                (_ #f)))
-                            processes))
-         (children  (filter (lambda (process)
-                              (match (process-command process)
-                                ((argv0 (= string->number argv1) _ ...)
-                                 (integer? argv1))
-                                (_ #f)))
-                            daemons))
-         (master    (remove (lambda (process)
-                              (memq process children))
-                            daemons)))
+         (daemons   (filter
+                     (lambda (process)
+                       (string=? (process-command process) "guix-daemon"))
+                     processes))
+         ;; Guix-daemon children have their command set to
+         ;; "guix/<client-pid>".
+         (children  (filter
+                     (lambda (process)
+                       (string-prefix? "guix/" (process-command process)))
+                     processes)))
+
     (define (lookup-process pid)
       (find (lambda (process)
               (and (process-id process)
@@ -159,22 +163,24 @@ active sessions, and the master 'guix-daemon' process."
               processes))
 
     (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)))))))
+      (let* ((command (process-command process))
+             (client (string->number
+                      (substring command
+                                 (1+ (string-index command #\/)))))
+             (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)))
+            daemons)))
 
 (define (daemon-session->recutils session port)
   "Display SESSION information in recutils format on PORT."
@@ -183,14 +189,14 @@ active sessions, and the master 'guix-daemon' process."
   (format port "ClientPID: ~a~%"
           (process-id (daemon-session-client session)))
   (format port "ClientCommand:~{ ~a~}~%"
-          (process-command (daemon-session-client session)))
+          (process-command-line (daemon-session-client session)))
   (for-each (lambda (lock)
               (format port "LockHeld: ~a~%" lock))
             (daemon-session-locks-held session))
   (for-each (lambda (process)
               (format port "ChildProcess: ~a:~{ ~a~}~%"
                       (process-id process)
-                      (process-command process)))
+                      (process-command-line process)))
             (daemon-session-children session)))
 
 
diff --git a/nix/nix-daemon/nix-daemon.cc b/nix/nix-daemon/nix-daemon.cc
index 3dd156ba77..467439bb56 100644
--- a/nix/nix-daemon/nix-daemon.cc
+++ b/nix/nix-daemon/nix-daemon.cc
@@ -16,6 +16,7 @@
 #include <signal.h>
 #include <sys/types.h>
 #include <sys/wait.h>
+#include <sys/prctl.h>
 #include <sys/stat.h>
 #include <sys/socket.h>
 #include <sys/un.h>
@@ -967,9 +968,23 @@ static void acceptConnection(int fdSocket)
                 /* Restore normal handling of SIGCHLD. */
                 setSigChldAction(false);
 
+
                 /* For debugging, stuff the pid into argv[1]. */
                 if (clientPid != -1 && argvSaved[1]) {
                     string processName = std::to_string(clientPid);
+                    string new_pr_name =
+                        "guix/" + processName;
+                    /*
+                     * Stuffing the pid into argv[1] does not work if
+                     * guix-daemon in run with binfmt. Change the process name
+                     * to guix/pid, so that there is another way to find the
+                     * client pid.
+                     */
+                    prctl(PR_SET_NAME,
+                          new_pr_name.c_str(),
+                          NULL,
+                          NULL,
+                          NULL);
                     strncpy(argvSaved[1], processName.c_str(), 
strlen(argvSaved[1]));
                 }
 
diff --git a/tests/processes.scm b/tests/processes.scm
index 40454bcbc7..ffb9f507f4 100644
--- a/tests/processes.scm
+++ b/tests/processes.scm
@@ -48,7 +48,7 @@
                           (daemon-sessions)))
            (daemon  (daemon-session-process session)))
       (and (kill (process-id daemon) 0)
-           (string-suffix? "guix-daemon" (first (process-command daemon)))))))
+           (string-prefix? "guix/" (process-command daemon))))))
 
 (test-assert "client + lock"
   (with-store store
-- 
2.24.0