~ruther/guix-local

32efa254a80672bdf5199b8e200764615a3cf68b — David Thompson 10 years ago 7c5a442
scripts: Add 'container' subcommand.

* guix/scripts/container.scm: New file.
* guix/scripts/container/exec.scm: New file.
* po/guix/POTFILES.in: Add them.
* Makefile.am (MODULES): Add them.
* doc/guix.texi (Invoking guix container): New section.
5 files changed, 209 insertions(+), 0 deletions(-)

M Makefile.am
M doc/guix.texi
A guix/scripts/container.scm
A guix/scripts/container/exec.scm
M po/guix/POTFILES.in
M Makefile.am => Makefile.am +2 -0
@@ 128,6 128,8 @@ MODULES =					\
  guix/scripts/edit.scm				\
  guix/scripts/size.scm				\
  guix/scripts/graph.scm			\
  guix/scripts/container.scm			\
  guix/scripts/container/exec.scm		\
  guix.scm					\
  $(GNU_SYSTEM_MODULES)


M doc/guix.texi => doc/guix.texi +56 -0
@@ 144,6 144,7 @@ Utilities
* Invoking guix environment::   Setting up development environments.
* Invoking guix publish::       Sharing substitutes.
* Invoking guix challenge::     Challenging substitute servers.
* Invoking guix container::     Process isolation.

GNU Distribution



@@ 3583,6 3584,7 @@ programming interface of Guix in a convenient way.
* Invoking guix environment::   Setting up development environments.
* Invoking guix publish::       Sharing substitutes.
* Invoking guix challenge::     Challenging substitute servers.
* Invoking guix container::     Process isolation.
@end menu

@node Invoking guix build


@@ 5036,6 5038,60 @@ URLs to compare to.
@end table


@node Invoking guix container
@section Invoking @command{guix container}
@cindex container

@quotation Note
As of version @value{VERSION}, this tool is experimental.  The interface
is subject to radical change in the future.
@end quotation

The purpose of @command{guix container} is to manipulate processes
running within an isolated environment, commonly known as a
``container,'' typically created by the @command{guix environment}
(@pxref{Invoking guix environment}) and @command{guix system container}
(@pxref{Invoking guix system}) commands.

The general syntax is:

@example
guix container @var{action} @var{options}@dots{}
@end example

@var{action} specifies the operation to perform with a container, and
@var{options} specifies the context-specific arguments for the action.

The following actions are available:

@table @code
@item exec
Execute a command within the context of a running container.

The syntax is:

@example
guix container exec @var{pid} @var{program} @var{arguments}@dots{}
@end example

@var{pid} specifies the process ID of the running container.
@var{program} specifies an executable file name within the container's
root file system.  @var{arguments} are the additional options that will
be passed to @var{program}.

The following command launches an interactive login shell inside a
GuixSD container, started by @command{guix system container}, and whose
process ID is 9001:

@example
guix container exec 9001 /run/current-system/profile/bin/bash --login
@end example

Note that the @var{pid} cannot be the parent process of a container.  It
must be the container's PID 1 or one of its child processes.

@end table

@c *********************************************************************
@node GNU Distribution
@chapter GNU Distribution

A guix/scripts/container.scm => guix/scripts/container.scm +63 -0
@@ 0,0 1,63 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix scripts container)
  #:use-module (ice-9 match)
  #:use-module (guix ui)
  #:export (guix-container))

(define (show-help)
  (display (_ "Usage: guix container ACTION ARGS...
Build and manipulate Linux containers.\n"))
  (newline)
  (display (_ "The valid values for ACTION are:\n"))
  (newline)
  (display (_ "\
   exec            execute a command inside of an existing container\n"))
  (newline)
  (display (_ "
  -h, --help             display this help and exit"))
  (display (_ "
  -V, --version          display version information and exit"))
  (newline)
  (show-bug-report-information))

(define %actions '("exec"))

(define (resolve-action name)
  (let ((module (resolve-interface
                 `(guix scripts container ,(string->symbol name))))
        (proc (string->symbol (string-append "guix-container-" name))))
    (module-ref module proc)))

(define (guix-container . args)
  (with-error-handling
    (match args
      (()
       (format (current-error-port)
               (_ "guix container: missing action~%")))
      ((or ("-h") ("--help"))
       (show-help)
       (exit 0))
      (("--version")
       (show-version-and-exit "guix container"))
      ((action args ...)
       (if (member action %actions)
           (apply (resolve-action action) args)
           (format (current-error-port)
                   (_ "guix container: invalid action~%")))))))

A guix/scripts/container/exec.scm => guix/scripts/container/exec.scm +86 -0
@@ 0,0 1,86 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix scripts container exec)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-37)
  #:use-module (guix scripts)
  #:use-module (guix ui)
  #:use-module (guix utils)
  #:use-module (gnu build linux-container)
  #:export (guix-container-exec))

(define %options
  (list (option '(#\h "help") #f #f
                (lambda args
                  (show-help)
                  (exit 0)))
        (option '(#\V "version") #f #f
                (lambda args
                  (show-version-and-exit "guix container exec")))))

(define (show-help)
  (display (_ "Usage: guix container exec PID COMMAND [ARGS...]
Execute COMMMAND within the container process PID.\n"))
  (newline)
  (display (_ "
  -h, --help             display this help and exit"))
  (display (_ "
  -V, --version          display version information and exit"))
  (newline)
  (show-bug-report-information))

(define (partition-args args)
  "Split ARGS into two lists; one containing the arguments for this program,
and the other containing arguments for the command to be executed."
  (break (lambda (arg)
           ;; Split after the pid argument.
           (not (false-if-exception (string->number arg))))
         args))

(define (guix-container-exec . args)
  (define (handle-argument arg result)
    (if (assoc-ref result 'pid)
        (leave (_ "~a: extraneous argument~%") arg)
        (alist-cons 'pid (string->number* arg) result)))

  (with-error-handling
    (let-values (((args command) (partition-args args)))
      (let* ((opts (parse-command-line args %options '(())
                                       #:argument-handler
                                       handle-argument))
             (pid  (assoc-ref opts 'pid)))

        (unless pid
          (leave (_ "no pid specified~%")))

        (when (null? command)
          (leave (_ "no command specified~%")))

        (unless (file-exists? (string-append "/proc/" (number->string pid)))
          (leave (_ "no such process ~d~%") pid))

        (let ((result (container-excursion pid
                        (lambda ()
                          (match command
                            ((program . program-args)
                             (apply execlp program program program-args)))))))
          (unless (zero? result)
            (leave (_ "exec failed with status ~d~%") result)))))))

M po/guix/POTFILES.in => po/guix/POTFILES.in +2 -0
@@ 25,6 25,8 @@ guix/scripts/size.scm
guix/scripts/graph.scm
guix/scripts/challenge.scm
guix/gnu-maintenance.scm
guix/scripts/container.scm
guix/scripts/container/exec.scm
guix/upstream.scm
guix/ui.scm
guix/http-client.scm