From mboxrd@z Thu Jan 1 00:00:00 1970 From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Subject: Re: Running IceCat in a container Date: Thu, 25 Jan 2018 23:16:47 +0100 Message-ID: <87zi51r3cg.fsf@gnu.org> References: <87vag2wopo.fsf@gnu.org> <877esh3gwd.fsf@gnu.org> <87tvvlrzlc.fsf@gnu.org> <87efmeuhvb.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:51671) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eeppH-0001ja-OK for help-guix@gnu.org; Thu, 25 Jan 2018 17:16:57 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eeppD-0001F1-P0 for help-guix@gnu.org; Thu, 25 Jan 2018 17:16:55 -0500 In-Reply-To: <87efmeuhvb.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Thu, 25 Jan 2018 15:34:48 +0100") List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: help-guix-bounces+gcggh-help-guix=m.gmane.org@gnu.org Sender: "Help-Guix" To: Mike Gerwitz Cc: help-guix@gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable ludo@gnu.org (Ludovic Court=C3=A8s) skribis: > Mike Gerwitz skribis: > >> On Tue, Jan 16, 2018 at 17:30:42 +0100, Ludovic Court=C3=A8s wrote: > > [...] > >>> But really, we should make a specific tool for this. >>> >>> Thoughts? >> >> Yes, though I'd be curious how you'd approach it---each package requires >> certain paths be shared, and those paths would further depend on user >> privacy preferences, so need to be able to be overridden. > > For a start, we could simply share everything that=E2=80=99s in: > > guix gc -R $(guix build the-package) > > plus /tmp/.X11-unix, maybe $PWD, and a few more. If you drop the attached file under guix/scripts/, you can then run: guix run icecat icecat and similar. This particular example doesn=E2=80=99t work well because of = the font issue you=E2=80=99re familiar with, but you get the idea. :-) Ludo=E2=80=99. --=-=-= Content-Type: text/x-scheme; charset=utf-8 Content-Disposition: inline; filename=run.scm Content-Transfer-Encoding: quoted-printable Content-Description: The 'guix run' command. ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2018 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 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-11) #: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) (title 'device) (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))))) (define %writable-things (list "/var/run/nscd/socket" (string-append (getenv "HOME") "/.Xauthority") "/tmp/.X11-unix" "/etc/machine-id")) (define (guix-run . args) (with-error-handling (match (reverse (parse-command-line args %options '(()) #:argument-handler cons)) ((spec command args ...) (with-store store (let-values (((package output) (specification->package+output spec))) (let* ((drv (package-derivation store package)) (prefix (derivation->output-path drv output))) (show-what-to-build store (list drv)) (build-derivations store (list drv)) (let* ((items (requisites store (list prefix))) (env (environ)) (full (search-path (list (string-append prefix "/bin") (string-append prefix "/sbin"= )) command))) (unless full (leave (G_ "command '~a' not found in package '~a'~%") command (package-name package))) (call-with-container (append (filter-map bind-mount-spec/ro items) (filter-map bind-mount-spec/rw %writable-things)) (lambda () (environ env) ;TODO: filter ENV (mkdir-p (getenv "HOME")) (newline) (catch #t (lambda () (apply execl full command args)) (lambda (key . args) (print-exception (current-error-port) #f key args) (exit 1)))) #:namespaces (delq 'net %namespaces)))))))))) --=-=-=--