projects/guix·blob python-team · refs

57 lines · 2.2 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2021 Brice Waegeneire <[email protected]>
3;;; Copyright © 2022 Tobias Geerinckx-Rice <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21;;;
22;;; Do not use this module in new code. It used to define data structures
23;;; representing setuid/setgid programs, but is now a mere compatibility shim
24;;; wrapping a subset of (gnu system privilege).
25;;;
26;;; Code:
27
28(define-module (gnu system setuid)
29 #:use-module (gnu system privilege)
30 #:use-module (ice-9 match)
31 #:use-module (srfi srfi-1)
32 #:re-export (file-like->setuid-program)
33 #:export (setuid-program
34 setuid-program?
35 setuid-program-program
36 setuid-program-setuid?
37 setuid-program-setgid?
38 setuid-program-user
39 setuid-program-group))
40
41(define-syntax setuid-program
42 (lambda (fields)
43 (syntax-case fields ()
44 ((_ (field value) ...)
45 #`(privileged-program
46 (setuid? (match (assoc-ref '((field value) ...) 'setuid?)
47 ((#f) #f)
48 (_ #t)))
49 #,@(remove (match-lambda ((f _) (eq? (syntax->datum f) 'setuid?)))
50 #'((field value) ...)))))))
51
52(define setuid-program? privileged-program?)
53(define setuid-program-program privileged-program-program)
54(define setuid-program-setuid? privileged-program-setuid?)
55(define setuid-program-setgid? privileged-program-setgid?)
56(define setuid-program-user privileged-program-user)
57(define setuid-program-group privileged-program-group)