You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

341 lines
13 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
  3. ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
  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. (define-module (gnu build activation)
  20. #:use-module (gnu system accounts)
  21. #:use-module (gnu build accounts)
  22. #:use-module (gnu build linux-boot)
  23. #:use-module (guix build utils)
  24. #:use-module ((guix build syscalls) #:select (with-file-lock))
  25. #:use-module (ice-9 ftw)
  26. #:use-module (ice-9 match)
  27. #:use-module (ice-9 vlist)
  28. #:use-module (srfi srfi-1)
  29. #:use-module (srfi srfi-11)
  30. #:use-module (srfi srfi-26)
  31. #:export (activate-users+groups
  32. activate-user-home
  33. activate-etc
  34. activate-setuid-programs
  35. activate-special-files
  36. activate-modprobe
  37. activate-firmware
  38. activate-ptrace-attach
  39. activate-current-system))
  40. ;;; Commentary:
  41. ;;;
  42. ;;; This module provides "activation" helpers. Activation is the process that
  43. ;;; consists in setting up system-wide files and directories so that an
  44. ;;; 'operating-system' configuration becomes active.
  45. ;;;
  46. ;;; Code:
  47. (define %skeleton-directory
  48. ;; Directory containing skeleton files for new accounts.
  49. ;; Note: keep the trailing '/' so that 'scandir' enters it.
  50. "/etc/skel/")
  51. (define (dot-or-dot-dot? file)
  52. (member file '("." "..")))
  53. (define* (copy-account-skeletons home
  54. #:key
  55. (directory %skeleton-directory)
  56. uid gid)
  57. "Copy the account skeletons from DIRECTORY to HOME. When UID is an integer,
  58. make it the owner of all the files created; likewise for GID."
  59. (define (set-owner file)
  60. (when (or uid gid)
  61. (chown file (or uid -1) (or gid -1))))
  62. (let ((files (scandir directory (negate dot-or-dot-dot?)
  63. string<?)))
  64. (mkdir-p home)
  65. (set-owner home)
  66. (for-each (lambda (file)
  67. (let ((target (string-append home "/" file)))
  68. (copy-recursively (string-append directory "/" file)
  69. target
  70. #:log (%make-void-port "w"))
  71. (for-each set-owner
  72. (find-files target (const #t)
  73. #:directories? #t))
  74. (make-file-writable target)))
  75. files)))
  76. (define* (make-skeletons-writable home
  77. #:optional (directory %skeleton-directory))
  78. "Make sure that the files that have been copied from DIRECTORY to HOME are
  79. owner-writable in HOME."
  80. (let ((files (scandir directory (negate dot-or-dot-dot?)
  81. string<?)))
  82. (for-each (lambda (file)
  83. (let ((target (string-append home "/" file)))
  84. (when (file-exists? target)
  85. (make-file-writable target))))
  86. files)))
  87. (define (duplicates lst)
  88. "Return elements from LST present more than once in LST."
  89. (let loop ((lst lst)
  90. (seen vlist-null)
  91. (result '()))
  92. (match lst
  93. (()
  94. (reverse result))
  95. ((head . tail)
  96. (loop tail
  97. (vhash-cons head #t seen)
  98. (if (vhash-assoc head seen)
  99. (cons head result)
  100. result))))))
  101. (define (activate-users+groups users groups)
  102. "Make sure USERS (a list of user account records) and GROUPS (a list of user
  103. group records) are all available."
  104. (define (make-home-directory user)
  105. (let ((home (user-account-home-directory user))
  106. (pwd (getpwnam (user-account-name user))))
  107. (mkdir-p home)
  108. ;; Always set ownership and permissions for home directories of system
  109. ;; accounts. If a service needs looser permissions on its home
  110. ;; directories, it can always chmod it in an activation snippet.
  111. (chown home (passwd:uid pwd) (passwd:gid pwd))
  112. (chmod home #o700)))
  113. (define system-accounts
  114. (filter (lambda (user)
  115. (and (user-account-system? user)
  116. (user-account-create-home-directory? user)))
  117. users))
  118. ;; Allow home directories to be created under /var/lib.
  119. (mkdir-p "/var/lib")
  120. ;; Take same lock as libc's 'lckpwdf' (but without a timeout) while we read
  121. ;; and write the databases. This ensures there's no race condition with
  122. ;; other tools that might be accessing it at the same time.
  123. (with-file-lock %password-lock-file
  124. (let-values (((groups passwd shadow)
  125. (user+group-databases users groups)))
  126. (write-group groups)
  127. (write-passwd passwd)
  128. (write-shadow shadow)))
  129. ;; Home directories of non-system accounts are created by
  130. ;; 'activate-user-home'.
  131. (for-each make-home-directory system-accounts)
  132. ;; Turn shared home directories, such as /var/empty, into root-owned,
  133. ;; read-only places.
  134. (for-each (lambda (directory)
  135. (chown directory 0 0)
  136. (chmod directory #o555))
  137. (duplicates (map user-account-home-directory system-accounts))))
  138. (define (activate-user-home users)
  139. "Create and populate the home directory of USERS, a list of tuples, unless
  140. they already exist."
  141. (define ensure-user-home
  142. (lambda (user)
  143. (let ((name (user-account-name user))
  144. (home (user-account-home-directory user))
  145. (create-home? (user-account-create-home-directory? user))
  146. (system? (user-account-system? user)))
  147. ;; The home directories of system accounts are created during
  148. ;; activation, not here.
  149. (unless (or (not home) (not create-home?) system?
  150. (directory-exists? home))
  151. (let* ((pw (getpwnam name))
  152. (uid (passwd:uid pw))
  153. (gid (passwd:gid pw)))
  154. (mkdir-p home)
  155. (chown home uid gid)
  156. (chmod home #o700)
  157. (copy-account-skeletons home
  158. #:uid uid #:gid gid))))))
  159. (for-each ensure-user-home users))
  160. (define (activate-etc etc)
  161. "Install ETC, a directory in the store, as the source of static files for
  162. /etc."
  163. ;; /etc is a mixture of static and dynamic settings. Here is where we
  164. ;; initialize it from the static part.
  165. (define (rm-f file)
  166. (false-if-exception (delete-file file)))
  167. (format #t "populating /etc from ~a...~%" etc)
  168. (mkdir-p "/etc")
  169. ;; Create the /etc/ssl -> /run/current-system/profile/etc/ssl symlink. This
  170. ;; symlink, to a target outside of the store, probably doesn't belong in the
  171. ;; static 'etc' store directory. However, if it were to be put there,
  172. ;; beware that if /run/current-system/profile/etc/ssl doesn't exist at the
  173. ;; time of activation (e.g. when installing a fresh system), the call to
  174. ;; 'file-is-directory?' below will fail because it uses 'stat', not 'lstat'.
  175. (rm-f "/etc/ssl")
  176. (symlink "/run/current-system/profile/etc/ssl" "/etc/ssl")
  177. (rm-f "/etc/static")
  178. (symlink etc "/etc/static")
  179. (for-each (lambda (file)
  180. (let ((target (string-append "/etc/" file))
  181. (source (string-append "/etc/static/" file)))
  182. (rm-f target)
  183. ;; Things such as /etc/sudoers must be regular files, not
  184. ;; symlinks; furthermore, they could be modified behind our
  185. ;; back---e.g., with 'visudo'. Thus, make a copy instead of
  186. ;; symlinking them.
  187. (if (file-is-directory? source)
  188. (symlink source target)
  189. (copy-file source target))
  190. ;; XXX: Dirty hack to meet sudo's expectations.
  191. (when (string=? (basename target) "sudoers")
  192. (chmod target #o440))))
  193. (scandir etc (negate dot-or-dot-dot?)
  194. ;; The default is 'string-locale<?', but we don't have
  195. ;; it when run from the initrd's statically-linked
  196. ;; Guile.
  197. string<?)))
  198. (define %setuid-directory
  199. ;; Place where setuid programs are stored.
  200. "/run/setuid-programs")
  201. (define (activate-setuid-programs programs)
  202. "Turn PROGRAMS, a list of file names, into setuid programs stored under
  203. %SETUID-DIRECTORY."
  204. (define (make-setuid-program prog)
  205. (let ((target (string-append %setuid-directory
  206. "/" (basename prog))))
  207. (copy-file prog target)
  208. (chown target 0 0)
  209. (chmod target #o6555)))
  210. (format #t "setting up setuid programs in '~a'...~%"
  211. %setuid-directory)
  212. (if (file-exists? %setuid-directory)
  213. (for-each (compose delete-file
  214. (cut string-append %setuid-directory "/" <>))
  215. (scandir %setuid-directory
  216. (lambda (file)
  217. (not (member file '("." ".."))))
  218. string<?))
  219. (mkdir-p %setuid-directory))
  220. (for-each (lambda (program)
  221. (catch 'system-error
  222. (lambda ()
  223. (make-setuid-program program))
  224. (lambda args
  225. ;; If we fail to create a setuid program, better keep going
  226. ;; so that we don't leave %SETUID-DIRECTORY empty or
  227. ;; half-populated. This can happen if PROGRAMS contains
  228. ;; incorrect file names: <https://bugs.gnu.org/38800>.
  229. (format (current-error-port)
  230. "warning: failed to make '~a' setuid-root: ~a~%"
  231. program (strerror (system-error-errno args))))))
  232. programs))
  233. (define (activate-special-files special-files)
  234. "Install the files listed in SPECIAL-FILES. Each element of SPECIAL-FILES
  235. is a pair where the first element is the name of the special file and the
  236. second element is the name it should appear at, such as:
  237. ((\"/bin/sh\" \"/gnu/store/…-bash/bin/sh\")
  238. (\"/usr/bin/env\" \"/gnu/store/…-coreutils/bin/env\"))
  239. "
  240. (define install-special-file
  241. (match-lambda
  242. ((target file)
  243. (let ((pivot (string-append target ".new")))
  244. (mkdir-p (dirname target))
  245. (symlink file pivot)
  246. (rename-file pivot target)))))
  247. (for-each install-special-file special-files))
  248. (define (activate-modprobe modprobe)
  249. "Tell the kernel to use MODPROBE to load modules."
  250. ;; If the kernel was built without loadable module support, this file is
  251. ;; unavailable, so check for its existence first.
  252. (when (file-exists? "/proc/sys/kernel/modprobe")
  253. (call-with-output-file "/proc/sys/kernel/modprobe"
  254. (lambda (port)
  255. (display modprobe port)))))
  256. (define (activate-firmware directory)
  257. "Tell the kernel to look for device firmware under DIRECTORY. This
  258. mechanism bypasses udev: it allows Linux to handle firmware loading directly
  259. by itself, without having to resort to a \"user helper\"."
  260. (call-with-output-file "/sys/module/firmware_class/parameters/path"
  261. (lambda (port)
  262. (display directory port))))
  263. (define (activate-ptrace-attach)
  264. "Allow users to PTRACE_ATTACH their own processes.
  265. This works around a regression introduced in the default \"security\" policy
  266. found in Linux 3.4 onward that prevents users from attaching to their own
  267. processes--see Yama.txt in the Linux source tree for the rationale. This
  268. sounds like an unacceptable restriction for little or no security
  269. improvement."
  270. (let ((file "/proc/sys/kernel/yama/ptrace_scope"))
  271. (when (file-exists? file)
  272. (call-with-output-file file
  273. (lambda (port)
  274. (display 0 port))))))
  275. (define %current-system
  276. ;; The system that is current (a symlink.) This is not necessarily the same
  277. ;; as the system we booted (aka. /run/booted-system) because we can re-build
  278. ;; a new system configuration and activate it, without rebooting.
  279. "/run/current-system")
  280. (define (boot-time-system)
  281. "Return the '--system' argument passed on the kernel command line."
  282. (find-long-option "--system" (if (string-contains %host-type "linux-gnu")
  283. (linux-command-line)
  284. (command-line))))
  285. (define* (activate-current-system
  286. #:optional (system (or (getenv "GUIX_NEW_SYSTEM")
  287. (boot-time-system))))
  288. "Atomically make SYSTEM the current system."
  289. ;; The 'GUIX_NEW_SYSTEM' environment variable is used as a way for 'guix
  290. ;; system reconfigure' to pass the file name of the new system.
  291. (format #t "making '~a' the current system...~%" system)
  292. ;; Atomically make SYSTEM current.
  293. (let ((new (string-append %current-system ".new")))
  294. (symlink system new)
  295. (rename-file new %current-system)))
  296. ;;; activation.scm ends here