From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id AL3XC0jT218CcQAA0tVLHw (envelope-from ) for ; Thu, 17 Dec 2020 21:53:12 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id KOSbB0jT21/sZQAAbx9fmQ (envelope-from ) for ; Thu, 17 Dec 2020 21:53:12 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 4EB3A9404D2 for ; Thu, 17 Dec 2020 21:53:11 +0000 (UTC) Received: from localhost ([::1]:35066 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kq1Cv-0004V4-2Q for larch@yhetil.org; Thu, 17 Dec 2020 16:53:09 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:47862) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kq1Cg-0004Um-RI for help-guix@gnu.org; Thu, 17 Dec 2020 16:52:54 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:33242) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kq1Cf-0000Th-CE; Thu, 17 Dec 2020 16:52:53 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=50878 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1kq1Ce-0007Pi-KH; Thu, 17 Dec 2020 16:52:52 -0500 From: =?utf-8?Q?Ludovic_Court=C3=A8s?= To: Pierre Neidhardt Subject: Re: Fast `guix environment --container' switch References: <87o8j35ncu.fsf@ambrevar.xyz> X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 27 Frimaire an 229 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu Date: Thu, 17 Dec 2020 22:52:51 +0100 In-Reply-To: <87o8j35ncu.fsf@ambrevar.xyz> (Pierre Neidhardt's message of "Wed, 09 Dec 2020 10:40:17 +0100") Message-ID: <87o8isdrrg.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.1 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-BeenThere: help-guix@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: help-guix@gnu.org Errors-To: help-guix-bounces+larch=yhetil.org@gnu.org Sender: "Help-Guix" X-Migadu-Flow: FLOW_IN X-Migadu-Spam-Score: -1.81 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of help-guix-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=help-guix-bounces@gnu.org X-Migadu-Queue-Id: 4EB3A9404D2 X-Spam-Score: -1.81 X-Migadu-Scanner: scn0.migadu.com X-TUID: 2+vz61ASL4Gd --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi! Pierre Neidhardt 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=C2=B9 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 =E2=80=98guix environment=E2=80=99 so it= is faster. HTH! Ludo=E2=80=99. =C2=B9 https://lists.gnu.org/archive/html/help-guix/2018-01/msg00117.html --=-=-= Content-Type: text/plain; charset=utf-8 Content-Disposition: inline; filename=run.scm Content-Transfer-Encoding: quoted-printable ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2018, 2019, 2020 Ludovic Court=C3=A8s ;;; ;;; 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 . (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)) (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 namespaces mappings) safe? (namespaces safe-namespaces) (mappings safe-mappings)) (define (application-safe items) "Return safe corresponding to the application whose dependencies are list= ed 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=3D> 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") %no= t-colon) command)) (resolved (and=3D> full readlink*)) (prefix (and=3D> 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))))))))) --=-=-=--