unofficial mirror of help-guix@gnu.org 
 help / color / mirror / Atom feed
From: Christopher Lemmer Webber <cwebber@dustycloud.org>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: help-guix@gnu.org
Subject: Re: Fast `guix environment --container' switch
Date: Tue, 05 Jan 2021 17:50:19 -0500	[thread overview]
Message-ID: <877dort2vo.fsf@dustycloud.org> (raw)
In-Reply-To: <87o8isdrrg.fsf@gnu.org>

This is very cool.  We need something like this!

I'm replying partly to make a note that here's where some of this
conversation is... but I'm going to try to write an email over the next
couple of weeks of how to lead the way for making users safe through
Guix.  This is a useful reference starting point.

 - Chris


Ludovic Courtès writes:

> Hi!
>
> Pierre Neidhardt <mail@ambrevar.xyz> skribis:
>
>> `guix environment --container ... -- my-foo-program` is great but a bit
>> slow to start.
>>
>> Is there a way to speed this up?
>
> The attached program (based on an experiment from 2018¹ with exciting
> yet to date mythical prospects) picks a program from $PATH (typically
> from your profile) and runs it in a container.  As in:
>
>   guix run inkscape
>
> It has less work to do compared to ‘guix environment’ so it is faster.
>
> HTH!
>
> Ludo’.
>
> ¹ https://lists.gnu.org/archive/html/help-guix/2018-01/msg00117.html
>
> ;;; GNU Guix --- Functional package management for GNU
> ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@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 run)
>   #:use-module (guix ui)
>   #:use-module (guix utils)
>   #:use-module (guix scripts)
>   #:use-module (guix store)
>   #:use-module (guix packages)
>   #:use-module (guix derivations)
>   #:use-module ((guix build utils) #:select (which mkdir-p))
>   #:use-module (gnu build linux-container)
>   #:use-module (gnu system file-systems)
>   #:use-module (gnu packages)
>   #:use-module (srfi srfi-1)
>   #:use-module (srfi srfi-9 gnu)
>   #:use-module (srfi srfi-11)
>   #:use-module (srfi srfi-26)
>   #:use-module (srfi srfi-37)
>   #:use-module (ice-9 match)
>   #:export (guix-run))
>
> (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 run")))))
>
> (define (show-help)
>   (display (G_ "Usage: guix run PACKAGE COMMAND...
> Run COMMAND from PACKAGE in a container.\n"))
>   (newline)
>   (display (G_ "
>   -h, --help             display this help and exit"))
>   (display (G_ "
>   -V, --version          display version information and exit"))
>   (newline)
>   (show-bug-report-information))
>
> \f
>
> (define (bind-mount-spec/ro item)
>   (and (file-exists? item)
>        (file-system
>          (device item)
>          (mount-point item)
>          (type "none")
>          (flags '(bind-mount read-only))
>          (check? #f))))
>
> (define (bind-mount-spec/rw item)
>   (and (file-exists? item)
>        (file-system
>          (inherit (bind-mount-spec/ro item))
>          (flags '(bind-mount)))))
>
> ;; Safe in which applications run.
> (define-immutable-record-type <safe>
>   (safe namespaces mappings)
>   safe?
>   (namespaces  safe-namespaces)
>   (mappings    safe-mappings))
>
> (define (application-safe items)
>   "Return safe corresponding to the application whose dependencies are listed
> in ITEMS."
>   (define packages
>     (map (compose (cut package-name->name+version <> #\-)
>                   store-path-package-name)
>          items))
>
>   (define x11? (member "libx11" packages))
>   (define dbus? (member "dbus" packages))
>   (define alsa? (member "alsa-lib" packages))
>   (define pulseaudio? (member "pulseaudio" packages))
>
>   (define mappings
>     (let-syntax ((if (syntax-rules ()
>                        ((_ condition body)
>                         (if condition
>                             (or (and=> body list) '())
>                             '()))))
>                  (ro (identifier-syntax bind-mount-spec/ro))
>                  (rw (identifier-syntax bind-mount-spec/rw)))
>       `(,(rw "/var/run/nscd/socket")
>         ,@(if x11? (rw (string-append (getenv "HOME") "/.Xauthority")))
>         ,@(if x11? (rw "/tmp/.X11-unix"))
>         ,@(if x11? (rw (string-append "/run/user/"
>                                       (number->string (getuid)))))
>         ,@(if dbus? (ro "/etc/machine-id"))
>         ,@(if alsa? (rw "/dev/snd"))
>         ,@(if pulseaudio? (rw (string-append (getenv "HOME") "/.pulse"))))))
>
>   (define namespaces
>     ;; X11 applications need to run in the same IPC namespace as
>     ;; the server.
>     (if x11?
>         (fold delq %namespaces '(ipc net))
>         %namespaces))
>
>   (safe namespaces mappings))
>
> (define %not-colon
>   (char-set-complement (char-set #\:)))
>
> (define (guix-run . args)
>   (define (parse-options)
>     ;; Return the alist of option values.  With this hack, the first
>     ;; non-option argument is considered to be the beginning of the command.
>     (let-values (((args command) (span (cut string-prefix? "-" <>) args)))
>       (args-fold* args %options
>                   (lambda (opt name arg result)
>                     (leave (G_ "~A: unrecognized option~%") name))
>                   (lambda (arg result)
>                     (pk 'arg arg)
>                     (alist-cons 'argument arg result))
>                   '())
>       command))
>
>   (with-error-handling
>     (match (parse-options)
>       ((command args ...)
>        (with-store store
>          (let* ((full     (search-path (string-tokenize (getenv "PATH") %not-colon)
>                                        command))
>                 (resolved (and=> full readlink*))
>                 (prefix   (and=> resolved (lambda (file)
>                                             (and (store-path? file)
>                                                  (direct-store-path file))))))
>            (unless full
>              (leave (G_ "command '~a' not found~%") command))
>            (unless prefix
>              (leave (G_ "command '~a' is not in '~a'~%")
>                     command (%store-prefix)))
>
>            (let* ((items (requisites store (list prefix)))
>                   (safe  (application-safe items))
>                   (env   (environ))
>                   (cwd   (getcwd)))
>
>              (call-with-container
>                  (append (map bind-mount-spec/ro items)
>                          (safe-mappings safe)
>                          (list (bind-mount-spec/ro cwd))) ;XXX: avoid that?
>                (lambda ()
>                  (environ env)                    ;TODO: filter ENV
>                  (mkdir-p (getenv "HOME"))
>                  (chdir cwd)
>
>                  (newline)
>                  (catch #t
>                    (lambda ()
>                      (apply execl resolved command args))
>                    (lambda (key . args)
>                      (print-exception (current-error-port) #f key args)
>                      (exit 1))))
>
>                #:namespaces (safe-namespaces safe)))))))))



  parent reply	other threads:[~2021-01-05 22:50 UTC|newest]

Thread overview: 11+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-12-09  9:40 Fast `guix environment --container' switch Pierre Neidhardt
2020-12-09 10:07 ` zimoun
2020-12-09 10:13   ` Pierre Neidhardt
2020-12-09 10:37     ` zimoun
2020-12-09 10:55       ` Pierre Neidhardt
2020-12-09 11:47         ` zimoun
2020-12-09 12:02           ` Pierre Neidhardt
2020-12-17 21:52 ` Ludovic Courtès
2020-12-29 21:47   ` Pierre Neidhardt
2021-01-05 22:50   ` Christopher Lemmer Webber [this message]
2021-01-26 10:31   ` Pierre Neidhardt

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=877dort2vo.fsf@dustycloud.org \
    --to=cwebber@dustycloud.org \
    --cc=help-guix@gnu.org \
    --cc=ludo@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).