davexunit pushed a commit to branch wip-container
in repository guix.
commit bb50fd112c9c179fcb160204f975f0a4ee5167f9
Author: David Thompson <da...@gnu.org>
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 option.
(guix-environment): Spawn new process in a container when requested.
---
guix/scripts/environment.scm | 35 +++++++++++++++++++++++++----------
1 files changed, 25 insertions(+), 10 deletions(-)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 007fde1..f944b2b 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -27,6 +27,7 @@
#:use-module (guix utils)
#:use-module (guix monads)
#:use-module (guix scripts build)
+ #:use-module (gnu build linux-container)
#:use-module (gnu packages)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
@@ -109,6 +110,8 @@ shell command in that environment.\n"))
--pure unset existing environment variables"))
(display (_ "
--search-paths display needed environment variable definitions"))
+ (display (_ "
+ -C, --container run command within an isolated container"))
(newline)
(show-build-options-help)
(newline)
@@ -156,6 +159,9 @@ shell command in that environment.\n"))
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
+ (option '(#\C "container") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'container? #t result)))
%standard-build-options))
(define (pick-all alist key)
@@ -232,15 +238,16 @@ packages."
(alist-cons 'package arg result))
(with-error-handling
- (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?
- (packages+propagated-inputs packages)
- (packages->transitive-inputs packages))))
+ (let* ((opts (parse-command-line args %options (list
%default-options)
+ #:argument-handler handle-argument))
+ (container? (assoc-ref opts 'container?))
+ (pure? (or (assoc-ref opts 'pure) container?))
+ (ad-hoc? (assoc-ref opts 'ad-hoc?))
+ (command (assoc-ref opts 'exec))
+ (packages (pick-all (options/resolve-packages opts) 'package))
+ (inputs (if ad-hoc?
+ (packages+propagated-inputs packages)
+ (packages->transitive-inputs packages))))
(with-store store
(define drvs
(run-with-store store
@@ -254,4 +261,12 @@ packages."
(show-search-paths inputs drvs pure?))
(else
(create-environment inputs drvs pure?)
- (system command)))))))
+ (if container?
+ (call-with-container "/tmp/container"
+ `(("/gnu/store" "/gnu/store")
+ (,(getcwd) "/env"))
+ (lambda ()
+ (display "container!\n")
+ (chdir "/env")
+ (system command)))
+ (system command))))))))
