[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/07: scripts: environment: Add --container option.
From: |
David Thompson |
Subject: |
04/07: scripts: environment: Add --container option. |
Date: |
Sat, 05 Sep 2015 18:23:00 +0000 |
davexunit pushed a commit to branch wip-container
in repository guix.
commit 7f462fb06712fc1ace6df6fbf900efd94eb69649
Author: David Thompson <address@hidden>
Date: Fri Jun 19 08:57:44 2015 -0400
scripts: environment: Add --container option.
* guix/scripts/enviroment.scm (show-help): Show help for new option.
(%options): Add --container and --network options.
(launch-environment, launch-environment/container, requisites*,
inputs->requisites): New procedures.
(guix-environment): Spawn new process in a container when requested.
* doc/guix.texi (Invoking guix environment): Document it.
---
doc/guix.texi | 22 +++++
guix/scripts/environment.scm | 174 ++++++++++++++++++++++++++++++++++--------
2 files changed, 165 insertions(+), 31 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index f943540..68d5676 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4508,6 +4508,18 @@ NumPy:
guix environment --ad-hoc python2-numpy python-2.7 -E python
@end example
+Sometimes it is desirable to isolate the environment as much as
+possible, for maximal purity and reproducibility. In particular, when
+using Guix on a host distro that is not GuixSD, it is desirable to
+prevent access to @file{/usr/bin} and other system-wide resources from
+the development environment. For example, the following command spawns
+a Guile REPL in a ``container'' where only the store and the current
+working directory are mounted:
+
address@hidden
+guix environment --ad-hoc --container guile --exec=guile
address@hidden example
+
The available options are summarized below.
@table @code
@@ -4573,6 +4585,15 @@ environment.
@item address@hidden
@itemx -s @var{system}
Attempt to build for @var{system}---e.g., @code{i686-linux}.
+
address@hidden --container
address@hidden -C
address@hidden container
+Run @var{command} within an isolated container. The current working
+directory outside the container is mapped to @file{/env} inside the
+container. Additionally, the spawned process runs as the current user
+outside the container, but has root privileges in the context of the
+container.
@end table
It also supports all of the common build options that @command{guix
@@ -6749,6 +6770,7 @@ This command also installs GRUB on the device specified in
@item vm
@cindex virtual machine
@cindex VM
address@hidden system vm}
Build a virtual machine that contain the operating system declared in
@var{file}, and return a script to run that virtual machine (VM).
Arguments given to the script are passed as is to QEMU.
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index ecdbc7a..9c1c41f 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -28,7 +28,11 @@
#:use-module (guix monads)
#:use-module ((guix gexp) #:select (lower-inputs))
#:use-module (guix scripts build)
+ #:use-module (gnu build linux-container)
+ #:use-module (gnu system linux-container)
+ #:use-module (gnu system file-systems)
#:use-module (gnu packages)
+ #:use-module (gnu packages bash)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -122,6 +126,10 @@ shell command in that environment.\n"))
--search-paths display needed environment variable definitions"))
(display (_ "
-s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
+ (display (_ "
+ -C, --container run command within an isolated container"))
+ (display (_ "
+ -N, --network allow containers to access the network"))
(newline)
(show-build-options-help)
(newline)
@@ -174,6 +182,12 @@ shell command in that environment.\n"))
(lambda (opt name arg result)
(alist-cons 'system arg
(alist-delete 'system result eq?))))
+ (option '(#\C "container") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'container? #t result)))
+ (option '(#\N "network") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'network? #t result)))
%standard-build-options))
(define (pick-all alist key)
@@ -229,56 +243,154 @@ OUTPUT) tuples, using the build options in OPTS."
(built-derivations derivations)
(return derivations))))))))
+(define (launch-environment command inputs paths pure?)
+ "Run COMMAND in a new environment containing INPUTS, using the native search
+paths defined by the list PATHS. When PURE?, pre-existing environment
+variables are cleared before setting the new ones."
+ (create-environment inputs paths pure?)
+ (system command))
+
+(define (launch-environment/container command bash requisites inputs
+ paths network?)
+ "Run COMMAND within a Linux container whose global shell (/bin/sh) is BASH,
+that includes the closure of INPUTS, and that sets the environment variables
+defined by PATHS, a list of native search paths. When NETWORK?, access to the
+host system network is permitted."
+ ;; Bind-mount all requisite store items, /bin/sh, the current working
+ ;; directory, and possibly networking configuration files within the
+ ;; container.
+ (let* ((cwd (getcwd))
+ (mappings (append
+ (list (file-system-mapping
+ (source cwd)
+ (target cwd)
+ (writable? #t))
+ (file-system-mapping
+ (source (string-append (derivation->output-path
bash)
+ "/bin/sh"))
+ (target "/bin/sh")
+ (writable? #f)))
+ ;; When in Nix, do as build.cc does.
+ (if network?
+ (filter-map (lambda (file)
+ (and (file-exists? file)
+ (file-system-mapping
+ (source file)
+ (target file)
+ (writable? #f))))
+ '("/etc/resolv.conf"
+ "/etc/nsswitch.conf"
+ "/etc/services"
+ "/etc/hosts"))
+ '())
+ (map (lambda (dir)
+ (file-system-mapping
+ (source dir)
+ (target dir)
+ (writable? #f)))
+ requisites)))
+ (file-systems (append %container-file-systems
+ (map mapping->file-system mappings)))
+ (status
+ (call-with-container (map file-system->spec file-systems)
+ (lambda ()
+ ;; Setup directory for temporary files.
+ (mkdir "/tmp")
+ (for-each (lambda (var)
+ (setenv var "/tmp"))
+ ;; The same variables as in Nix's 'build.cc'.
+ '("TMPDIR" "TEMPDIR" "TMP" "TEMP"))
+
+ ;; For convenience, start in the user's current working
+ ;; directory rather than the root directory.
+ (chdir cwd)
+
+ ;; A container's environment is already purified, so no need to
+ ;; request it be purified again.
+ (launch-environment command inputs paths #f))
+ #:namespaces (if network?
+ (delq 'net %namespaces)
+ %namespaces))))
+ (status:exit-val status)))
+
+(define requisites* (store-lift requisites))
+
+(define (inputs->requisites inputs)
+ "Convert INPUTS, a list of derivations, into a set of requisite store items
i.e.
+the union closure of all the inputs."
+ (define input->requisites
+ (match-lambda
+ ((drv output)
+ (requisites* (derivation->output-path drv output)))))
+
+ (mlet %store-monad ((reqs (sequence %store-monad
+ (map input->requisites inputs))))
+ (return (delete-duplicates (concatenate reqs)))))
+
;; Entry point.
(define (guix-environment . args)
(define (handle-argument arg result)
(alist-cons 'package arg result))
(with-error-handling
- (let* ((opts (parse-command-line args %options (list %default-options)
+ (let* ((opts (parse-command-line args %options (list
%default-options)
#:argument-handler handle-argument))
- (pure? (assoc-ref opts 'pure))
- (ad-hoc? (assoc-ref opts 'ad-hoc?))
- (command (assoc-ref opts 'exec))
- (packages (pick-all (options/resolve-packages opts) 'package))
- (inputs (if ad-hoc?
- (append-map (match-lambda
- ((package output)
- (package+propagated-inputs package
- output)))
- packages)
- (append-map (compose bag-transitive-inputs
- package->bag
- first)
- packages)))
- (paths (delete-duplicates
- (cons $PATH
- (append-map (match-lambda
- ((label (? package? p) _ ...)
- (package-native-search-paths p))
- (_
- '()))
- inputs))
- eq?)))
+ (pure? (assoc-ref opts 'pure))
+ (container? (assoc-ref opts 'container?))
+ (network? (assoc-ref opts 'network?))
+ (ad-hoc? (assoc-ref opts 'ad-hoc?))
+ (command (assoc-ref opts 'exec))
+ (packages (pick-all (options/resolve-packages opts) 'package))
+ (inputs (if ad-hoc?
+ (append-map (match-lambda
+ ((package output)
+ (package+propagated-inputs package
+ output)))
+ packages)
+ (append-map (compose bag-transitive-inputs
+ package->bag
+ first)
+ packages)))
+ (paths (delete-duplicates
+ (cons $PATH
+ (append-map (match-lambda
+ ((label (? package? p) _ ...)
+ (package-native-search-paths p))
+ (_
+ '()))
+ inputs))
+ eq?)))
(with-store store
(run-with-store store
- (mlet %store-monad ((inputs (lower-inputs
- (map (match-lambda
+ (mlet* %store-monad ((inputs (lower-inputs
+ (map (match-lambda
((label item)
(list item))
((label item output)
(list item output)))
- inputs)
- #:system (assoc-ref opts 'system))))
+ inputs)
+ #:system (assoc-ref opts 'system)))
+ ;; Containers need a Bourne shell at /bin/sh.
+ (bash (if container?
+ (package->derivation bash)
+ (return #f)))
+ (all-inputs -> (if container?
+ `((,bash "out") ,@inputs)
+ inputs)))
(mbegin %store-monad
;; First build INPUTS. This is necessary even for
;; --search-paths.
- (build-inputs inputs opts)
+ (build-inputs all-inputs opts)
(cond ((assoc-ref opts 'dry-run?)
(return #t))
((assoc-ref opts 'search-paths)
(show-search-paths inputs paths pure?)
(return #t))
+ (container?
+ (mlet %store-monad ((reqs (inputs->requisites
all-inputs)))
+ (return
+ (launch-environment/container command bash reqs
+ inputs paths network?))))
(else
- (create-environment inputs paths pure?)
- (return (exit (status:exit-val (system
command)))))))))))))
+ (return
+ (launch-environment command inputs paths pure?)))))))))))
- branch wip-container created (now 228e77d), David Thompson, 2015/09/05
- 01/07: build: container: Setup /dev/console., David Thompson, 2015/09/05
- 02/07: build: container: Use the same clone flags as fork(3)., David Thompson, 2015/09/05
- 03/07: gnu: system: Add Linux container module., David Thompson, 2015/09/05
- 04/07: scripts: environment: Add --container option.,
David Thompson <=
- 05/07: scripts: system: Add 'container' action., David Thompson, 2015/09/05
- 07/07: build: syscalls: Add pseudo-terminal bindings., David Thompson, 2015/09/05
- 06/07: scripts: Add 'container' subcommand., David Thompson, 2015/09/05