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

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

[Mathieu Othacehe]

Hello,

I have 3 failing tests when building guix 1.0.1-10.41b4b71 on armhf. I
didn't build with -K argument and as it takes ~10 hours, so I'll just paste
my terminal output for now.

It seems to fail on ci.guix.info but the log is partial?

http://ci.guix.info/log/ma98kc90y5jp7h1ydxjlfa7r3nx0sd37-guix-1.0.1-10.41b4b71

Here is my output:

--8<---------------cut here---------------start------------->8---
=================================================
   GNU Guix 1.0.1-10.41b4b71: ./test-suite.log
=================================================
  
# TOTAL: 975
# PASS:  903
# SKIP:  67
# XFAIL: 2
# FAIL:  3
# XPASS: 0
# ERROR: 0
--8<---------------cut here---------------end--------------->8---

and the failing tests:

--8<---------------cut here---------------start------------->8---
test-name: make-lzip-input-port/compressed
location: /tmp/guix-build-guix-1.0.1-10.41b4b71.drv-0/source/tests/lzlib.scm:111
source:
+ (test-assert
+   "make-lzip-input-port/compressed"
+   (let* ((len (pk 'len (+ 10 (random 4000 %seed))))
+          (data (random-bytevector len))
+          (compressed
+            (make-lzip-input-port/compressed
+              (open-bytevector-input-port data)))
+          (result
+            (call-with-lzip-input-port
+              compressed
+              get-bytevector-all)))
+     (pk (bytevector-length result)
+         (bytevector-length data))
+     random seed for tests: 1574602043
(bytevector=? result data)))

;;; (len 3501)
actual-value: #f
actual-error:
+ (wrong-type-arg
+   #f
+   "Wrong type to apply: ~S"
+   (#f)
+   (#f))
result: FAIL
--8<---------------cut here---------------end--------------->8---

and,

--8<---------------cut here---------------start------------->8---
test-name: client
location: /tmp/guix-build-guix-1.0.1-10.41b4b71.drv-0/source/tests/processes.scm:43
source:
+ (test-assert
+   "client"
+   (with-store
+     store
+     (let* ((session
+              (find (lambda (session)
+                      (= (getpid)
+                         (process-id (daemon-session-client session))))
+                    (daemon-sessions)))
+            (daemon (daemon-session-process session)))
+       (and (kill (process-id daemon) 0)
+            (string-suffix?
+              "guix-daemon"
+              (first (process-command daemon)))))))
actual-value: #f
actual-error:
+ (wrong-type-arg
+   "struct_vtable"
+   "Wrong type argument in position ~A (expecting ~A): ~S"
+   (1 "struct" #f)
+   (#f))
result: FAIL
--8<---------------cut here---------------end--------------->8---

and,

--8<---------------cut here---------------start------------->8---
test-name: client + lock
location: /tmp/guix-build-guix-1.0.1-10.41b4b71.drv-0/source/tests/processes.scm:53
source:
+ (test-assert
+   "client + lock"
+   (with-store
+     store
+     (call-with-temporary-directory
+       (lambda (directory)
+         (let* ((token1 (string-append directory "/token1"))
+                (token2 (string-append directory "/token2"))
+                (exp (gexp (begin
+                             (ungexp (random-text))
+                             (mkdir (ungexp token1))
+                             (let loop ()
+                               (unless
+                                 (file-exists? (ungexp token2))
+                                 (sleep 1)
+                                 (loop)))
+                             (mkdir (ungexp output)))))
+                (guile (package-derivation store %bootstrap-guile))
+                (drv (run-with-store
+                       store
+                       (gexp->derivation
+                         "foo"
+                         exp
+                         #:guile-for-build
+                         guile)))
+                (thread
+                  (call-with-new-thread
+                    (lambda () (build-derivations store (list drv)))))
+                (_ (let loop ()
+                     (unless
+                       (file-exists? token1)
+                       (usleep 200)
+                       (loop))))
+                (session
+                  (find (lambda (session)
+                          (= (getpid)
+                             (process-id (daemon-session-client session))))
+                        (daemon-sessions)))
+                (locks (daemon-session-locks-held (pk 'session session))))
+           (call-with-output-file token2 (const #t))
+           (equal?
+             (list (string-append
+                     (derivation->output-path drv)
+                     ".lock"))
+             locks))))))

;;; (session #f)
actual-value: #f
actual-error:
+ (wrong-type-arg
+   "struct_vtable"
+   "Wrong type argument in position ~A (expecting ~A): ~S"
+   (1 "struct" #f)
+   (#f))
result: FAIL
--8<---------------cut here---------------end--------------->8---

Thanks,

Mathieu

bug#38359: Mistaken merge

[Jack Hill]

Oops, I didn't mean to merge this bug with the other ones. I'll look up 
how to unmerge shortly.

Apologies,
Jack

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.

Mathieu

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

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 1204 bytes --]


About the failing test below, lzip is not found on armhf and all tests
are skipped but the last one, that fails.

The patch attached, makes sure that this test is also skipped if lzip is
not found.

Now I'm not sure why it is not found but that's another matter.

WDYT?

Mathieu

> --8<---------------cut here---------------start------------->8---
> test-name: make-lzip-input-port/compressed
> location: /tmp/guix-build-guix-1.0.1-10.41b4b71.drv-0/source/tests/lzlib.scm:111
> source:
> + (test-assert
> +   "make-lzip-input-port/compressed"
> +   (let* ((len (pk 'len (+ 10 (random 4000 %seed))))
> +          (data (random-bytevector len))
> +          (compressed
> +            (make-lzip-input-port/compressed
> +              (open-bytevector-input-port data)))
> +          (result
> +            (call-with-lzip-input-port
> +              compressed
> +              get-bytevector-all)))
> +     (pk (bytevector-length result)
> +         (bytevector-length data))
> +     random seed for tests: 1574602043
> (bytevector=? result data)))
>
> ;;; (len 3501)
> actual-value: #f
> actual-error:
> + (wrong-type-arg
> +   #f
> +   "Wrong type to apply: ~S"
> +   (#f)
> +   (#f))
> result: FAIL


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-tests-lzlib-Do-not-fail-if-lzlib-in-not-available.patch --]
[-- Type: text/x-diff, Size: 981 bytes --]

From 13d2014879372a947e3239c14bdc9f6ae8f3c318 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Tue, 26 Nov 2019 08:31:43 +0100
Subject: [PATCH] tests: lzlib: Do not fail if lzlib in not available.

* tests/lzlib.scm: Use test-assert* for all test cases, so that there are no
failures if lzlib is unavailable.
---
 tests/lzlib.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/lzlib.scm b/tests/lzlib.scm
index 543622bb45..d8d0e6edf8 100644
--- a/tests/lzlib.scm
+++ b/tests/lzlib.scm
@@ -108,7 +108,7 @@
 (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)"
   (compress-and-decompress (random-bytevector (1+ (* 1024 1024)))))
 
-(test-assert "make-lzip-input-port/compressed"
+(test-assert* "make-lzip-input-port/compressed"
   (let* ((len        (pk 'len (+ 10 (random 4000 %seed))))
          (data       (random-bytevector len))
          (compressed (make-lzip-input-port/compressed
-- 
2.24.0

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

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 556 bytes --]


> 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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-process-Fix-binfmt-support.patch --]
[-- Type: text/x-diff, Size: 10383 bytes --]

From 3b6f5708043a29343275fadf0b0e0e651bb6971e Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
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)))
 
 \f
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

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

[Ludovic Courtès]

Hi Mathieu,

Sorry for the delay!

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>> 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.

Good catch!  When “transparent” emulation is no longer transparent…

> 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.

It’s kinda ugly, but I’d be tempted to go for that second solution:
detecting in tests/processes.scm that we’re under binfmt_misc and
skipping tests.

The reason is that while your patch looks great to me, it would break
when new “guix processes” is used with an old daemon.  There are other
details, like “guix/PID” is not as nice as “guix-daemon PID” (or
similar) for grepping purposes, but “guix-daemon PID” might hit the
limit on command name length.  Tricky!

As for the detection, this appears to work:

  (define (binfmt-misc?)
    (let ((pid (getpid))
          (cmdline (call-with-input-file "/proc/self/cmdline" get-string-all)))
      (match (primitive-fork)
        (0 (dynamic-wind
             (const #t)
             (lambda ()
               (exit (not (equal? (call-with-input-file (format #f "/proc/~a/cmdline" pid)
                                    get-string-all)
                                  cmdline))))
             (const #t)))
        (x (zero? (pk (cdr (waitpid x))))))))

WDYT?

Thanks,
Ludo’.

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

[Mathieu Othacehe]

Hola!

> As for the detection, this appears to work:
>
>   (define (binfmt-misc?)
>     (let ((pid (getpid))
>           (cmdline (call-with-input-file "/proc/self/cmdline" get-string-all)))
>       (match (primitive-fork)
>         (0 (dynamic-wind
>              (const #t)
>              (lambda ()
>                (exit (not (equal? (call-with-input-file (format #f "/proc/~a/cmdline" pid)
>                                     get-string-all)
>                                   cmdline))))
>              (const #t)))
>         (x (zero? (pk (cdr (waitpid x))))))))
>
> WDYT?

Nice trick, I didn't think of forking process to fool qemu-user ;)

Pushed a fix with your snippet as
0b5ad0e756a34d5e3ed1f37c3d4083a330fa33f5.

Thanks,

Mathieu

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

[Ludovic Courtès]

Bon dia!

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>> As for the detection, this appears to work:
>>
>>   (define (binfmt-misc?)
>>     (let ((pid (getpid))
>>           (cmdline (call-with-input-file "/proc/self/cmdline" get-string-all)))
>>       (match (primitive-fork)
>>         (0 (dynamic-wind
>>              (const #t)
>>              (lambda ()
>>                (exit (not (equal? (call-with-input-file (format #f "/proc/~a/cmdline" pid)
>>                                     get-string-all)
>>                                   cmdline))))
>>              (const #t)))
>>         (x (zero? (pk (cdr (waitpid x))))))))
>>
>> WDYT?
>
> Nice trick, I didn't think of forking process to fool qemu-user ;)
>
> Pushed a fix with your snippet as
> 0b5ad0e756a34d5e3ed1f37c3d4083a330fa33f5.

Awesome, thank you!

Ludo’.