summary refs log tree commit diff
path: root/gnu/build
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/image.scm7
-rw-r--r--gnu/build/marionette.scm45
2 files changed, 31 insertions, 21 deletions
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 81caa424f8..3e8b94e2d6 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020, 2022 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -48,12 +49,13 @@
   "Take SEXP, a tuple as returned by 'partition->gexp', and turn it into a
 <partition> record."
   (match sexp
-    ((size file-system file-system-options label uuid)
+    ((size file-system file-system-options label uuid flags)
      (partition (size size)
                 (file-system file-system)
                 (file-system-options file-system-options)
                 (label label)
-                (uuid uuid)))))
+                (uuid uuid)
+                (flags flags)))))
 
 (define (size-in-kib size)
   "Convert SIZE expressed in bytes, to kilobytes and return it as a string."
@@ -78,6 +80,7 @@ turn doesn't take any constant overhead into account, force a 1-MiB minimum."
         (fs-options (partition-file-system-options partition))
         (label (partition-label partition))
         (uuid (partition-uuid partition))
+        (flags (partition-flags partition))
         (journal-options "lazy_itable_init=1,lazy_journal_init=1"))
     (apply invoke
            `("fakeroot" "mke2fs" "-t" ,fs "-d" ,root
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index b336024610..0d2af642c8 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -196,31 +196,38 @@ FILE has not shown up after TIMEOUT seconds, raise an error."
      (error "file didn't show up" file))))
 
 (define* (wait-for-tcp-port port marionette
-                            #:key (timeout 20))
+                            #:key
+                            (timeout 20)
+                            (address `(make-socket-address AF_INET
+                                                           INADDR_LOOPBACK
+                                                           ,port)))
   "Wait for up to TIMEOUT seconds for PORT to accept connections in
-MARIONETTE.  Raise an error on failure."
+MARIONETTE.  ADDRESS must be an expression that returns a socket address,
+typically a call to 'make-socket-address'.  Raise an error on failure."
   ;; Note: The 'connect' loop has to run within the guest because, when we
   ;; forward ports to the host, connecting to the host never raises
   ;; ECONNREFUSED.
   (match (marionette-eval
-          `(begin
-             (let ((sock (socket PF_INET SOCK_STREAM 0)))
-               (let loop ((i 0))
-                 (catch 'system-error
-                   (lambda ()
-                     (connect sock AF_INET INADDR_LOOPBACK ,port)
-                     (close-port sock)
-                     'success)
-                   (lambda args
-                     (if (< i ,timeout)
-                         (begin
-                           (sleep 1)
-                           (loop (+ 1 i)))
-                         'failure))))))
+          `(let* ((address ,address)
+                  (sock (socket (sockaddr:fam address) SOCK_STREAM 0)))
+             (let loop ((i 0))
+               (catch 'system-error
+                 (lambda ()
+                   (connect sock address)
+                   (close-port sock)
+                   'success)
+                 (lambda args
+                   (if (< i ,timeout)
+                       (begin
+                         (sleep 1)
+                         (loop (+ 1 i)))
+                       (list 'failure address))))))
           marionette)
     ('success #t)
-    ('failure
-     (error "nobody's listening on port" port))))
+    (('failure address)
+     (error "nobody's listening on port"
+            (list (inet-ntop (sockaddr:fam address) (sockaddr:addr address))
+                  (sockaddr:port address))))))
 
 (define* (wait-for-unix-socket file-name marionette
                                 #:key (timeout 20))