GNU bug report logs - #57076
[PATCH] linux-container: container-script: Parse command line options.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 57076 in the body.
You can then email your comments to 57076 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: guix-patches <at> gnu.org
Cc: Ricardo Wurmus <rekado <at> elephly.net>
Subject: [PATCH] linux-container: container-script: Parse command line options.
Date: Tue,  9 Aug 2022 14:56:59 +0200

* gnu/system/linux-container.scm (container-script): Accept command line
options to bind mount host directories into the container.
---
 gnu/system/linux-container.scm | 97 +++++++++++++++++++++++++---------
 1 file changed, 72 insertions(+), 25 deletions(-)

diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 24077e347a..69080bcacb 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2019 Arun Isaac <arunisaac <at> systemreboot.net>
 ;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
 ;;; Copyright © 2020 Google LLC
+;;; Copyright © 2022 Ricardo Wurmus <rekado <at> elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -202,16 +203,49 @@ (define script
                          (guix build utils)
                          (guix i18n)
                          (guix diagnostics)
-                         (srfi srfi-1))
+                         (srfi srfi-1)
+                         (srfi srfi-37)
+                         (ice-9 match))
 
-            (define file-systems
-              (filter-map (lambda (spec)
-                            (let* ((fs    (spec->file-system spec))
-                                   (flags (file-system-flags fs)))
-                              (and (or (not (memq 'bind-mount flags))
-                                       (file-exists? (file-system-device fs)))
-                                   fs)))
-                          '#$specs))
+            (define (show-help)
+              (display (G_ "Usage: run-container [OPTION ...]
+Run the container with the given options."))
+              (newline)
+              (display (G_ "
+      --share=SPEC       share host file system with read/write access
+                         according to SPEC"))
+              (display (G_ "
+      --expose=SPEC      expose host file system directory as read-only
+                         according to SPEC"))
+              (newline)
+              (display (G_ "
+  -h, --help             display this help and exit"))
+              (newline))
+
+            (define %options
+              ;; Specifications of the command-line options.
+              (list (option '(#\h "help") #f #f
+                            (lambda args
+                              (show-help)
+                              (exit 0)))
+                    (option '("share") #t #f
+                            (lambda (opt name arg result)
+                              (alist-cons 'file-system-mapping
+                                          (specification->file-system-mapping arg #t)
+                                          result)))
+                    (option '("expose") #t #f
+                            (lambda (opt name arg result)
+                              (alist-cons 'file-system-mapping
+                                          (specification->file-system-mapping arg #f)
+                                          result)))))
+
+            (define (parse-options args options)
+              (args-fold args options
+                         (lambda (opt name arg . rest)
+                           (report-error (G_ "~A: unrecognized option~%") name)
+                           (exit 1))
+                         (lambda (op res) (cons op res))
+                         '()))
 
             (define (explain pid)
               ;; XXX: We can't quite call 'bindtextdomain' so there's actually
@@ -225,22 +259,35 @@ (define (explain pid)
               (info (G_ "or run 'sudo nsenter -a -t ~a' to get a shell into it.~%") pid)
               (newline (guix-warning-port)))
 
-            (call-with-container file-systems
-              (lambda ()
-                (setenv "HOME" "/root")
-                (setenv "TMPDIR" "/tmp")
-                (setenv "GUIX_NEW_SYSTEM" #$os)
-                (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
-                (primitive-load (string-append #$os "/boot")))
-              ;; A range of 65536 uid/gids is used to cover 16 bits worth of
-              ;; users and groups, which is sufficient for most cases.
-              ;;
-              ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
-              #:host-uids 65536
-              #:namespaces (if #$shared-network?
-                               (delq 'net %namespaces)
-                               %namespaces)
-              #:process-spawned-hook explain))))
+            (let* ((opts (parse-options (cdr (command-line)) %options))
+                   (mappings (filter-map (match-lambda
+                                           (('file-system-mapping . mapping) mapping)
+                                           (_ #f))
+                                         opts))
+                   (file-systems
+                    (filter-map (lambda (fs)
+                                  (let ((flags (file-system-flags fs)))
+                                    (and (or (not (memq 'bind-mount flags))
+                                             (file-exists? (file-system-device fs)))
+                                         fs)))
+                                (append (map file-system-mapping->bind-mount mappings)
+                                        (map spec->file-system '#$specs)))))
+              (call-with-container file-systems
+                (lambda ()
+                  (setenv "HOME" "/root")
+                  (setenv "TMPDIR" "/tmp")
+                  (setenv "GUIX_NEW_SYSTEM" #$os)
+                  (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
+                  (primitive-load (string-append #$os "/boot")))
+                ;; A range of 65536 uid/gids is used to cover 16 bits worth of
+                ;; users and groups, which is sufficient for most cases.
+                ;;
+                ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
+                #:host-uids 65536
+                #:namespaces (if #$shared-network?
+                                 (delq 'net %namespaces)
+                                 %namespaces)
+                #:process-spawned-hook explain)))))
 
     (gexp->script "run-container" script)))
 
-- 
2.36.1

Message #8 received at 57076 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Ricardo Wurmus <rekado <at> elephly.net>
Cc: 57076 <at> debbugs.gnu.org
Subject: Re: bug#57076: [PATCH] linux-container: container-script: Parse
 command line options.
Date: Tue, 09 Aug 2022 16:53:56 +0200

Hi,

Ricardo Wurmus <rekado <at> elephly.net> skribis:

> * gnu/system/linux-container.scm (container-script): Accept command line
> options to bind mount host directories into the container.

I like that, go for it!  Perhaps you can add a line in doc/guix.texi,
under ‘container’ in “Invoking guix system”, like:

  The @option{--share} and @option{--expose} can also be passed to the
  generated script.

Thanks,
Ludo’.

Message #13 received at 57076-done <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 57076-done <at> debbugs.gnu.org
Subject: Re: bug#57076: [PATCH] linux-container: container-script: Parse
 command line options.
Date: Tue, 09 Aug 2022 20:39:20 +0200

Ludovic Courtès <ludo <at> gnu.org> writes:

> Ricardo Wurmus <rekado <at> elephly.net> skribis:
>
>> * gnu/system/linux-container.scm (container-script): Accept command line
>> options to bind mount host directories into the container.
>
> I like that, go for it!  Perhaps you can add a line in doc/guix.texi,
> under ‘container’ in “Invoking guix system”, like:
>
>   The @option{--share} and @option{--expose} can also be passed to the
>   generated script.

Done.

Thanks for the quick review!

-- 
Ricardo

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.