From: "Ludovic Courtès" <ludo@gnu.org>
To: Pierre Neidhardt <mail@ambrevar.xyz>
Cc: help-guix@gnu.org
Subject: Re: Fast `guix environment --container' switch
Date: Thu, 17 Dec 2020 22:52:51 +0100 [thread overview]
Message-ID: <87o8isdrrg.fsf@gnu.org> (raw)
In-Reply-To: <87o8j35ncu.fsf@ambrevar.xyz> (Pierre Neidhardt's message of "Wed, 09 Dec 2020 10:40:17 +0100")
[-- Attachment #1: Type: text/plain, Size: 585 bytes --]
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
[-- Attachment #2: run.scm --]
[-- Type: text/plain, Size: 6433 bytes --]
;;; 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)))))))))
next prev parent reply other threads:[~2020-12-17 21:53 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 [this message]
2020-12-29 21:47 ` Pierre Neidhardt
2021-01-05 22:50 ` Christopher Lemmer Webber
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=87o8isdrrg.fsf@gnu.org \
--to=ludo@gnu.org \
--cc=help-guix@gnu.org \
--cc=mail@ambrevar.xyz \
/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).