;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; 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 (gnu system pam) #:use-module (guix records) #:use-module (guix derivations) #:use-module (guix gexp) #:use-module (gnu services) #:use-module (ice-9 match) #:use-modu
aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org>
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.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 (gnu build activation)
  #:use-module (gnu system accounts)
  #:use-module (gnu system privilege)
  #:use-module (gnu build accounts)
  #:use-module (gnu build linux-boot)
  #:use-module (guix build utils)
  #:use-module ((guix build syscalls) #:select (with-file-lock))
  #:use-module (ice-9 ftw)
  #:use-module (ice-9 match)
  #:use-module (ice-9 vlist)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-26)
  #:export (activate-users+groups
            activate-subuids+subgids
            activate-user-home
            activate-etc
            activate-privileged-programs
            activate-special-files
            activate-modprobe
            activate-firmware
            activate-ptrace-attach
            activate-current-system
            mkdir-p/perms))

;;; Commentary:
;;;
;;; This module provides "activation" helpers.  Activation is the process that
;;; consists in setting up system-wide files and directories so that an
;;; 'operating-system' configuration becomes active.
;;;
;;; Code:

(define %skeleton-directory
  ;; Directory containing skeleton files for new accounts.
  ;; Note: keep the trailing '/' so that 'scandir' enters it.
  "/etc/skel/")

(define (dot-or-dot-dot? file)
  (member file '("." "..")))

(define (mkdir-p/perms directory owner bits)
  "Create directory DIRECTORY and all its ancestors.

Additionally, verify no component of DIRECTORY is a symbolic link,
without TOCTTOU races.  However, if OWNER differs from the the current
(process) uid/gid, there is a small window in which DIRECTORY is set to the
current (process) uid/gid instead of OWNER.  This is not expected to be
a problem in practice.

The permission bits and owner of DIRECTORY are set to BITS and OWNER.
Anything above DIRECTORY that already exists keeps
its old owner and bits.  For components that do not exist yet, the owner
and bits are set according to the default behaviour of 'mkdir'."
  (define absolute?
    (string-prefix? "/" directory))

  (define not-slash
    (char-set-complement (char-set #\/)))

  ;; By combining O_NOFOLLOW and O_DIRECTORY, this procedure automatically
  ;; verifies that no components are symlinks.
  (define open-flags (logior O_CLOEXEC ; don't pass the port on to subprocesses
                             O_NOFOLLOW ; don't follow symlinks
                             O_DIRECTORY)) ; reject anything not a directory

  (let loop ((components (string-tokenize directory not-slash))
             (root (open (if absolute? "/" ".") open-flags)))
    (match components
      ((head tail ...)
       (let retry ()
         ;; In the usual case, we expect HEAD to already exist.
         (match (catch 'system-error
                  (lambda ()
                    (openat root head open-flags))
                  (lambda args
                    (if (= ENOENT (system-error-errno args))
                        #false
                        (begin
                          (close-port root)
                          (apply throw args)))))
           ((? port? new-root)
            (close root)
            (loop tail new-root))
           (#false
            ;; If not, create it.
            (catch 'system-error
              (lambda _
                (if (null? tail)
                    (mkdirat root head bits)
                    (mkdirat root head)))
              (lambda args
                ;; Someone else created the directory.  Unexpected but fine.
                (unless (= EEXIST (system-error-errno args))
                  (close-port root)
                  (apply throw args))))
            (retry)))))
      (()
       (catch 'system-error
         (lambda ()
           (chown root (passwd:uid owner) (passwd:gid owner))
           (chmod root bits))
         (lambda args
           (close-port root)
           (apply throw args)))
       (close-port root)
       (values)))))

(define* (copy-account-skeletons home
                                 #:key
                                 (directory %skeleton-directory)
                                 uid gid)
  "Copy the account skeletons from DIRECTORY to HOME.  When UID is an integer,
make it the owner of all the files created except the home directory; likewise
for GID."
  (define (set-owner file)
    (when (or uid gid)
      (chown file (or uid -1) (or gid -1))))

  (let ((files (scandir directory (negate dot-or-dot-dot?)
                        string<?)))
    (mkdir-p home)
    (for-each (lambda (file)
                (let ((target (string-append home "/" file)))
                  (copy-recursively (string-append directory "/" file)
                                    target
                                    #:log (%make-void-port "w"))
                  (for-each set-owner
                            (find-files target (const #t)
                                        #:directories? #t))
                  (make-file-writable target)))
              files)))

(define* (make-skeletons-writable home
                                  #:optional (directory %skeleton-directory))
  "Make sure that the files that have been copied from DIRECTORY to HOME are
owner-writable in HOME."
  (let ((files (scandir directory (negate dot-or-dot-dot?)
                        string<?)))
    (for-each (lambda (file)
                (let ((target (string-append home "/" file)))
                  (when (file-exists? target)
                    (make-file-writable target))))
              files)))

(define (duplicates lst)
  "Return elements from LST present more than once in LST."
  (let loop ((lst lst)
             (seen vlist-null)
             (result '()))
    (match lst
      (()
       (reverse result))
      ((head . tail)
       (loop tail
             (vhash-cons head #t seen)
             (if (vhash-assoc head seen)
                 (cons head result)
                 result))))))

(define (activate-users+groups users groups)
  "Make sure USERS (a list