[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Christopher Baines]

This is a port of the functionality in the Guix environment command to the
guix system container command.

This requires additional changes to the operating-system definitions used, in
particular, networking related services may need removing if the host network
is shared.

* guix/scripts/system.scm (system-derivation-for-action): Add
  #:container-shared-network? argument.
  (perform-action): Add #:container-shared-network? argument.
  (show-help): Add "-N, --network" help information.
  (%options): Add network option.
  (process-action): Call perform-action with #:container-shared-network?.
* gnu/system/linux-container.scm (%network-configuration-files): New variable.
  (container-script): Add support for returning a container script that shares
  the host network.
* gnu/system.scm (essential-services): Add #:container-shared-network?
  argument.
  (operating-system-services): Add #:container-shared-network? argument.
  (operating-system-etc-service): Add #:container-shared-network? argument,
  and support for ommiting some configuration if the network is shared.
  (operating-system-activation-script): Add #:container-shared-network?
  argument, and pass this through to the operating-system-services procedure.
  (operating-system-boot-script): Add #:container-shared-network? argument,
  and pass this through to the operating-system-services procedure.
  (operating-system-derivation): Add the #:container-shared-network? argument,
  and pass this through to the operating-system-services procedure.
  (operating-system-profile): Add the #:container-shared-network? argument,
  and pass this through to the operating-system-services procedure.
---
 gnu/system.scm                 | 63 +++++++++++++++++++++++++++++-------------
 gnu/system/linux-container.scm | 47 +++++++++++++++++++++++++++----
 guix/scripts/system.scm        | 18 ++++++++++--
 3 files changed, 101 insertions(+), 27 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index fdb5be287..a8a7ac005 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -415,7 +415,7 @@ value of the SYSTEM-SERVICE-TYPE service."
                       ("initrd" ,initrd)
                       ("locale" ,locale))))))))   ;used by libc
 
-(define* (essential-services os #:key container?)
+(define* (essential-services os #:key container? container-shared-network?)
   "Return the list of essential services for OS.  These are special services
 that implement part of what's declared in OS are responsible for low-level
 bookkeeping.  CONTAINER? determines whether to return the list of services for
@@ -423,6 +423,9 @@ a container or that of a \"bare metal\" system."
   (define known-fs
     (map file-system-mount-point (operating-system-file-systems os)))
 
+  (if (and container-shared-network? (not container?))
+      (error "cannot specify container-shared-network? without container? #t"))
+
   (let* ((mappings  (device-mapping-services os))
          (root-fs   (root-file-system-service))
          (other-fs  (non-boot-file-system-service os))
@@ -447,7 +450,8 @@ a container or that of a \"bare metal\" system."
            (account-service (append (operating-system-accounts os)
                                     (operating-system-groups os))
                             (operating-system-skeletons os))
-           (operating-system-etc-service os)
+           (operating-system-etc-service
+            os #:container-shared-network? container-shared-network?)
            (service fstab-service-type '())
            (session-environment-service
             (operating-system-environment-variables os))
@@ -467,11 +471,14 @@ a container or that of a \"bare metal\" system."
                              (service firmware-service-type
                                       (operating-system-firmware os))))))))
 
-(define* (operating-system-services os #:key container?)
+(define* (operating-system-services os #:key container? container-shared-network?)
   "Return all the services of OS, including \"internal\" services that do not
 explicitly appear in OS."
   (append (operating-system-user-services os)
-          (essential-services os #:container? container?)))
+          (essential-services
+           os
+           #:container? container?
+           #:container-shared-network? container-shared-network?)))
 
 \f
 ;;;
@@ -534,7 +541,7 @@ This is the GNU system.  Welcome.\n")
   "Return the default /etc/hosts file."
   (plain-file "hosts" (local-host-aliases host-name)))
 
-(define* (operating-system-etc-service os)
+(define* (operating-system-etc-service os #:key container-shared-network?)
   "Return a <service> that builds containing the static part of the /etc
 directory."
   (let ((login.defs (plain-file "login.defs" "# Empty for now.\n"))
@@ -613,19 +620,22 @@ then
   source /run/current-system/profile/etc/profile.d/bash_completion.sh
 fi\n")))
     (etc-service
-     `(("services" ,(file-append net-base "/etc/services"))
-       ("protocols" ,(file-append net-base "/etc/protocols"))
+     `(("protocols" ,(file-append net-base "/etc/protocols"))
        ("rpc" ,(file-append net-base "/etc/rpc"))
        ("login.defs" ,#~#$login.defs)
        ("issue" ,#~#$issue)
-       ("nsswitch.conf" ,#~#$nsswitch)
        ("profile" ,#~#$profile)
        ("bashrc" ,#~#$bashrc)
-       ("hosts" ,#~#$(or (operating-system-hosts-file os)
-                         (default-/etc/hosts (operating-system-host-name os))))
        ("localtime" ,(file-append tzdata "/share/zoneinfo/"
                                   (operating-system-timezone os)))
-       ("sudoers" ,(operating-system-sudoers-file os))))))
+       ("sudoers" ,(operating-system-sudoers-file os))
+       ,@(if container-shared-network?
+             '()
+             `(("services" ,(file-append net-base "/etc/services"))
+               ("nsswitch.conf" ,#~#$nsswitch)
+               ("hosts" ,#~#$(or (operating-system-hosts-file os)
+                                 (default-/etc/hosts
+                                   (operating-system-host-name os))))))))))
 
 (define %root-account
   ;; Default root account.
@@ -733,20 +743,28 @@ use 'plain-file' instead~%")
 root ALL=(ALL) ALL
 %wheel ALL=(ALL) ALL\n"))
 
-(define* (operating-system-activation-script os #:key container?)
+(define* (operating-system-activation-script os #:key container?
+                                             container-shared-network?)
   "Return the activation script for OS---i.e., the code that \"activates\" the
 stateful part of OS, including user accounts and groups, special directories,
 etc."
-  (let* ((services   (operating-system-services os #:container? container?))
+  (let* ((services   (operating-system-services
+                      os
+                      #:container? container?
+                      #:container-shared-network? container-shared-network?))
          (activation (fold-services services
                                     #:target-type activation-service-type)))
     (activation-service->script activation)))
 
-(define* (operating-system-boot-script os #:key container?)
+(define* (operating-system-boot-script os #:key container?
+                                       container-shared-network?)
   "Return the boot script for OS---i.e., the code started by the initrd once
 we're running in the final root.  When CONTAINER? is true, skip all
 hardware-related operations as necessary when booting a Linux container."
-  (let* ((services (operating-system-services os #:container? container?))
+  (let* ((services (operating-system-services
+                    os
+                    #:container? container?
+                    #:container-shared-network? container-shared-network?))
          (boot     (fold-services services #:target-type boot-service-type)))
     ;; BOOT is the script as a monadic value.
     (service-value boot)))
@@ -767,17 +785,24 @@ hardware-related operations as necessary when booting a Linux container."
                               #:target-type
                               shepherd-root-service-type))))
 
-(define* (operating-system-derivation os #:key container?)
+(define* (operating-system-derivation os #:key container?
+                                      container-shared-network?)
   "Return a derivation that builds OS."
-  (let* ((services (operating-system-services os #:container? container?))
+  (let* ((services (operating-system-services
+                    os
+                    #:container? container?
+                    #:container-shared-network? container-shared-network?))
          (system   (fold-services services)))
     ;; SYSTEM contains the derivation as a monadic value.
     (service-value system)))
 
-(define* (operating-system-profile os #:key container?)
+(define* (operating-system-profile os #:key container? container-shared-network?)
   "Return a derivation that builds the system profile of OS."
   (mlet* %store-monad
-      ((services -> (operating-system-services os #:container? container?))
+      ((services -> (operating-system-services
+                     os
+                     #:container? container?
+                     #:container-shared-network? container-shared-network?))
        (profile (fold-services services
                                #:target-type profile-service-type)))
     (match profile
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index bceea4133..538b1f19c 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -60,18 +60,50 @@ containerized OS."
                           %container-file-systems
                           user-file-systems))))
 
-(define* (container-script os #:key (mappings '()))
+
+(define %network-configuration-files
+  '("/etc/resolv.conf"
+    "/etc/nsswitch.conf"
+    "/etc/services"
+    "/etc/hosts"))
+
+(define* (container-script os #:key (mappings '())
+                           container-shared-network?)
   "Return a derivation of a script that runs OS as a Linux container.
 MAPPINGS is a list of <file-system> objects that specify the files/directories
 that will be shared with the host system."
-  (let* ((os           (containerized-operating-system os mappings))
+  (let* ((os           (containerized-operating-system
+                        os
+                        (append
+                         mappings
+                         (if
+                          container-shared-network?
+                          (filter-map (lambda (file)
+                                        (and (file-exists? file)
+                                             (file-system-mapping
+                                              (source file)
+                                              (target file)
+                                              ;; XXX: On some GNU/Linux
+                                              ;; systems, /etc/resolv.conf is a
+                                              ;; symlink to a file in a tmpfs
+                                              ;; which, for an unknown reason,
+                                              ;; cannot be bind mounted
+                                              ;; read-only within the
+                                              ;; container.
+                                              (writable?
+                                               (string=?
+                                                file "/etc/resolv.conf")))))
+                                      %network-configuration-files)
+                          '()))))
          (file-systems (filter file-system-needed-for-boot?
                                (operating-system-file-systems os)))
          (specs        (map file-system->spec file-systems)))
 
-    (mlet* %store-monad ((os-drv (operating-system-derivation
-                                  os
-                                  #:container? #t)))
+    (mlet* %store-monad ((os-drv
+                          (operating-system-derivation
+                           os
+                           #:container? #t
+                           #:container-shared-network? container-shared-network?)))
 
       (define script
         (with-imported-modules (source-module-closure
@@ -93,6 +125,9 @@ that will be shared with the host system."
                 ;; 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))))
+                #:host-uids 65536
+                #:namespaces (if #$container-shared-network?
+                                 (delq 'net %namespaces)
+                                 %namespaces)))))
 
       (gexp->script "run-container" script))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 5a2811e75..2fe687cdb 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -561,13 +561,15 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
 
 (define* (system-derivation-for-action os action
                                        #:key image-size file-system-type
-                                       full-boot? mappings)
+                                       full-boot? mappings
+                                       container-shared-network?)
   "Return as a monadic value the derivation for OS according to ACTION."
   (case action
     ((build init reconfigure)
      (operating-system-derivation os))
     ((container)
-     (container-script os #:mappings mappings))
+     (container-script os #:mappings mappings
+                       #:container-shared-network? container-shared-network?))
     ((vm-image)
      (system-qemu-image os #:disk-image-size image-size))
     ((vm)
@@ -617,6 +619,7 @@ and TARGET arguments."
                          dry-run? derivations-only?
                          use-substitutes? device target
                          image-size file-system-type full-boot?
+                         container-shared-network?
                          (mappings '())
                          (gc-root #f))
   "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
@@ -626,6 +629,8 @@ root directory; IMAGE-SIZE is the size of the image to be built, for the
 The root filesystem is created as a FILE-SYSTEM-TYPE filesystem.
 FULL-BOOT? is used for the 'vm' action;
 it determines whether to boot directly to the kernel or to the bootloader.
+CONTAINER-SHARED_NETWORK? determines if the container will use a use a
+separate network namespace.
 
 When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
 building anything.
@@ -643,6 +648,7 @@ output when building a system derivation, such as a disk image."
                                                 #:file-system-type file-system-type
                                                 #:image-size image-size
                                                 #:full-boot? full-boot?
+                                                #:container-shared-network? container-shared-network?
                                                 #:mappings mappings))
        (bootloader -> (bootloader-configuration-bootloader
                        (operating-system-bootloader os)))
@@ -795,6 +801,8 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --share=SPEC       for 'vm', share host file system according to SPEC"))
   (display (G_ "
+  -N, --network          for 'container', allow containers to access the network"))
+  (display (G_ "
   -r, --root=FILE        for 'vm', 'vm-image', 'disk-image', 'container',
                          and 'build', make FILE a symlink to the result, and
                          register it as a garbage collector root"))
@@ -834,6 +842,9 @@ Some ACTIONS support additional ARGS.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'image-size (size->number arg)
                                result)))
+         (option '(#\N "network") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'container-shared-network? #t result)))
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
@@ -928,6 +939,9 @@ resulting from command-line parsing."
                              #:file-system-type (assoc-ref opts 'file-system-type)
                              #:image-size (assoc-ref opts 'image-size)
                              #:full-boot? (assoc-ref opts 'full-boot?)
+                             #:container-shared-network? (assoc-ref
+                                                          opts
+                                                          'container-shared-network?)
                              #:mappings (filter-map (match-lambda
                                                       (('file-system-mapping . m)
                                                        m)
-- 
2.14.1

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Christopher Baines]

This is a port of the functionality in the Guix environment command to the
guix system container command.

This requires additional changes to the operating-system definitions used, in
particular, networking related services may need removing if the host network
is shared.

* guix/scripts/system.scm (system-derivation-for-action): Add
  #:container-shared-network? argument.
  (perform-action): Add #:container-shared-network? argument.
  (show-help): Add "-N, --network" help information.
  (%options): Add network option.
  (process-action): Call perform-action with #:container-shared-network?.
* gnu/system/linux-container.scm (%network-configuration-files): New variable.
  (container-script): Add support for returning a container script that shares
  the host network.
* gnu/system.scm (essential-services): Add #:container-shared-network?
  argument.
  (operating-system-services): Add #:container-shared-network? argument.
  (operating-system-etc-service): Add #:container-shared-network? argument,
  and support for ommiting some configuration if the network is shared.
  (operating-system-activation-script): Add #:container-shared-network?
  argument, and pass this through to the operating-system-services procedure.
  (operating-system-boot-script): Add #:container-shared-network? argument,
  and pass this through to the operating-system-services procedure.
  (operating-system-derivation): Add the #:container-shared-network? argument,
  and pass this through to the operating-system-services procedure.
  (operating-system-profile): Add the #:container-shared-network? argument,
  and pass this through to the operating-system-services procedure.
---
 gnu/system.scm                 | 63 +++++++++++++++++++++++++++++-------------
 gnu/system/linux-container.scm | 47 +++++++++++++++++++++++++++----
 guix/scripts/system.scm        | 18 ++++++++++--
 3 files changed, 101 insertions(+), 27 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 6b35e3c0c..d6c7331e6 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -415,7 +415,7 @@ value of the SYSTEM-SERVICE-TYPE service."
                       ("initrd" ,initrd)
                       ("locale" ,locale))))))))   ;used by libc
 
-(define* (essential-services os #:key container?)
+(define* (essential-services os #:key container? container-shared-network?)
   "Return the list of essential services for OS.  These are special services
 that implement part of what's declared in OS are responsible for low-level
 bookkeeping.  CONTAINER? determines whether to return the list of services for
@@ -423,6 +423,9 @@ a container or that of a \"bare metal\" system."
   (define known-fs
     (map file-system-mount-point (operating-system-file-systems os)))
 
+  (if (and container-shared-network? (not container?))
+      (error "cannot specify container-shared-network? without container? #t"))
+
   (let* ((mappings  (device-mapping-services os))
          (root-fs   (root-file-system-service))
          (other-fs  (non-boot-file-system-service os))
@@ -447,7 +450,8 @@ a container or that of a \"bare metal\" system."
            (account-service (append (operating-system-accounts os)
                                     (operating-system-groups os))
                             (operating-system-skeletons os))
-           (operating-system-etc-service os)
+           (operating-system-etc-service
+            os #:container-shared-network? container-shared-network?)
            (service fstab-service-type '())
            (session-environment-service
             (operating-system-environment-variables os))
@@ -467,11 +471,14 @@ a container or that of a \"bare metal\" system."
                              (service firmware-service-type
                                       (operating-system-firmware os))))))))
 
-(define* (operating-system-services os #:key container?)
+(define* (operating-system-services os #:key container? container-shared-network?)
   "Return all the services of OS, including \"internal\" services that do not
 explicitly appear in OS."
   (append (operating-system-user-services os)
-          (essential-services os #:container? container?)))
+          (essential-services
+           os
+           #:container? container?
+           #:container-shared-network? container-shared-network?)))
 
 \f
 ;;;
@@ -540,7 +547,7 @@ This is the GNU system.  Welcome.\n")
   "Return the default /etc/hosts file."
   (plain-file "hosts" (local-host-aliases host-name)))
 
-(define* (operating-system-etc-service os)
+(define* (operating-system-etc-service os #:key container-shared-network?)
   "Return a <service> that builds containing the static part of the /etc
 directory."
   (let ((login.defs (plain-file "login.defs" "# Empty for now.\n"))
@@ -619,19 +626,22 @@ then
   source /run/current-system/profile/etc/profile.d/bash_completion.sh
 fi\n")))
     (etc-service
-     `(("services" ,(file-append net-base "/etc/services"))
-       ("protocols" ,(file-append net-base "/etc/protocols"))
+     `(("protocols" ,(file-append net-base "/etc/protocols"))
        ("rpc" ,(file-append net-base "/etc/rpc"))
        ("login.defs" ,#~#$login.defs)
        ("issue" ,#~#$issue)
-       ("nsswitch.conf" ,#~#$nsswitch)
        ("profile" ,#~#$profile)
        ("bashrc" ,#~#$bashrc)
-       ("hosts" ,#~#$(or (operating-system-hosts-file os)
-                         (default-/etc/hosts (operating-system-host-name os))))
        ("localtime" ,(file-append tzdata "/share/zoneinfo/"
                                   (operating-system-timezone os)))
-       ("sudoers" ,(operating-system-sudoers-file os))))))
+       ("sudoers" ,(operating-system-sudoers-file os))
+       ,@(if container-shared-network?
+             '()
+             `(("services" ,(file-append net-base "/etc/services"))
+               ("nsswitch.conf" ,#~#$nsswitch)
+               ("hosts" ,#~#$(or (operating-system-hosts-file os)
+                                 (default-/etc/hosts
+                                   (operating-system-host-name os))))))))))
 
 (define %root-account
   ;; Default root account.
@@ -739,20 +749,28 @@ use 'plain-file' instead~%")
 root ALL=(ALL) ALL
 %wheel ALL=(ALL) ALL\n"))
 
-(define* (operating-system-activation-script os #:key container?)
+(define* (operating-system-activation-script os #:key container?
+                                             container-shared-network?)
   "Return the activation script for OS---i.e., the code that \"activates\" the
 stateful part of OS, including user accounts and groups, special directories,
 etc."
-  (let* ((services   (operating-system-services os #:container? container?))
+  (let* ((services   (operating-system-services
+                      os
+                      #:container? container?
+                      #:container-shared-network? container-shared-network?))
          (activation (fold-services services
                                     #:target-type activation-service-type)))
     (activation-service->script activation)))
 
-(define* (operating-system-boot-script os #:key container?)
+(define* (operating-system-boot-script os #:key container?
+                                       container-shared-network?)
   "Return the boot script for OS---i.e., the code started by the initrd once
 we're running in the final root.  When CONTAINER? is true, skip all
 hardware-related operations as necessary when booting a Linux container."
-  (let* ((services (operating-system-services os #:container? container?))
+  (let* ((services (operating-system-services
+                    os
+                    #:container? container?
+                    #:container-shared-network? container-shared-network?))
          (boot     (fold-services services #:target-type boot-service-type)))
     ;; BOOT is the script as a monadic value.
     (service-value boot)))
@@ -773,17 +791,24 @@ hardware-related operations as necessary when booting a Linux container."
                               #:target-type
                               shepherd-root-service-type))))
 
-(define* (operating-system-derivation os #:key container?)
+(define* (operating-system-derivation os #:key container?
+                                      container-shared-network?)
   "Return a derivation that builds OS."
-  (let* ((services (operating-system-services os #:container? container?))
+  (let* ((services (operating-system-services
+                    os
+                    #:container? container?
+                    #:container-shared-network? container-shared-network?))
          (system   (fold-services services)))
     ;; SYSTEM contains the derivation as a monadic value.
     (service-value system)))
 
-(define* (operating-system-profile os #:key container?)
+(define* (operating-system-profile os #:key container? container-shared-network?)
   "Return a derivation that builds the system profile of OS."
   (mlet* %store-monad
-      ((services -> (operating-system-services os #:container? container?))
+      ((services -> (operating-system-services
+                     os
+                     #:container? container?
+                     #:container-shared-network? container-shared-network?))
        (profile (fold-services services
                                #:target-type profile-service-type)))
     (match profile
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index bceea4133..538b1f19c 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -60,18 +60,50 @@ containerized OS."
                           %container-file-systems
                           user-file-systems))))
 
-(define* (container-script os #:key (mappings '()))
+
+(define %network-configuration-files
+  '("/etc/resolv.conf"
+    "/etc/nsswitch.conf"
+    "/etc/services"
+    "/etc/hosts"))
+
+(define* (container-script os #:key (mappings '())
+                           container-shared-network?)
   "Return a derivation of a script that runs OS as a Linux container.
 MAPPINGS is a list of <file-system> objects that specify the files/directories
 that will be shared with the host system."
-  (let* ((os           (containerized-operating-system os mappings))
+  (let* ((os           (containerized-operating-system
+                        os
+                        (append
+                         mappings
+                         (if
+                          container-shared-network?
+                          (filter-map (lambda (file)
+                                        (and (file-exists? file)
+                                             (file-system-mapping
+                                              (source file)
+                                              (target file)
+                                              ;; XXX: On some GNU/Linux
+                                              ;; systems, /etc/resolv.conf is a
+                                              ;; symlink to a file in a tmpfs
+                                              ;; which, for an unknown reason,
+                                              ;; cannot be bind mounted
+                                              ;; read-only within the
+                                              ;; container.
+                                              (writable?
+                                               (string=?
+                                                file "/etc/resolv.conf")))))
+                                      %network-configuration-files)
+                          '()))))
          (file-systems (filter file-system-needed-for-boot?
                                (operating-system-file-systems os)))
          (specs        (map file-system->spec file-systems)))
 
-    (mlet* %store-monad ((os-drv (operating-system-derivation
-                                  os
-                                  #:container? #t)))
+    (mlet* %store-monad ((os-drv
+                          (operating-system-derivation
+                           os
+                           #:container? #t
+                           #:container-shared-network? container-shared-network?)))
 
       (define script
         (with-imported-modules (source-module-closure
@@ -93,6 +125,9 @@ that will be shared with the host system."
                 ;; 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))))
+                #:host-uids 65536
+                #:namespaces (if #$container-shared-network?
+                                 (delq 'net %namespaces)
+                                 %namespaces)))))
 
       (gexp->script "run-container" script))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 773779318..2a3c721eb 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -558,13 +558,15 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
 
 (define* (system-derivation-for-action os action
                                        #:key image-size file-system-type
-                                       full-boot? mappings)
+                                       full-boot? mappings
+                                       container-shared-network?)
   "Return as a monadic value the derivation for OS according to ACTION."
   (case action
     ((build init reconfigure)
      (operating-system-derivation os))
     ((container)
-     (container-script os #:mappings mappings))
+     (container-script os #:mappings mappings
+                       #:container-shared-network? container-shared-network?))
     ((vm-image)
      (system-qemu-image os #:disk-image-size image-size))
     ((vm)
@@ -614,6 +616,7 @@ and TARGET arguments."
                          dry-run? derivations-only?
                          use-substitutes? bootloader-target target
                          image-size file-system-type full-boot?
+                         container-shared-network?
                          (mappings '())
                          (gc-root #f))
   "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
@@ -622,6 +625,8 @@ target root directory; IMAGE-SIZE is the size of the image to be built, for
 the 'vm-image' and 'disk-image' actions.  The root filesystem is created as a
 FILE-SYSTEM-TYPE filesystem.  FULL-BOOT? is used for the 'vm' action; it
 determines whether to boot directly to the kernel or to the bootloader.
+CONTAINER-SHARED_NETWORK? determines if the container will use a use a
+separate network namespace.
 
 When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
 building anything.
@@ -639,6 +644,7 @@ output when building a system derivation, such as a disk image."
                                                 #:file-system-type file-system-type
                                                 #:image-size image-size
                                                 #:full-boot? full-boot?
+                                                #:container-shared-network? container-shared-network?
                                                 #:mappings mappings))
        (bootloader -> (bootloader-configuration-bootloader
                        (operating-system-bootloader os)))
@@ -789,6 +795,8 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --share=SPEC       for 'vm', share host file system according to SPEC"))
   (display (G_ "
+  -N, --network          for 'container', allow containers to access the network"))
+  (display (G_ "
   -r, --root=FILE        for 'vm', 'vm-image', 'disk-image', 'container',
                          and 'build', make FILE a symlink to the result, and
                          register it as a garbage collector root"))
@@ -828,6 +836,9 @@ Some ACTIONS support additional ARGS.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'image-size (size->number arg)
                                result)))
+         (option '(#\N "network") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'container-shared-network? #t result)))
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
@@ -922,6 +933,9 @@ resulting from command-line parsing."
                              #:file-system-type (assoc-ref opts 'file-system-type)
                              #:image-size (assoc-ref opts 'image-size)
                              #:full-boot? (assoc-ref opts 'full-boot?)
+                             #:container-shared-network? (assoc-ref
+                                                          opts
+                                                          'container-shared-network?)
                              #:mappings (filter-map (match-lambda
                                                       (('file-system-mapping . m)
                                                        m)
-- 
2.14.1

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Ludovic Courtès]

Hi!

Sorry for the delay!

Christopher Baines <mail@cbaines.net> skribis:

> This is a port of the functionality in the Guix environment command to the
> guix system container command.
>
> This requires additional changes to the operating-system definitions used, in
> particular, networking related services may need removing if the host network
> is shared.
>
> * guix/scripts/system.scm (system-derivation-for-action): Add
>   #:container-shared-network? argument.
>   (perform-action): Add #:container-shared-network? argument.
>   (show-help): Add "-N, --network" help information.
>   (%options): Add network option.
>   (process-action): Call perform-action with #:container-shared-network?.
> * gnu/system/linux-container.scm (%network-configuration-files): New variable.
>   (container-script): Add support for returning a container script that shares
>   the host network.
> * gnu/system.scm (essential-services): Add #:container-shared-network?
>   argument.
>   (operating-system-services): Add #:container-shared-network? argument.
>   (operating-system-etc-service): Add #:container-shared-network? argument,
>   and support for ommiting some configuration if the network is shared.
>   (operating-system-activation-script): Add #:container-shared-network?
>   argument, and pass this through to the operating-system-services procedure.
>   (operating-system-boot-script): Add #:container-shared-network? argument,
>   and pass this through to the operating-system-services procedure.
>   (operating-system-derivation): Add the #:container-shared-network? argument,
>   and pass this through to the operating-system-services procedure.
>   (operating-system-profile): Add the #:container-shared-network? argument,
>   and pass this through to the operating-system-services procedure.

My gut reaction was “hey this is cool!”, and then “wait, it doesn’t feel
right to pass that argument around everywhere!”.   :-)

We already have that with #:container?, and I think that’s a bit of a
problem.  The ‘linux-bare-metal’ service addresses it somewhat in a more
elegant way, I think.

What about this:

  1. Remove from ‘operating-system-etc-service’ all the
     shared-network-related files;

  2. Add a ‘shared-network-service’ that simply adds those file to /etc;

  3. Add a ‘containerized-operating-system’ that removes it.

There’s the problem, though, that /etc/hosts can only be added from
‘essential-services’.

Now, this:

+(define %network-configuration-files
+  '("/etc/resolv.conf"
+    "/etc/nsswitch.conf"
+    "/etc/services"
+    "/etc/hosts"))

… is exactly what (gnu system file-systems) defines.

Also, we should map the host’s /var/run/nscd/socket (if it exists) in
the guest, and remove nscd from the guest.

Thoughts?

Ludo’.

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Christopher Baines]

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

On Tue, 19 Sep 2017 23:39:34 +0200
ludo@gnu.org (Ludovic Courtès) wrote:

> Hi!
> 
> Sorry for the delay!
> 
> Christopher Baines <mail@cbaines.net> skribis:
> 
> > This is a port of the functionality in the Guix environment command
> > to the guix system container command.
> >
> > This requires additional changes to the operating-system
> > definitions used, in particular, networking related services may
> > need removing if the host network is shared.
> >
> > * guix/scripts/system.scm (system-derivation-for-action): Add
> >   #:container-shared-network? argument.
> >   (perform-action): Add #:container-shared-network? argument.
> >   (show-help): Add "-N, --network" help information.
> >   (%options): Add network option.
> >   (process-action): Call perform-action with
> > #:container-shared-network?.
> > * gnu/system/linux-container.scm (%network-configuration-files):
> > New variable. (container-script): Add support for returning a
> > container script that shares the host network.
> > * gnu/system.scm (essential-services): Add
> > #:container-shared-network? argument.
> >   (operating-system-services): Add #:container-shared-network?
> > argument. (operating-system-etc-service): Add
> > #:container-shared-network? argument, and support for ommiting some
> > configuration if the network is shared.
> > (operating-system-activation-script): Add
> > #:container-shared-network? argument, and pass this through to the
> > operating-system-services procedure.
> > (operating-system-boot-script): Add #:container-shared-network?
> > argument, and pass this through to the operating-system-services
> > procedure. (operating-system-derivation): Add the
> > #:container-shared-network? argument, and pass this through to the
> > operating-system-services procedure. (operating-system-profile):
> > Add the #:container-shared-network? argument, and pass this through
> > to the operating-system-services procedure.  
> 
> My gut reaction was “hey this is cool!”, and then “wait, it doesn’t
> feel right to pass that argument around everywhere!”.   :-)

Yep, agreed :)

> We already have that with #:container?, and I think that’s a bit of a
> problem.  The ‘linux-bare-metal’ service addresses it somewhat in a
> more elegant way, I think.
> 
> What about this:
> 
>   1. Remove from ‘operating-system-etc-service’ all the
>      shared-network-related files;
> 
>   2. Add a ‘shared-network-service’ that simply adds those file
> to /etc;
> 
>   3. Add a ‘containerized-operating-system’ that removes it.
> 
> There’s the problem, though, that /etc/hosts can only be added from
> ‘essential-services’.
> 
> Now, this:
> 
> +(define %network-configuration-files
> +  '("/etc/resolv.conf"
> +    "/etc/nsswitch.conf"
> +    "/etc/services"
> +    "/etc/hosts"))
> 
> … is exactly what (gnu system file-systems) defines.
> 
> Also, we should map the host’s /var/run/nscd/socket (if it exists) in
> the guest, and remove nscd from the guest.
> 
> Thoughts?

This sounds really good, I'll try and make some time to implement it :)

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 963 bytes --]

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Arun Isaac]

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


I need this feature and I'd like to see this patch completed. And, I'm
willing to adopt it if Christopher Baines is unable to find time for
it. May I?

> “wait, it doesn’t feel right to pass that argument around
> everywhere!”.  :-)
> 
> We already have that with #:container?, and I think that’s a bit of a
> problem.

Yes, it doesn't feel right to pass the #:container? and
#:container-shared-network? argument around everywhere. We should do
something more elegant.

> The ‘linux-bare-metal’ service addresses it somewhat in a
> more elegant way, I think.
> 
> What about this:
> 
>   1. Remove from ‘operating-system-etc-service’ all the
>   shared-network-related files;
> 
>   2. Add a ‘shared-network-service’ that simply adds those file to
>   /etc;
> 
>   3. Add a ‘containerized-operating-system’ that removes it.
> 
> There’s the problem, though, that /etc/hosts can only be added from
> ‘essential-services’.

I tried the above, but since /etc/hosts can only be added from
essential-services, we still have to pass around the
#:container-shared-network? argument a lot.

What if, instead of a flag to `guix system', we introduced two fields --
container? and container-shared-network? -- in the <operating-system>
record type? This way, all the information would be bundled into the
`os' argument of essential-services and other functions. We wouldn't
need additional keyword arguments like #:container? and
#:container-shared-network?. In the interest of backward compatibility
and convenience, we could also retain the existing flags to the `guix
system' script. When the script sees the flag, it could modify the
operating-system record accordingly before passing it on for further
processing.

Thoughts?

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Christopher Baines]

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


Arun Isaac <arunisaac@systemreboot.net> writes:

> I need this feature and I'd like to see this patch completed. And, I'm
> willing to adopt it if Christopher Baines is unable to find time for
> it. May I?

I still use this, but as you can see, unfortunately I haven't made time
to look more at how better implement it. I'd be very happy for you or
anyone else to take a look at it.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Ricardo Wurmus]

Arun Isaac <arunisaac@systemreboot.net> writes:

> What if, instead of a flag to `guix system', we introduced two fields --
> container? and container-shared-network? -- in the <operating-system>
> record type?

I’d rather not do this.  Is this really a property of the operating
system definition?  Making it part of <operating-system> would make it
difficult to use the same definition for containers, virtual machines,
or bare-metal instantiations.

-- 
Ricardo

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Arun Isaac]

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


> I’d rather not do this.  Is this really a property of the operating
> system definition?  Making it part of <operating-system> would make it
> difficult to use the same definition for containers, virtual machines,
> or bare-metal instantiations.

You're right. #:container? and #:container-shared-network? are not
properties of the operating system definition. Please disregard my
proposal. Any other ideas for possible implementation of this feature?
It seems to me like Christopher Baines' original implementation is the
only way to do it.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Ludovic Courtès]

Hello Arun,

Arun Isaac <arunisaac@systemreboot.net> skribis:

> I need this feature and I'd like to see this patch completed. And, I'm
> willing to adopt it if Christopher Baines is unable to find time for
> it. May I?

Thanks for picking it up, and sorry for the delay!

>> What about this:
>> 
>>   1. Remove from ‘operating-system-etc-service’ all the
>>   shared-network-related files;
>> 
>>   2. Add a ‘shared-network-service’ that simply adds those file to
>>   /etc;
>> 
>>   3. Add a ‘containerized-operating-system’ that removes it.
>> 
>> There’s the problem, though, that /etc/hosts can only be added from
>> ‘essential-services’.
>
> I tried the above, but since /etc/hosts can only be added from
> essential-services, we still have to pass around the
> #:container-shared-network? argument a lot.

What about solving the /etc/hosts issue like this:

  a. Add in (gnu services) an ‘hosts-database-service-type’ that would
     take could be extended with IP/name pairs that it would put in
     /etc/hosts.

  b. Have ‘essential-services’ extend ‘hosts-database-service-type’.

In the container-with-shared-network case we’d arrange to not extend
‘hosts-database-service-type’, which would thus not produce /etc/hosts.

Does that make sense?

HTH,
Ludo’.

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Arun Isaac]

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


>   a. Add in (gnu services) an ‘hosts-database-service-type’ that would
>      take could be extended with IP/name pairs that it would put in
>      /etc/hosts.
>
>   b. Have ‘essential-services’ extend ‘hosts-database-service-type’.
>
> In the container-with-shared-network case we’d arrange to not extend
> ‘hosts-database-service-type’, which would thus not produce /etc/hosts.

How would we arrange to not extend `hosts-database-service-type' in the
container-with-shared-network case? Wouldn't such an arrangement still
require us to pass #:container-shared-network? to `essential-services'?

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Ludovic Courtès]

Hi Arun,

Arun Isaac <arunisaac@systemreboot.net> skribis:

>>   a. Add in (gnu services) an ‘hosts-database-service-type’ that would
>>      take could be extended with IP/name pairs that it would put in
>>      /etc/hosts.
>>
>>   b. Have ‘essential-services’ extend ‘hosts-database-service-type’.
>>
>> In the container-with-shared-network case we’d arrange to not extend
>> ‘hosts-database-service-type’, which would thus not produce /etc/hosts.
>
> How would we arrange to not extend `hosts-database-service-type' in the
> container-with-shared-network case? Wouldn't such an arrangement still
> require us to pass #:container-shared-network? to `essential-services'?

Oh, hmm, good point.

Perhaps ‘essential-services’ could check whether
‘hosts-database-service-type’ is part of the
‘operating-system-user-services’.

If it is, it would extend it; if not, it would do nothing.

‘hosts-database-service-type’ would be part of ‘%base-services’, but
in the container-with-shared-network case, we’d remove it (in a
procedure similar to ‘virtualized-operating-system’.)

How does that sound?

Thanks,
Ludo’.

[bug#28128] [PATCH] scripts: system: Add support for container network sharing.

[Arun Isaac]

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


> Perhaps ‘essential-services’ could check whether
> ‘hosts-database-service-type’ is part of the
> ‘operating-system-user-services’.
>
> If it is, it would extend it; if not, it would do nothing.
>
> ‘hosts-database-service-type’ would be part of ‘%base-services’, but
> in the container-with-shared-network case, we’d remove it (in a
> procedure similar to ‘virtualized-operating-system’.)
>
> How does that sound?

This sounds workable. I'll send you an implementation soon.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH 0/2] Support container network sharing

[Arun Isaac]

Here is an implementation as promised. One small difference from what you
suggested is that instead of creating a `hosts-database-service-type' that is
extended by `essential-services', I created a `shared-network-service-type'
that is extended by `essential-services'. This way, the population of all the
shared-network related files are grouped under a single service. Let me know
if this is satisfactory.

Thanks!

Arun Isaac (2):
  shepherd: Move nscd-socket to (gnu system file-systems).
  scripts: system: Support container network sharing.

 gnu/build/shepherd.scm         |  8 ++------
 gnu/services.scm               |  9 +++++++++
 gnu/services/base.scm          |  4 +++-
 gnu/system.scm                 | 27 +++++++++++++++++----------
 gnu/system/file-systems.scm    | 10 +++++++++-
 gnu/system/linux-container.scm | 26 +++++++++++++++++++++++---
 guix/scripts/system.scm        | 30 +++++++++++++++++++++++-------
 7 files changed, 86 insertions(+), 28 deletions(-)

-- 
2.20.1

[bug#28128] [PATCH 1/2] shepherd: Move nscd-socket to (gnu system file-systems).

[Arun Isaac]

* gnu/build/shepherd.scm (default-mounts)[nscd-socket]: Move to ...
* gnu/system/file-systems.scm (%nscd-socket-mapping): ... here.
---
 gnu/build/shepherd.scm      |  8 ++------
 gnu/system/file-systems.scm | 10 +++++++++-
 2 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/gnu/build/shepherd.scm b/gnu/build/shepherd.scm
index f383259924..b3fc1f9c72 100644
--- a/gnu/build/shepherd.scm
+++ b/gnu/build/shepherd.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -67,15 +68,10 @@
           (file-system-mapping
            (source "/etc/group") (target source))))
 
-  (define nscd-socket
-    (file-system-mapping
-     (source "/var/run/nscd") (target source)
-     (writable? #t)))
-
   (append (cons (tmpfs "/tmp") %container-file-systems)
           (let ((mappings `(,@(if (memq 'net namespaces)
                                   '()
-                                  (cons nscd-socket
+                                  (cons %nscd-socket-mapping
                                         %network-file-mappings))
                             ,@(if (and (memq 'mnt namespaces)
                                        (not (memq 'user namespaces)))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 393dd0df70..4cf4f6608b 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -76,7 +77,8 @@
 
             %store-mapping
             %network-configuration-files
-            %network-file-mappings))
+            %network-file-mappings
+            %nscd-socket-mapping))
 
 ;;; Commentary:
 ;;;
@@ -510,6 +512,12 @@ a bind mount."
                  (writable? (string=? file "/etc/resolv.conf"))))
               %network-configuration-files))
 
+(define %nscd-socket-mapping
+  (file-system-mapping
+   (source "/var/run/nscd")
+   (target source)
+   (writable? #t)))
+
 (define (file-system-type-predicate type)
   "Return a predicate that, when passed a file system, returns #t if that file
 system has the given TYPE."
-- 
2.20.1

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Arun Isaac]

* gnu/services.scm (shared-network-service-type): New variable.
* gnu/services/base.scm (%base-services): Add shared-network-service.
* gnu/system.scm (essential-services): If shared-network-service exists,
extend it to add /etc/services, /etc/nsswitch.conf and /etc/hosts.
(operating-system-etc-service): Do not add /etc/services, /etc/nsswitch.conf
and /etc/hosts.
* gnu/system/linux-container.scm (container-script): Support returning a
container script that shares the host network.
* guix/scripts/system.scm (system-derivation-for-action, perform-action): Add
#:container-shared-network? argument.
(show-help): Add "-N, --network" help information.
(%options): Add network option.
(process-action): Call perform-action with #:container-shared-network?.

Co-authored-by: Christopher Baines <mail@cbaines.net>
---
 gnu/services.scm               |  9 +++++++++
 gnu/services/base.scm          |  4 +++-
 gnu/system.scm                 | 27 +++++++++++++++++----------
 gnu/system/linux-container.scm | 26 +++++++++++++++++++++++---
 guix/scripts/system.scm        | 30 +++++++++++++++++++++++-------
 5 files changed, 75 insertions(+), 21 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index f151bbaa9d..316b22eabb 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -95,6 +96,7 @@
             profile-service-type
             firmware-service-type
             gc-root-service-type
+            shared-network-service-type
 
             %boot-service
             %activation-service
@@ -651,6 +653,13 @@ as Wifi cards.")))
                  "Register garbage-collector roots---i.e., store items that
 will not be reclaimed by the garbage collector.")))
 
+(define shared-network-service-type
+  (service-type (name 'shared-network)
+                (extensions (list (service-extension etc-service-type identity)))
+                (compose concatenate)
+                (extend append)
+                (default-value '())))
+
 \f
 ;;;
 ;;; Service folding.
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 67df4d1379..5f806fab35 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -2373,6 +2373,8 @@ to handle."
 
         (service special-files-service-type
                  `(("/bin/sh" ,(file-append (canonical-package bash)
-                                            "/bin/sh"))))))
+                                            "/bin/sh"))))
+
+        (service shared-network-service-type)))
 
 ;;; base.scm ends here
diff --git a/gnu/system.scm b/gnu/system.scm
index e6c86cb9ba..22f7e5d55d 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -501,7 +502,21 @@ a container or that of a \"bare metal\" system."
                        (list %containerized-shepherd-service)
                        (list %linux-bare-metal-service
                              (service firmware-service-type
-                                      (operating-system-firmware os))))))))
+                                      (operating-system-firmware os))))
+                   (if (find (lambda (service)
+                               (eq? (service-type-name (service-kind service))
+                                    'shared-network))
+                             (operating-system-user-services os))
+                       (let ((nsswitch (plain-file "nsswitch.conf"
+                                                   (name-service-switch->string
+                                                    (operating-system-name-service-switch os)))))
+                         (list (simple-service 'shared-network-extension
+                                               shared-network-service-type
+                                               `(("services" ,(file-append net-base "/etc/services"))
+                                                 ("nsswitch.conf" ,#~#$nsswitch)
+                                                 ("hosts" ,#~#$(or (operating-system-hosts-file os)
+                                                                   (default-/etc/hosts (operating-system-host-name os))))))))
+                       (list))))))
 
 (define* (operating-system-services os #:key container?)
   "Return all the services of OS, including \"internal\" services that do not
@@ -592,10 +607,6 @@ directory."
                         "/run/current-system/profile/sbin\n")))
 
         (issue      (plain-file "issue" (operating-system-issue os)))
-        (nsswitch   (plain-file "nsswitch.conf"
-                                (name-service-switch->string
-                                 (operating-system-name-service-switch os))))
-
         ;; Startup file for POSIX-compliant login shells, which set system-wide
         ;; environment variables.
         (profile    (mixed-text-file "profile"  "\
@@ -679,16 +690,12 @@ then
   source /run/current-system/profile/etc/profile.d/bash_completion.sh
 fi\n")))
     (etc-service
-     `(("services" ,(file-append net-base "/etc/services"))
-       ("protocols" ,(file-append net-base "/etc/protocols"))
+     `(("protocols" ,(file-append net-base "/etc/protocols"))
        ("rpc" ,(file-append net-base "/etc/rpc"))
        ("login.defs" ,#~#$login.defs)
        ("issue" ,#~#$issue)
-       ("nsswitch.conf" ,#~#$nsswitch)
        ("profile" ,#~#$profile)
        ("bashrc" ,#~#$bashrc)
-       ("hosts" ,#~#$(or (operating-system-hosts-file os)
-                         (default-/etc/hosts (operating-system-host-name os))))
        ;; Write the operating-system-host-name to /etc/hostname to prevent
        ;; NetworkManager from changing the system's hostname when connecting
        ;; to certain networks.  Some discussion at
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index bceea41332..485623f563 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -1,6 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -60,11 +62,26 @@ containerized OS."
                           %container-file-systems
                           user-file-systems))))
 
-(define* (container-script os #:key (mappings '()))
+(define* (container-script os #:key (mappings '()) container-shared-network?)
   "Return a derivation of a script that runs OS as a Linux container.
 MAPPINGS is a list of <file-system> objects that specify the files/directories
 that will be shared with the host system."
-  (let* ((os           (containerized-operating-system os mappings))
+  (let* ((os (containerized-operating-system
+              (operating-system
+                (inherit os)
+                (services (if container-shared-network?
+                              (remove (lambda (service)
+                                        (case (service-type-name (service-kind service))
+                                          ((nscd shared-network) #t)
+                                          (else #f)))
+                                      (operating-system-user-services os))
+                              (operating-system-user-services os))))
+              (append
+               mappings
+               (if container-shared-network?
+                   (cons %nscd-socket-mapping
+                         %network-file-mappings)
+                   '()))))
          (file-systems (filter file-system-needed-for-boot?
                                (operating-system-file-systems os)))
          (specs        (map file-system->spec file-systems)))
@@ -93,6 +110,9 @@ that will be shared with the host system."
                 ;; 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))))
+                #:host-uids 65536
+                #:namespaces (if #$container-shared-network?
+                                 (delq 'net %namespaces)
+                                 %namespaces)))))
 
       (gexp->script "run-container" script))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index d67b9f8185..c2fb1ebed5 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -756,13 +757,16 @@ checking this by themselves in their 'check' procedure."
 
 (define* (system-derivation-for-action os action
                                        #:key image-size file-system-type
-                                       full-boot? mappings)
+                                       full-boot? mappings
+                                       container-shared-network?)
   "Return as a monadic value the derivation for OS according to ACTION."
   (case action
     ((build init reconfigure)
      (operating-system-derivation os))
     ((container)
-     (container-script os #:mappings mappings))
+     (container-script os
+                       #:mappings mappings
+                       #:container-shared-network? container-shared-network?))
     ((vm-image)
      (system-qemu-image os #:disk-image-size image-size))
     ((vm)
@@ -817,6 +821,7 @@ and TARGET arguments."
                          dry-run? derivations-only?
                          use-substitutes? bootloader-target target
                          image-size file-system-type full-boot?
+                         container-shared-network?
                          (mappings '())
                          (gc-root #f))
   "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
@@ -825,6 +830,8 @@ target root directory; IMAGE-SIZE is the size of the image to be built, for
 the 'vm-image' and 'disk-image' actions.  The root file system is created as a
 FILE-SYSTEM-TYPE file system.  FULL-BOOT? is used for the 'vm' action; it
 determines whether to boot directly to the kernel or to the bootloader.
+CONTAINER-SHARED-NETWORK? determines if the container will use a separate
+network namespace.
 
 When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
 building anything.
@@ -870,11 +877,13 @@ static checks."
       (check-initrd-modules os)))
 
   (mlet* %store-monad
-      ((sys       (system-derivation-for-action os action
-                                                #:file-system-type file-system-type
-                                                #:image-size image-size
-                                                #:full-boot? full-boot?
-                                                #:mappings mappings))
+      ((sys       (system-derivation-for-action
+                   os action
+                   #:file-system-type file-system-type
+                   #:image-size image-size
+                   #:full-boot? full-boot?
+                   #:container-shared-network? container-shared-network?
+                   #:mappings mappings))
 
        ;; For 'init' and 'reconfigure', always build BOOTCFG, even if
        ;; --no-bootloader is passed, because we then use it as a GC root.
@@ -1011,6 +1020,8 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --share=SPEC       for 'vm', share host file system according to SPEC"))
   (display (G_ "
+  -N, --network          for 'container', allow containers to access the network"))
+  (display (G_ "
   -r, --root=FILE        for 'vm', 'vm-image', 'disk-image', 'container',
                          and 'build', make FILE a symlink to the result, and
                          register it as a garbage collector root"))
@@ -1057,6 +1068,9 @@ Some ACTIONS support additional ARGS.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'image-size (size->number arg)
                                result)))
+         (option '(#\N "network") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'container-shared-network? #t result)))
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
@@ -1173,6 +1187,8 @@ resulting from command-line parsing."
                              #:file-system-type (assoc-ref opts 'file-system-type)
                              #:image-size (assoc-ref opts 'image-size)
                              #:full-boot? (assoc-ref opts 'full-boot?)
+                             #:container-shared-network?
+                             (assoc-ref opts 'container-shared-network?)
                              #:mappings (filter-map (match-lambda
                                                       (('file-system-mapping . m)
                                                        m)
-- 
2.20.1

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Ludovic Courtès]

Hello!

Some comments below.

Arun Isaac <arunisaac@systemreboot.net> skribis:

> * gnu/services.scm (shared-network-service-type): New variable.
> * gnu/services/base.scm (%base-services): Add shared-network-service.
> * gnu/system.scm (essential-services): If shared-network-service exists,
> extend it to add /etc/services, /etc/nsswitch.conf and /etc/hosts.
> (operating-system-etc-service): Do not add /etc/services, /etc/nsswitch.conf
> and /etc/hosts.
> * gnu/system/linux-container.scm (container-script): Support returning a
> container script that shares the host network.
> * guix/scripts/system.scm (system-derivation-for-action, perform-action): Add
> #:container-shared-network? argument.
> (show-help): Add "-N, --network" help information.
> (%options): Add network option.
> (process-action): Call perform-action with #:container-shared-network?.
>
> Co-authored-by: Christopher Baines <mail@cbaines.net>

[...]

> +(define shared-network-service-type
> +  (service-type (name 'shared-network)
> +                (extensions (list (service-extension etc-service-type identity)))
> +                (compose concatenate)
> +                (extend append)
> +                (default-value '())))

I’d encourage you to add a ‘description’ field as well.  :-)

> --- a/gnu/system.scm
> +++ b/gnu/system.scm
> @@ -5,6 +5,7 @@
>  ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
>  ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
>  ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
> +;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -501,7 +502,21 @@ a container or that of a \"bare metal\" system."
>                         (list %containerized-shepherd-service)
>                         (list %linux-bare-metal-service
>                               (service firmware-service-type
> -                                      (operating-system-firmware os))))))))
> +                                      (operating-system-firmware os))))
> +                   (if (find (lambda (service)
> +                               (eq? (service-type-name (service-kind service))
> +                                    'shared-network))
> +                             (operating-system-user-services os))
> +                       (let ((nsswitch (plain-file "nsswitch.conf"
> +                                                   (name-service-switch->string
> +                                                    (operating-system-name-service-switch os)))))
> +                         (list (simple-service 'shared-network-extension
> +                                               shared-network-service-type
> +                                               `(("services" ,(file-append net-base "/etc/services"))
> +                                                 ("nsswitch.conf" ,#~#$nsswitch)
> +                                                 ("hosts" ,#~#$(or (operating-system-hosts-file os)
> +                                                                   (default-/etc/hosts (operating-system-host-name os))))))))
> +                       (list))))))

A couple of things:

  1. ‘service-type-name’ exists for debugging purposes, and I think we
     shouldn’t rely on it at all in our code.  Instead, we should
     compare service types by identity, as in:

       (eq? (service-kind service) foo-service-type)

  2. The notion of “shared network” is very much a container (or VM)
     thing, so somehow it still doesn’t feel right to me that (gnu
     system) has to be aware of these special cases.

I think the ‘host-database-service-type’ wouldn’t have this problem, but
maybe it has other issues.  I guess this needs more experimentation,
sorry for not coming up with clearer ideas!

Ludo’.

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Arun Isaac]

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


>> +(define shared-network-service-type
>> +  (service-type (name 'shared-network)
>> +                (extensions (list (service-extension etc-service-type identity)))
>> +                (compose concatenate)
>> +                (extend append)
>> +                (default-value '())))
>
> I’d encourage you to add a ‘description’ field as well.  :-)

Sure, will do.

>   1. ‘service-type-name’ exists for debugging purposes, and I think we
>      shouldn’t rely on it at all in our code.  Instead, we should
>      compare service types by identity, as in:
>
>        (eq? (service-kind service) foo-service-type)

Sure, will do.

>   2. The notion of “shared network” is very much a container (or VM)
>      thing, so somehow it still doesn’t feel right to me that (gnu
>      system) has to be aware of these special cases.
>
> I think the ‘host-database-service-type’ wouldn’t have this problem, but
> maybe it has other issues.  I guess this needs more experimentation,
> sorry for not coming up with clearer ideas!

If these services (the shared-network service, the hosts-database
service or indeed any other service) had access to the operating-system
object `os', then they would be able to operate independently without
having to be extended by `essential-services'. Is this possible somehow?
Is it a good idea to give services access to the os fields?

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Ludovic Courtès]

Hi,

Arun Isaac <arunisaac@systemreboot.net> skribis:

>>   2. The notion of “shared network” is very much a container (or VM)
>>      thing, so somehow it still doesn’t feel right to me that (gnu
>>      system) has to be aware of these special cases.
>>
>> I think the ‘host-database-service-type’ wouldn’t have this problem, but
>> maybe it has other issues.  I guess this needs more experimentation,
>> sorry for not coming up with clearer ideas!
>
> If these services (the shared-network service, the hosts-database
> service or indeed any other service) had access to the operating-system
> object `os', then they would be able to operate independently without
> having to be extended by `essential-services'. Is this possible somehow?
> Is it a good idea to give services access to the os fields?

It’s not easily possible, and I think it would be a bad idea: if every
service has access to every ‘operating-system’ field, that gives you
more flexibility, but it’s also much harder to reason about what
happens, compared to the current extension graph (the NixOS “module”
system works like that: every service can access every bit of the whole
configuration, but IMO that makes it quite hard to understand.)

What could be useful is “self-referential” records, where a field can
refer to the record it belongs do.  So we’d do:

  (define-record-type* <operating-system>
    ;; …
    (services operating-system-services
              (self-referential? #t) (default essential-services)))

whereby ‘essential-services’ would be passed the <operating-system>
record somehow.

That needs more thought…

Thanks,
Ludo’.

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Arun Isaac]

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


> It’s not easily possible, and I think it would be a bad idea: if every
> service has access to every ‘operating-system’ field, that gives you
> more flexibility, but it’s also much harder to reason about what
> happens, compared to the current extension graph (the NixOS “module”
> system works like that: every service can access every bit of the whole
> configuration, but IMO that makes it quite hard to understand.)

OK, I understand. Just out of curiosity: Why do we have special
operating-system fields like host-name, hosts-file, etc. instead of just
having services like host-name-service-type, hosts-file-service-type,
etc.? Doesn't giving special status to these operating-system fields
complicate things? For example, if we only had a hosts-file-service-type
instead of a hosts-file operating-system field, we wouldn't have the
problem that /etc/hosts could only be created from within
essential-services.

> What could be useful is “self-referential” records, where a field can
> refer to the record it belongs do.  So we’d do:
>
>   (define-record-type* <operating-system>
>     ;; …
>     (services operating-system-services
>               (self-referential? #t) (default essential-services)))
>
> whereby ‘essential-services’ would be passed the <operating-system>
> record somehow.
>
> That needs more thought…

OK, I'll wait.

Thanks!

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Ludovic Courtès]

Hi Arun & Chris,

Arun Isaac <arunisaac@systemreboot.net> skribis:

>> It’s not easily possible, and I think it would be a bad idea: if every
>> service has access to every ‘operating-system’ field, that gives you
>> more flexibility, but it’s also much harder to reason about what
>> happens, compared to the current extension graph (the NixOS “module”
>> system works like that: every service can access every bit of the whole
>> configuration, but IMO that makes it quite hard to understand.)
>
> OK, I understand. Just out of curiosity: Why do we have special
> operating-system fields like host-name, hosts-file, etc. instead of just
> having services like host-name-service-type, hosts-file-service-type,
> etc.? Doesn't giving special status to these operating-system fields
> complicate things? For example, if we only had a hosts-file-service-type
> instead of a hosts-file operating-system field, we wouldn't have the
> problem that /etc/hosts could only be created from within
> essential-services.

You’re right, to some extent those fields complicate things (most of
them were here before the service infrastructure, though.)  OTOH I find
it convenient to have a high-level view of the OS.

>> What could be useful is “self-referential” records, where a field can
>> refer to the record it belongs do.  So we’d do:
>>
>>   (define-record-type* <operating-system>
>>     ;; …
>>     (services operating-system-services
>>               (self-referential? #t) (default essential-services)))
>>
>> whereby ‘essential-services’ would be passed the <operating-system>
>> record somehow.
>>
>> That needs more thought…
>
> OK, I'll wait.

I didn’t mean to block you though because it was just an idea without
code…  but in the meantime I’ve sent code to
<https://issues.guix.info/issue/34948>.  It turned out to be easier than
I thought!

Ludo’.

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Arun Isaac]

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


> I didn’t mean to block you though because it was just an idea without
> code…  but in the meantime I’ve sent code to
> <https://issues.guix.info/issue/34948>.  It turned out to be easier than
> I thought!

It's not that you were blocking me. I was just at my wit's end about
what to do. :-P

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Arun Isaac]

[-- Attachment #1.1: Type: text/plain, Size: 114 bytes --]


I took too long, but here it is finally! Should I add any documentation
about this new -N option to the manual?


[-- Attachment #1.2: 0001-linux-container-Add-support-for-container-network-sh.patch --]
[-- Type: text/x-patch, Size: 11238 bytes --]

From d5f6fb996f591c44d94fe578a5c41a830ddcb077 Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Fri, 10 May 2019 16:56:16 +0530
Subject: [PATCH] linux-container: Add support for container network sharing.

* gnu/system/linux-container.scm (container-essential-services): If network is
to be shared with the host, remove network configuration files from etc
service.
(containerized-operating-system): If network is to be shared with the host,
remove nscd service and map host's /var/run/nscd if it exists.
(container-script): If network is to be shared with the host, do not create
network namespace.
* guix/scripts/system.scm (system-derivation-for-action): Add
(perform-action): Add #:container-shared-network? argument.
(show-help): Add "-N, --network" help information.
(%options): Add network option.
(process-action): Call perform-action with #container-shared-network? argument.

Co-authored-by: Christopher Baines <mail@cbaines.net>
---
 gnu/system/linux-container.scm | 63 ++++++++++++++++++++++++++++------
 guix/scripts/system.scm        | 20 +++++++++--
 2 files changed, 70 insertions(+), 13 deletions(-)

diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 149c3d08a3..da0fd040f9 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,7 +36,7 @@
             containerized-operating-system
             container-script))
 
-(define (container-essential-services os)
+(define* (container-essential-services os #:key shared-network?)
   "Return a list of essential services corresponding to OS, a
 non-containerized OS.  This procedure essentially strips essential services
 from OS that are needed on the bare metal and not in a container."
@@ -51,9 +52,20 @@ from OS that are needed on the bare metal and not in a container."
                  (let ((locale (operating-system-locale-directory os)))
                    (with-monad %store-monad
                      (return `(("locale" ,locale))))))
-        base))
+        ;; If network is to be shared with the host, remove network
+        ;; configuration files from etc-service.
+        (if shared-network?
+            (modify-services base
+              (etc-service-type
+               files => (remove
+                         (match-lambda
+                           ((filename _)
+                            (member filename
+                                    (map basename %network-configuration-files))))
+                         files)))
+            base)))
 
-(define (containerized-operating-system os mappings)
+(define* (containerized-operating-system os mappings #:key shared-network?)
   "Return an operating system based on OS for use in a Linux container
 environment.  MAPPINGS is a list of <file-system-mapping> to realize in the
 containerized OS."
@@ -76,27 +88,53 @@ containerized OS."
   (define useless-services
     ;; Services that make no sense in a container.  Those that attempt to
     ;; access /dev/tty[0-9] in particular cannot work in a container.
-    (list console-font-service-type
-          mingetty-service-type
-          agetty-service-type))
+    (append (list console-font-service-type
+                  mingetty-service-type
+                  agetty-service-type)
+            ;; Remove nscd service if network is shared with the host.
+            (if shared-network?
+                (list nscd-service-type)
+                (list))))
+
+  (define shared-network-file-mappings
+    ;; Files to map if network is to be shared with the host
+    (append %network-file-mappings
+            (let ((nscd-run-directory "/var/run/nscd"))
+              (if (file-exists? nscd-run-directory)
+                  (list (file-system-mapping
+                         (source nscd-run-directory)
+                         (target nscd-run-directory)))
+                  (list)))))
+
+  ;; (write shared-network-file-mappings)
+  ;; (newline)
 
   (operating-system
     (inherit os)
     (swap-devices '()) ; disable swap
-    (essential-services (container-essential-services os))
+    (essential-services (container-essential-services
+                         os #:shared-network? shared-network?))
     (services (remove (lambda (service)
                         (memq (service-kind service)
                               useless-services))
                       (operating-system-user-services os)))
-    (file-systems (append (map mapping->fs (cons %store-mapping mappings))
+    (file-systems (append (map mapping->fs
+                               (cons %store-mapping
+                                     (append mappings
+                                             (if shared-network?
+                                                 shared-network-file-mappings
+                                                 (list)))))
                           %container-file-systems
                           user-file-systems))))
 
-(define* (container-script os #:key (mappings '()))
+(define* (container-script os #:key (mappings '()) shared-network?)
   "Return a derivation of a script that runs OS as a Linux container.
 MAPPINGS is a list of <file-system> objects that specify the files/directories
 that will be shared with the host system."
-  (let* ((os           (containerized-operating-system os mappings))
+  (let* ((os           (containerized-operating-system
+                        os
+                        mappings
+                        #:shared-network? shared-network?))
          (file-systems (filter file-system-needed-for-boot?
                                (operating-system-file-systems os)))
          (specs        (map file-system->spec file-systems)))
@@ -121,6 +159,9 @@ that will be shared with the host system."
               ;; 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))))
+              #:host-uids 65536
+              #:namespaces (if #$shared-network?
+                               (delq 'net %namespaces)
+                               %namespaces)))))
 
     (gexp->script "run-container" script)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3c3d6cbd5f..cf4418f981 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -756,13 +757,17 @@ checking this by themselves in their 'check' procedure."
 
 (define* (system-derivation-for-action os action
                                        #:key image-size file-system-type
-                                       full-boot? mappings)
+                                       full-boot? container-shared-network?
+                                       mappings)
   "Return as a monadic value the derivation for OS according to ACTION."
   (case action
     ((build init reconfigure)
      (operating-system-derivation os))
     ((container)
-     (container-script os #:mappings mappings))
+     (container-script
+      os
+      #:mappings mappings
+      #:shared-network? container-shared-network?))
     ((vm-image)
      (system-qemu-image os #:disk-image-size image-size))
     ((vm)
@@ -826,6 +831,7 @@ and TARGET arguments."
                          dry-run? derivations-only?
                          use-substitutes? bootloader-target target
                          image-size file-system-type full-boot?
+                         container-shared-network?
                          (mappings '())
                          (gc-root #f))
   "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
@@ -834,6 +840,8 @@ target root directory; IMAGE-SIZE is the size of the image to be built, for
 the 'vm-image' and 'disk-image' actions.  The root file system is created as a
 FILE-SYSTEM-TYPE file system.  FULL-BOOT? is used for the 'vm' action; it
 determines whether to boot directly to the kernel or to the bootloader.
+CONTAINER-SHARED-NETWORK? determines if the container will use a separate
+network namespace.
 
 When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
 building anything.
@@ -883,6 +891,7 @@ static checks."
                                                 #:file-system-type file-system-type
                                                 #:image-size image-size
                                                 #:full-boot? full-boot?
+                                                #:container-shared-network? container-shared-network?
                                                 #:mappings mappings))
 
        ;; For 'init' and 'reconfigure', always build BOOTCFG, even if
@@ -1020,6 +1029,8 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --share=SPEC       for 'vm', share host file system according to SPEC"))
   (display (G_ "
+  -N, --network          for 'container', allow containers to access the network"))
+  (display (G_ "
   -r, --root=FILE        for 'vm', 'vm-image', 'disk-image', 'container',
                          and 'build', make FILE a symlink to the result, and
                          register it as a garbage collector root"))
@@ -1066,6 +1077,9 @@ Some ACTIONS support additional ARGS.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'image-size (size->number arg)
                                result)))
+         (option '(#\N "network") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'container-shared-network? #t result)))
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
@@ -1182,6 +1196,8 @@ resulting from command-line parsing."
                              #:file-system-type (assoc-ref opts 'file-system-type)
                              #:image-size (assoc-ref opts 'image-size)
                              #:full-boot? (assoc-ref opts 'full-boot?)
+                             #:container-shared-network?
+                             (assoc-ref opts 'container-shared-network?)
                              #:mappings (filter-map (match-lambda
                                                       (('file-system-mapping . m)
                                                        m)
-- 
2.21.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Ludovic Courtès]

Hi Arun!

Arun Isaac <arunisaac@systemreboot.net> skribis:

> I took too long, but here it is finally! Should I add any documentation
> about this new -N option to the manual?

Yes, please.

> From d5f6fb996f591c44d94fe578a5c41a830ddcb077 Mon Sep 17 00:00:00 2001
> From: Arun Isaac <arunisaac@systemreboot.net>
> Date: Fri, 10 May 2019 16:56:16 +0530
> Subject: [PATCH] linux-container: Add support for container network sharing.
>
> * gnu/system/linux-container.scm (container-essential-services): If network is
> to be shared with the host, remove network configuration files from etc
> service.
> (containerized-operating-system): If network is to be shared with the host,
> remove nscd service and map host's /var/run/nscd if it exists.
> (container-script): If network is to be shared with the host, do not create
> network namespace.
> * guix/scripts/system.scm (system-derivation-for-action): Add
> (perform-action): Add #:container-shared-network? argument.
> (show-help): Add "-N, --network" help information.
> (%options): Add network option.
> (process-action): Call perform-action with #container-shared-network? argument.
>
> Co-authored-by: Christopher Baines <mail@cbaines.net>

LGTM!  I guess this is what you wanted to achieve, Chris, right?

Thank you,
Ludo’.

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Arun Isaac]

[-- Attachment #1.1: Type: text/plain, Size: 137 bytes --]


>> Should I add any documentation about this new -N option to the
>> manual?
>
> Yes, please.

Please find attached the updated patch.


[-- Attachment #1.2: 0001-linux-container-Support-container-network-sharing.patch --]
[-- Type: text/x-patch, Size: 11979 bytes --]

From 53fc5d548d8c2bb772dd6f26df80809ba2707a20 Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Fri, 10 May 2019 16:56:16 +0530
Subject: [PATCH] linux-container: Support container network sharing.

* gnu/system/linux-container.scm (container-essential-services): If network is
to be shared with the host, remove network configuration files from etc
service.
(containerized-operating-system): If network is to be shared with the host,
remove nscd service and map host's /var/run/nscd if it exists.
(container-script): If network is to be shared with the host, do not create
network namespace.
* guix/scripts/system.scm (system-derivation-for-action): Add
#:container-shared-network? argument.
(perform-action): Add #:container-shared-network? argument.
(show-help): Add "-N, --network" help information.
(%options): Add network option.
(process-action): Call perform-action with #container-shared-network? argument.
* doc/guix.texi (Invoking guix system): Document the "-N, --network" option.

Co-authored-by: Christopher Baines <mail@cbaines.net>
---
 doc/guix.texi                  |  5 +++
 gnu/system/linux-container.scm | 63 ++++++++++++++++++++++++++++------
 guix/scripts/system.scm        | 20 +++++++++--
 3 files changed, 75 insertions(+), 13 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b6d00ec176..aa4888da73 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -24586,6 +24586,11 @@ When this option is omitted, @command{guix system} computes an estimate
 of the image size as a function of the size of the system declared in
 @var{file}.
 
+@item --network
+@itemx -N
+For the @code{container} action, allow containers to access the host network,
+that is, do not create a network namespace.
+
 @item --root=@var{file}
 @itemx -r @var{file}
 Make @var{file} a symlink to the result, and register it as a garbage
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index ded5f279fe..ce786e39b2 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,7 +36,7 @@
             containerized-operating-system
             container-script))
 
-(define (container-essential-services os)
+(define* (container-essential-services os #:key shared-network?)
   "Return a list of essential services corresponding to OS, a
 non-containerized OS.  This procedure essentially strips essential services
 from OS that are needed on the bare metal and not in a container."
@@ -51,9 +52,20 @@ from OS that are needed on the bare metal and not in a container."
                  (let ((locale (operating-system-locale-directory os)))
                    (with-monad %store-monad
                      (return `(("locale" ,locale))))))
-        base))
+        ;; If network is to be shared with the host, remove network
+        ;; configuration files from etc-service.
+        (if shared-network?
+            (modify-services base
+              (etc-service-type
+               files => (remove
+                         (match-lambda
+                           ((filename _)
+                            (member filename
+                                    (map basename %network-configuration-files))))
+                         files)))
+            base)))
 
-(define (containerized-operating-system os mappings)
+(define* (containerized-operating-system os mappings #:key shared-network?)
   "Return an operating system based on OS for use in a Linux container
 environment.  MAPPINGS is a list of <file-system-mapping> to realize in the
 containerized OS."
@@ -76,27 +88,53 @@ containerized OS."
   (define useless-services
     ;; Services that make no sense in a container.  Those that attempt to
     ;; access /dev/tty[0-9] in particular cannot work in a container.
-    (list console-font-service-type
-          mingetty-service-type
-          agetty-service-type))
+    (append (list console-font-service-type
+                  mingetty-service-type
+                  agetty-service-type)
+            ;; Remove nscd service if network is shared with the host.
+            (if shared-network?
+                (list nscd-service-type)
+                (list))))
+
+  (define shared-network-file-mappings
+    ;; Files to map if network is to be shared with the host
+    (append %network-file-mappings
+            (let ((nscd-run-directory "/var/run/nscd"))
+              (if (file-exists? nscd-run-directory)
+                  (list (file-system-mapping
+                         (source nscd-run-directory)
+                         (target nscd-run-directory)))
+                  (list)))))
+
+  ;; (write shared-network-file-mappings)
+  ;; (newline)
 
   (operating-system
     (inherit os)
     (swap-devices '()) ; disable swap
-    (essential-services (container-essential-services os))
+    (essential-services (container-essential-services
+                         os #:shared-network? shared-network?))
     (services (remove (lambda (service)
                         (memq (service-kind service)
                               useless-services))
                       (operating-system-user-services os)))
-    (file-systems (append (map mapping->fs (cons %store-mapping mappings))
+    (file-systems (append (map mapping->fs
+                               (cons %store-mapping
+                                     (append mappings
+                                             (if shared-network?
+                                                 shared-network-file-mappings
+                                                 (list)))))
                           %container-file-systems
                           user-file-systems))))
 
-(define* (container-script os #:key (mappings '()))
+(define* (container-script os #:key (mappings '()) shared-network?)
   "Return a derivation of a script that runs OS as a Linux container.
 MAPPINGS is a list of <file-system> objects that specify the files/directories
 that will be shared with the host system."
-  (let* ((os           (containerized-operating-system os mappings))
+  (let* ((os           (containerized-operating-system
+                        os
+                        mappings
+                        #:shared-network? shared-network?))
          (file-systems (filter file-system-needed-for-boot?
                                (operating-system-file-systems os)))
          (specs        (map file-system->spec file-systems)))
@@ -121,6 +159,9 @@ that will be shared with the host system."
               ;; 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))))
+              #:host-uids 65536
+              #:namespaces (if #$shared-network?
+                               (delq 'net %namespaces)
+                               %namespaces)))))
 
     (gexp->script "run-container" script)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3c3d6cbd5f..cf4418f981 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -756,13 +757,17 @@ checking this by themselves in their 'check' procedure."
 
 (define* (system-derivation-for-action os action
                                        #:key image-size file-system-type
-                                       full-boot? mappings)
+                                       full-boot? container-shared-network?
+                                       mappings)
   "Return as a monadic value the derivation for OS according to ACTION."
   (case action
     ((build init reconfigure)
      (operating-system-derivation os))
     ((container)
-     (container-script os #:mappings mappings))
+     (container-script
+      os
+      #:mappings mappings
+      #:shared-network? container-shared-network?))
     ((vm-image)
      (system-qemu-image os #:disk-image-size image-size))
     ((vm)
@@ -826,6 +831,7 @@ and TARGET arguments."
                          dry-run? derivations-only?
                          use-substitutes? bootloader-target target
                          image-size file-system-type full-boot?
+                         container-shared-network?
                          (mappings '())
                          (gc-root #f))
   "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
@@ -834,6 +840,8 @@ target root directory; IMAGE-SIZE is the size of the image to be built, for
 the 'vm-image' and 'disk-image' actions.  The root file system is created as a
 FILE-SYSTEM-TYPE file system.  FULL-BOOT? is used for the 'vm' action; it
 determines whether to boot directly to the kernel or to the bootloader.
+CONTAINER-SHARED-NETWORK? determines if the container will use a separate
+network namespace.
 
 When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
 building anything.
@@ -883,6 +891,7 @@ static checks."
                                                 #:file-system-type file-system-type
                                                 #:image-size image-size
                                                 #:full-boot? full-boot?
+                                                #:container-shared-network? container-shared-network?
                                                 #:mappings mappings))
 
        ;; For 'init' and 'reconfigure', always build BOOTCFG, even if
@@ -1020,6 +1029,8 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --share=SPEC       for 'vm', share host file system according to SPEC"))
   (display (G_ "
+  -N, --network          for 'container', allow containers to access the network"))
+  (display (G_ "
   -r, --root=FILE        for 'vm', 'vm-image', 'disk-image', 'container',
                          and 'build', make FILE a symlink to the result, and
                          register it as a garbage collector root"))
@@ -1066,6 +1077,9 @@ Some ACTIONS support additional ARGS.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'image-size (size->number arg)
                                result)))
+         (option '(#\N "network") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'container-shared-network? #t result)))
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
@@ -1182,6 +1196,8 @@ resulting from command-line parsing."
                              #:file-system-type (assoc-ref opts 'file-system-type)
                              #:image-size (assoc-ref opts 'image-size)
                              #:full-boot? (assoc-ref opts 'full-boot?)
+                             #:container-shared-network?
+                             (assoc-ref opts 'container-shared-network?)
                              #:mappings (filter-map (match-lambda
                                                       (('file-system-mapping . m)
                                                        m)
-- 
2.21.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Ludovic Courtès]

Arun Isaac <arunisaac@systemreboot.net> skribis:

> From 53fc5d548d8c2bb772dd6f26df80809ba2707a20 Mon Sep 17 00:00:00 2001
> From: Arun Isaac <arunisaac@systemreboot.net>
> Date: Fri, 10 May 2019 16:56:16 +0530
> Subject: [PATCH] linux-container: Support container network sharing.
>
> * gnu/system/linux-container.scm (container-essential-services): If network is
> to be shared with the host, remove network configuration files from etc
> service.
> (containerized-operating-system): If network is to be shared with the host,
> remove nscd service and map host's /var/run/nscd if it exists.
> (container-script): If network is to be shared with the host, do not create
> network namespace.
> * guix/scripts/system.scm (system-derivation-for-action): Add
> #:container-shared-network? argument.
> (perform-action): Add #:container-shared-network? argument.
> (show-help): Add "-N, --network" help information.
> (%options): Add network option.
> (process-action): Call perform-action with #container-shared-network? argument.
> * doc/guix.texi (Invoking guix system): Document the "-N, --network" option.
>
> Co-authored-by: Christopher Baines <mail@cbaines.net>

LGTM, thanks!

Ludo’.

bug#28128: [PATCH 2/2] scripts: system: Support container network sharing.

[Arun Isaac]

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


> LGTM, thanks!

Pushed, thanks!

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Christopher Baines]

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


Arun Isaac <arunisaac@systemreboot.net> writes:

>> LGTM, thanks!
>
> Pushed, thanks!

Wahoo, thanks so much for moving this forward Arun :)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 962 bytes --]

[bug#28128] [PATCH 2/2] scripts: system: Support container network sharing.

[Arun Isaac]

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


>> Pushed, thanks!
>
> Wahoo, thanks so much for moving this forward Arun :)

Thank you! My pleasure! :-)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]