Add (guix least-authority).
* guix/least-authority.scm: New file. * Makefile.am (MODULES): Add it. * gnu/build/shepherd.scm (default-mounts): Make public.
This commit is contained in:
Ludovic Courtès
parent
391bd14359
commit
3682bd4003
@ -130,6 +130,7 @@ MODULES = \
|
||||
guix/cache.scm \
|
||||
guix/cve.scm \
|
||||
guix/workers.scm \
|
||||
guix/least-authority.scm \
|
||||
guix/ipfs.scm \
|
||||
guix/build-system.scm \
|
||||
guix/build-system/android-ndk.scm \
|
||||
|
||||
@ -31,7 +31,8 @@
|
||||
exec-command
|
||||
%precious-signals)
|
||||
#:autoload (shepherd system) (unblock-signals)
|
||||
#:export (make-forkexec-constructor/container
|
||||
#:export (default-mounts
|
||||
make-forkexec-constructor/container
|
||||
fork+exec-command/container))
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
135
guix/least-authority.scm
Normal file
135
guix/least-authority.scm
Normal file
@ -0,0 +1,135 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2022 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 least-authority)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix modules)
|
||||
#:use-module ((guix store) #:select (%store-prefix))
|
||||
#:autoload (gnu build linux-container) (%namespaces)
|
||||
#:autoload (gnu system file-systems) (file-system-mapping
|
||||
file-system-mapping-source
|
||||
spec->file-system
|
||||
file-system->spec
|
||||
file-system-mapping->bind-mount)
|
||||
#:export (least-authority-wrapper))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; This module provides tools to execute programs with the least authority
|
||||
;;; necessary, using Linux namespaces.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define %precious-variables
|
||||
;; Environment variables preserved by the wrapper by default.
|
||||
'("HOME" "USER" "LOGNAME" "DISPLAY" "XAUTHORITY" "TERM" "TZ" "PAGER"))
|
||||
|
||||
(define* (least-authority-wrapper program
|
||||
#:key (name "pola-wrapper")
|
||||
(guest-uid 1000)
|
||||
(guest-gid 1000)
|
||||
(mappings '())
|
||||
(namespaces %namespaces)
|
||||
(directory "/")
|
||||
(preserved-environment-variables
|
||||
%precious-variables))
|
||||
"Return a wrapper of PROGRAM that executes it with the least authority.
|
||||
|
||||
PROGRAM is executed in separate namespaces according to NAMESPACES, a list of
|
||||
symbols; it turns with GUEST-UID and GUEST-GID. MAPPINGS is a list of
|
||||
<file-system-mapping> records indicating directories mirrored inside the
|
||||
execution environment of PROGRAM. DIRECTORY is the working directory of the
|
||||
wrapped process. Each environment listed in PRESERVED-ENVIRONMENT-VARIABLES
|
||||
is preserved; other environment variables are erased."
|
||||
(define code
|
||||
(with-imported-modules (source-module-closure
|
||||
'((gnu system file-systems)
|
||||
(gnu build shepherd)
|
||||
(gnu build linux-container)))
|
||||
#~(begin
|
||||
(use-modules (gnu system file-systems)
|
||||
(gnu build linux-container)
|
||||
((gnu build shepherd) #:select (default-mounts))
|
||||
(srfi srfi-1))
|
||||
|
||||
(define variables
|
||||
(filter-map (lambda (variable)
|
||||
(let ((value (getenv variable)))
|
||||
(and value
|
||||
(string-append variable "=" value))))
|
||||
'#$preserved-environment-variables))
|
||||
|
||||
(define (read-file file)
|
||||
(call-with-input-file file read))
|
||||
|
||||
(define references
|
||||
(delete-duplicates
|
||||
(append-map read-file
|
||||
'#$(map references-file
|
||||
(cons program
|
||||
(map file-system-mapping-source
|
||||
mappings))))))
|
||||
|
||||
(define (store? file-system)
|
||||
(string=? (file-system-mount-point file-system)
|
||||
#$(%store-prefix)))
|
||||
|
||||
(define mounts
|
||||
(append (map (lambda (item)
|
||||
(file-system-mapping->bind-mount
|
||||
(file-system-mapping (source item)
|
||||
(target item))))
|
||||
references)
|
||||
(remove store?
|
||||
(default-mounts
|
||||
#:namespaces '#$namespaces))
|
||||
(map spec->file-system
|
||||
'#$(map (compose file-system->spec
|
||||
file-system-mapping->bind-mount)
|
||||
mappings))))
|
||||
|
||||
(define (reify-exit-status status)
|
||||
(cond ((status:exit-val status) => exit)
|
||||
((or (status:term-sig status)
|
||||
(status:stop-sig status))
|
||||
=> (lambda (signal)
|
||||
(format (current-error-port)
|
||||
"~a terminated with signal ~a~%"
|
||||
#$program signal)
|
||||
(exit (+ 128 signal))))))
|
||||
|
||||
;; Note: 'call-with-container' creates a sub-process that this one
|
||||
;; waits for. This might seem suboptimal but unshare(2) isn't
|
||||
;; really applicable: the process would still run in the same PID
|
||||
;; namespace.
|
||||
|
||||
(reify-exit-status
|
||||
(call-with-container mounts
|
||||
(lambda ()
|
||||
(chdir #$directory)
|
||||
(environ variables)
|
||||
(apply execl #$program #$program (cdr (command-line))))
|
||||
|
||||
;; Don't assume PROGRAM can behave as an init process.
|
||||
#:child-is-pid1? #f
|
||||
|
||||
#:guest-uid #$guest-uid
|
||||
#:guest-gid #$guest-gid
|
||||
#:namespaces '#$namespaces)))))
|
||||
|
||||
(program-file name code))
|
||||
Loading…
Reference in New Issue
Block a user