;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014-2022 Ludovic Courtès ;;; Copyright © 2016 Andreas Enge ;;; Copyright © 2017, 2018 Mark H Weaver ;;; ;;; 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 mapped-devices) #:use-module (guix gexp) #:use-module (guix records) #:use-module ((guix modules) #:hide (file-name->module-name)) #:use-module (guix i18n) #:use-module ((guix diagnostics) #:select (source-properties->location formatted-message &fix-hint &error-location)) #:use-module (guix deprecation) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu system uuid) #:autoload (gnu build file-systems) (find-partition-by-luks-uuid) #:autoload (gnu build linux-modules) (missing-modules) #:autoload (gnu packages cryptsetup) (cryptsetup-static) #:autoload (gnu packages linux) (mdadm-static lvm2-static) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (%mapped-device mapped-device mapped-device? mapped-device-source mapped-device-target mapped-device-targets mapped-device-type mapped-device-location mapped-device-kind mapped-device-kind? mapped-device-kind-open mapped-device-kind-close mapped-device-kind-check device-mapping-service-type device-mapping-service check-device-initrd-modules ;XXX: needs a better place luks-device-mapping raid-device-mapping lvm-device-mapping)) ;;; Commentary: ;;; ;;; This module supports "device mapping", a concept implemented by Linux's ;;; device-mapper. ;;; ;;; Code: (define-record-type* %mapped-device make-mapped-device mapped-device? (source mapped-device-source) ;string | list of strings (targets mapped-device-targets) ;list of strings (type mapped-device-type) ; (location mapped-device-location (default (current-source-location)) (innate))) (define-syntax mapped-device-compatibility-helper (syntax-rules (target) ((_ () (fields ...)) (%mapped-device fields ...)) ((_ ((target exp) rest ...) (others ...)) (%mapped-device others ... (targets (list exp)) rest ...)) ((_ (field rest ...) (others ...)) (mapped-device-compatibility-helper (rest ...) (others ... field))))) (define-syntax-rule (mapped-device fields ...) "Build an record, automatically converting 'target' field specifications to 'targets'." (mapped-device-compatibility-helper (fields ...) ())) (define-deprecated (mapped-device-target md) mapped-device-targets (car (mapped-device-targets md))) (define-record-type* mapped-device-kind make-mapped-device-kind mapped-device-kind? (open mapped-device-kind-open) ;source target -> gexp (close mapped-device-kind-close ;source target -> gexp (default (const #~(const #f)))) (check mapped-device-kind-check ;source -> Boolean (default (const #t)))) ;;; ;;; Device mapping as a Shepherd service. ;;; (define device-mapping-service-type (shepherd-service-type 'device-mapping (match-lambda (($ source targets ($ open close)) (shepherd-service (provision (list (symbol-append 'device-mapping- (string->symbol (string-join targets "-"))))) (requirement '(udev)) (documentation "Map a device node using Linux's device mapper.") (start #~(lambda () #$(open source targets))) (stop #~(lambda _ (not #$(close source targets)))) (respawn? #f)))) (description "Map a device node using Linux's device mapper."))) (define (device-mapping-service mapped-device) "Return a service that sets up @var{mapped-device}." (service device-mapping-service-type mapped-device)) ;;; ;;; Static checks. ;;; (define (check-device-initrd-modules device linux-modules location) "Raise an error if DEVICE needs modules beyond LINUX-MODULES to operate. DEVICE must be a \"/dev\" file name." (define missing ;; Attempt to determine missing modules. (catch 'system-error (lambda () (missing-modules device linux-modules)) ;; If we can't do that (e.g., EPERM), skip the whole thing. (const '()))) (unless (null? missing) ;; Note: What we suggest here is a list of module names (e.g., ;; "usb_storage"), not file names (e.g., "usb-storage.ko"). This is ;; OK because we have machinery that accepts both the hyphen and the ;; underscore version. (raise (make-compound-condition (formatted-message (G_ "you may need these modules \ in the initrd for ~a:~{ ~a~}") device missing) (condition (&fix-hint (hint (format #f (G_ "Try adding them to the @code{initrd-modules} field of your @code{operating-system} declaration, along these lin2015-10-21gnu-maintenance: Generalize, leading to (guix upstream)....* guix/gnu-maintenance.scm (<gnu-release>): Remove. (coalesce-releases): Move to upstream.scm. Rename to 'coalesce-sources'; adjust callers. (releases, latest-release): Return <upstream-source> objects instead of <gnu-release> objects. (latest-release*, non-emacs-gnu-package?): New procedures. (gnu-release-archive-types): Remove. (%gnu-updater): New variable. (package-update-path, download-tarball, package-update, update-package-source): Move to... * guix/upstream.scm: ... here. New file. * Makefile.am (MODULES): Add it. * po/guix/POTFILES.in: Replace gnu-maintenance.scm with upstream.scm. * guix/scripts/refresh.scm (%updaters): New variable. (update-package): Adjust to new 'package-update' interface. (guix-refresh): Adjust to new 'package-update-path'. Remove 'false-if-exception' around it. Ludovic Courtès 2015-10-20Add 'guix challenge'....* guix/scripts/challenge.scm, tests/challenge.scm: New files. * Makefile.am (MODULES): Add the former. (SCM_TESTS): Add the latter. * doc.am (SUBCOMMANDS): Add 'challenge'. * doc/guix.texi (Substitutes): Add xref to 'guix challenge'. (Invoking guix challenge): New node. * doc/contributing.texi (Submitting Patches): Add note about using 'guix challenge'. * po/guix/POTFILES.in: Add guix/scripts/challenge.scm. Ludovic Courtès 2015-10-10services: Introduce extensible services....This patch rewrites GuixSD services to make them extensible. * gnu-system.am (GNU_SYSTEM_MODULES): Add gnu/services/dbus.scm. * gnu/services.scm (<service>): Replace with new record type. (<service-extension>, <service-type>): New record types. (write-service-type, compute-boot-script, second-argument): New procedures. (%boot-service, boot-service-type): New variables. (file-union, directory-union, modprobe-wrapper, activation-service->script, activation-script, gexps->activation-gexp): New procedures. (activation-service-type, %activation-service): New variables. (etc-directory, files->etc-directory, etc-service): New procedures. (etc-service-type, setuid-program-service, firmware-service-type): New variables. (firmware->activation-gexp): New procedure. (&service-error, &missing-target-service-error, &ambiguous-target-service-error): New condition types. (service-back-edges, fold-services): New procedures. * gnu/services/avahi.scm (<avahi-configuration>): New record type. (configuration-file): Replace keyword parameters with a single 'config' parameter. (%avahi-accounts, %avahi-activation, avahi-service-type): New variables. (avahi-dmd-service): New procedure. (avahi-service): Rewrite using 'service' and 'avahi-configuration'. * gnu/services/base.scm (%root-file-system-dmd-service, root-file-system-service-type): New variables. (root-file-system-service): Use them. (file-system->dmd-service-name): New procedure. (file-system-service-type): New variable. (file-system-service): Use it. Replace keyword parameters with a single 'file-system' object. (user-unmount-service-type): New variable. (user-unmount-service): Use it. (user-processes-service-type): New variable. (user-processes-service): Use it. (host-name-service-type): New variable. (host-name-service): Use it. (console-keymap-service-type): New variable. (console-keymap-service): Use it. (console-font-service-type): New variable. (console-font-service): Use it. (mingetty-pam-service, mingetty-dmd-service): New procedures. (mingetty-service-type): New variable. (mingetty-service): Use it. (nscd-dmd-service): New procedure. (nscd-activation, nscd-service-type): New variables. (nscd-service): Use the latter. (syslog-service-type): New variable. (syslog-service): Use it. (<guix-configuration>): New record type. (%default-guix-configuration): New variable. (guix-dmd-service, guix-accounts, guix-activation): New procedures. (guix-service-type): New variable. (guix-service): Replace list of keyword parameters with a single 'config' parameter. Rewrite using 'service'. (<udev-configuration>): New record type. (udev-dmd-service): New procedure. (udev-service-type): New variable. (udev-service): Use it. (device-mapping-service-type): New variable. (device-mapping-service): Use it. (swap-service-type): New variable. (swap-service): Use it. * gnu/services/databases.scm (<postgresql-configuration>): New record type. (%postgresql-accounts, postgresql-activation): New variables. (postgresql-dmd-service): New procedure. (postgresql-service): Rewrite using 'service' and 'postgresql-configuration'. * gnu/services/dbus.scm: New file. * gnu/services/desktop.scm (dbus-configuration-directory, dbus-service): Remove. (wrapped-dbus-service): New procedure. (<upower-configuration>): New record type. (upower-configuration-file): Replace keyword parameters with single <upower-configuration> parameter. (%upower-accounts, %upower-activation): New variables. (upower-dbus-service, upower-dmd-service): New procedures. (upower-service-type): New variable. (upower-service): Rewrite using 'service' and 'upower-configuration'. (%colord-activation, %colord-accounts): New variables. (colord-dmd-service): New procedure. (colord-service-type): New variable. (colord-service): Rewrite using 'service'. (<geoclue-configuration>): New record type. (geoclue-configuration-file): Replace keyword parameters with a single 'config' parameter. (geoclue-dbus-service, geoclue-dmd-service): New procedures. (%geoclue-accounts, geoclue-service-type): New variables. (geoclue-service): Rewrite using 'service' and 'geoclue-configuration'. (%polkit-accounts, %polkit-pam-services, polkit-service-type): New variables. (polkit-dmd-service): New procedure. (polkit-service): Rewrite using 'service'. (<elogind-configuration>)[elogind]: New field. (elogind-dmd-service): New procedure. (elogind-service-type): New variable. (elogind-service): Rewrite using 'service'. (%desktop-services): Remove argument to 'dbus-service'. Remove 'map' over %BASE-SERVICES. * gnu/services/dmd.scm (dmd-boot-gexp): New procedure. (dmd-root-service-type, %dmd-root-service): New variables. (dmd-ser