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.

445 lines
18 KiB

maint: Switch to Guile-JSON 3.x. Guile-JSON 3.x is incompatible with Guile-JSON 1.x, which we relied on until now: it maps JSON dictionaries to alists (instead of hash tables), and JSON arrays to vectors (instead of lists). This commit is about adjusting all the existing code to this new mapping. * m4/guix.m4 (GUIX_CHECK_GUILE_JSON): New macro. * configure.ac: Use it. * doc/guix.texi (Requirements): Mention the Guile-JSON version. * guix/git-download.scm (git-fetch)[guile-json]: Use GUILE-JSON-3. * guix/import/cpan.scm (string->license): Expect vectors instead of lists. (module->dist-name): Use 'json-fetch' instead of 'json-fetch-alist'. (cpan-fetch): Likewise. * guix/import/crate.scm (crate-fetch): Likewise, and call 'vector->list' for DEPS. * guix/import/gem.scm (rubygems-fetch): Likewise. * guix/import/json.scm (json-fetch-alist): Remove. * guix/import/pypi.scm (pypi-fetch): Use 'json-fetch' instead of 'json-fetch-alist'. (latest-source-release, latest-wheel-release): Call 'vector->list' on RELEASES. * guix/import/stackage.scm (stackage-lts-info-fetch): Use 'json-fetch' instead of 'json-fetch-alist'. (lts-package-version): Use 'vector->list'. * guix/import/utils.scm (hash-table->alist): Remove. (alist->package): Pass 'vector->list' on the inputs fields, and default to the empty vector. * guix/scripts/import/json.scm (guix-import-json): Remove call to 'hash-table->alist'. * guix/swh.scm (define-json-reader): Expect pair? or null? instead of hash-table?. [extract-field]: Use 'assoc-ref' instead of 'hash-ref'. (json->branches): Use 'map' instead of 'hash-map->list'. (json->checksums): Likewise. (json->directory-entries, origin-visits): Call 'vector->list' on the result of 'json->scm'. * tests/import-utils.scm ("alist->package with dependencies"): New test. * gnu/installer.scm (build-compiled-file)[builder]: Use GUILE-JSON-3. * gnu/installer.scm (installer-program)[installer-builder]: Likewise. * gnu/installer/locale.scm (iso639->iso639-languages): Use 'assoc-ref' instead of 'hash-ref', and pass vectors through 'vector->list'. (iso3166->iso3166-territories): Likewise. * gnu/system/vm.scm (system-docker-image)[build]: Use GUILE-JSON-3. * guix/docker.scm (manifest, config): Adjust for Guile-JSON 3. * guix/scripts/pack.scm (docker-image)[build]: Use GUILE-JSON-3. * guix/import/github.scm (fetch-releases-or-tags): Update docstring. (latest-released-version): Use 'assoc-ref' instead of 'hash-ref'. Pass the result of 'fetch-releases-or-tags' to 'vector->list'. * guix/import/launchpad.scm (latest-released-version): Likewise.
2 years ago
maint: Switch to Guile-JSON 3.x. Guile-JSON 3.x is incompatible with Guile-JSON 1.x, which we relied on until now: it maps JSON dictionaries to alists (instead of hash tables), and JSON arrays to vectors (instead of lists). This commit is about adjusting all the existing code to this new mapping. * m4/guix.m4 (GUIX_CHECK_GUILE_JSON): New macro. * configure.ac: Use it. * doc/guix.texi (Requirements): Mention the Guile-JSON version. * guix/git-download.scm (git-fetch)[guile-json]: Use GUILE-JSON-3. * guix/import/cpan.scm (string->license): Expect vectors instead of lists. (module->dist-name): Use 'json-fetch' instead of 'json-fetch-alist'. (cpan-fetch): Likewise. * guix/import/crate.scm (crate-fetch): Likewise, and call 'vector->list' for DEPS. * guix/import/gem.scm (rubygems-fetch): Likewise. * guix/import/json.scm (json-fetch-alist): Remove. * guix/import/pypi.scm (pypi-fetch): Use 'json-fetch' instead of 'json-fetch-alist'. (latest-source-release, latest-wheel-release): Call 'vector->list' on RELEASES. * guix/import/stackage.scm (stackage-lts-info-fetch): Use 'json-fetch' instead of 'json-fetch-alist'. (lts-package-version): Use 'vector->list'. * guix/import/utils.scm (hash-table->alist): Remove. (alist->package): Pass 'vector->list' on the inputs fields, and default to the empty vector. * guix/scripts/import/json.scm (guix-import-json): Remove call to 'hash-table->alist'. * guix/swh.scm (define-json-reader): Expect pair? or null? instead of hash-table?. [extract-field]: Use 'assoc-ref' instead of 'hash-ref'. (json->branches): Use 'map' instead of 'hash-map->list'. (json->checksums): Likewise. (json->directory-entries, origin-visits): Call 'vector->list' on the result of 'json->scm'. * tests/import-utils.scm ("alist->package with dependencies"): New test. * gnu/installer.scm (build-compiled-file)[builder]: Use GUILE-JSON-3. * gnu/installer.scm (installer-program)[installer-builder]: Likewise. * gnu/installer/locale.scm (iso639->iso639-languages): Use 'assoc-ref' instead of 'hash-ref', and pass vectors through 'vector->list'. (iso3166->iso3166-territories): Likewise. * gnu/system/vm.scm (system-docker-image)[build]: Use GUILE-JSON-3. * guix/docker.scm (manifest, config): Adjust for Guile-JSON 3. * guix/scripts/pack.scm (docker-image)[build]: Use GUILE-JSON-3. * guix/import/github.scm (fetch-releases-or-tags): Update docstring. (latest-released-version): Use 'assoc-ref' instead of 'hash-ref'. Pass the result of 'fetch-releases-or-tags' to 'vector->list'. * guix/import/launchpad.scm (latest-released-version): Likewise.
2 years ago
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
  3. ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
  4. ;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
  5. ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
  6. ;;;
  7. ;;; This file is part of GNU Guix.
  8. ;;;
  9. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10. ;;; under the terms of the GNU General Public License as published by
  11. ;;; the Free Software Foundation; either version 3 of the License, or (at
  12. ;;; your option) any later version.
  13. ;;;
  14. ;;; GNU Guix is distributed in the hope that it will be useful, but
  15. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. ;;; GNU General Public License for more details.
  18. ;;;
  19. ;;; You should have received a copy of the GNU General Public License
  20. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  21. (define-module (gnu installer)
  22. #:use-module (guix discovery)
  23. #:use-module (guix packages)
  24. #:use-module (guix gexp)
  25. #:use-module (guix modules)
  26. #:use-module (guix utils)
  27. #:use-module (guix ui)
  28. #:use-module ((guix self) #:select (make-config.scm))
  29. #:use-module (guix packages)
  30. #:use-module (guix git-download)
  31. #:use-module (gnu installer utils)
  32. #:use-module (gnu packages admin)
  33. #:use-module (gnu packages base)
  34. #:use-module (gnu packages bash)
  35. #:use-module (gnu packages connman)
  36. #:use-module (gnu packages cryptsetup)
  37. #:use-module (gnu packages disk)
  38. #:use-module (gnu packages file-systems)
  39. #:use-module (gnu packages guile)
  40. #:use-module (gnu packages guile-xyz)
  41. #:autoload (gnu packages gnupg) (guile-gcrypt)
  42. #:use-module (gnu packages iso-codes)
  43. #:use-module (gnu packages linux)
  44. #:use-module (gnu packages ncurses)
  45. #:use-module (gnu packages package-management)
  46. #:use-module (gnu packages xorg)
  47. #:use-module (gnu system locale)
  48. #:use-module (ice-9 match)
  49. #:use-module (srfi srfi-1)
  50. #:export (installer-program))
  51. (define module-to-import?
  52. ;; Return true for modules that should be imported. For (gnu system …) and
  53. ;; (gnu packages …) modules, we simply add the whole 'guix' package via
  54. ;; 'with-extensions' (to avoid having to rebuild it all), which is why these
  55. ;; modules are excluded here.
  56. (match-lambda
  57. (('guix 'config) #f)
  58. (('gnu 'installer _ ...) #t)
  59. (('gnu 'build _ ...) #t)
  60. (('guix 'build _ ...) #t)
  61. (_ #f)))
  62. (define not-config?
  63. ;; Select (guix …) and (gnu …) modules, except (guix config).
  64. (match-lambda
  65. (('guix 'config) #f)
  66. (('guix _ ...) #t)
  67. (('gnu _ ...) #t)
  68. (_ #f)))
  69. (define* (build-compiled-file name locale-builder)
  70. "Return a file-like object that evalutes the gexp LOCALE-BUILDER and store
  71. its result in the scheme file NAME. The derivation will also build a compiled
  72. version of this file."
  73. (define set-utf8-locale
  74. #~(begin
  75. (setenv "LOCPATH"
  76. #$(file-append glibc-utf8-locales "/lib/locale/"
  77. (version-major+minor
  78. (package-version glibc-utf8-locales))))
  79. (setlocale LC_ALL "en_US.utf8")))
  80. (define builder
  81. (with-extensions (list guile-json-3)
  82. (with-imported-modules `(,@(source-module-closure
  83. '((gnu installer locale))
  84. #:select? not-config?)
  85. ((guix config) => ,(make-config.scm)))
  86. #~(begin
  87. (use-modules (gnu installer locale))
  88. ;; The locale files contain non-ASCII characters.
  89. #$set-utf8-locale
  90. (mkdir #$output)
  91. (let ((locale-file
  92. (string-append #$output "/" #$name ".scm"))
  93. (locale-compiled-file
  94. (string-append #$output "/" #$name ".go")))
  95. (call-with-output-file locale-file
  96. (lambda (port)
  97. (write #$locale-builder port)))
  98. (compile-file locale-file
  99. #:output-file locale-compiled-file))))))
  100. (computed-file name builder))
  101. (define apply-locale
  102. ;; Install the specified locale.
  103. (with-imported-modules (source-module-closure '((gnu services herd)))
  104. #~(lambda (locale)
  105. (false-if-exception
  106. (setlocale LC_ALL locale))
  107. ;; Restart the documentation viewer so it displays the manual in
  108. ;; language that corresponds to LOCALE. Make sure that nothing is
  109. ;; printed on the console.
  110. (parameterize ((shepherd-message-port
  111. (%make-void-port "w")))
  112. (stop-service 'term-tty2)
  113. (start-service 'term-tty2 (list locale))))))
  114. (define* (compute-locale-step #:key
  115. locales-name
  116. iso639-languages-name
  117. iso3166-territories-name)
  118. "Return a gexp that run the locale-page of INSTALLER, and install the
  119. selected locale. The list of locales, languages and territories passed to
  120. locale-page are computed in derivations named respectively LOCALES-NAME,
  121. ISO639-LANGUAGES-NAME and ISO3166-TERRITORIES-NAME. Those lists are compiled,
  122. so that when the installer is run, all the lengthy operations have already
  123. been performed at build time."
  124. (define (compiled-file-loader file name)
  125. #~(load-compiled
  126. (string-append #$file "/" #$name ".go")))
  127. (let* ((supported-locales #~(supported-locales->locales
  128. #+(glibc-supported-locales)))
  129. (iso-codes #~(string-append #$iso-codes "/share/iso-codes/json/"))
  130. (iso639-3 #~(string-append #$iso-codes "iso_639-3.json"))
  131. (iso639-5 #~(string-append #$iso-codes "iso_639-5.json"))
  132. (iso3166 #~(string-append #$iso-codes "iso_3166-1.json"))
  133. (locales-file (build-compiled-file
  134. locales-name
  135. #~`(quote ,#$supported-locales)))
  136. (iso639-file (build-compiled-file
  137. iso639-languages-name
  138. #~`(quote ,(iso639->iso639-languages
  139. #$supported-locales
  140. #$iso639-3 #$iso639-5))))
  141. (iso3166-file (build-compiled-file
  142. iso3166-territories-name
  143. #~`(quote ,(iso3166->iso3166-territories #$iso3166))))
  144. (locales-loader (compiled-file-loader locales-file
  145. locales-name))
  146. (iso639-loader (compiled-file-loader iso639-file
  147. iso639-languages-name))
  148. (iso3166-loader (compiled-file-loader iso3166-file
  149. iso3166-territories-name)))
  150. #~(lambda (current-installer)
  151. (let ((result
  152. ((installer-locale-page current-installer)
  153. #:supported-locales #$locales-loader
  154. #:iso639-languages #$iso639-loader
  155. #:iso3166-territories #$iso3166-loader)))
  156. (#$apply-locale result)
  157. result))))
  158. (define apply-keymap
  159. ;; Apply the specified keymap. Use the default keyboard model.
  160. #~(match-lambda
  161. ((layout variant options)
  162. (kmscon-update-keymap (default-keyboard-model)
  163. layout variant options))))
  164. (define* (compute-keymap-step context)
  165. "Return a gexp that runs the keymap-page of INSTALLER and install the
  166. selected keymap."
  167. #~(lambda (current-installer)
  168. (let ((result
  169. (call-with-values
  170. (lambda ()
  171. (xkb-rules->models+layouts
  172. (string-append #$xkeyboard-config
  173. "/share/X11/xkb/rules/base.xml")))
  174. (lambda (models layouts)
  175. ((installer-keymap-page current-installer)
  176. layouts '#$context)))))
  177. (#$apply-keymap result)
  178. result)))
  179. (define (installer-steps)
  180. (let ((locale-step (compute-locale-step
  181. #:locales-name "locales"
  182. #:iso639-languages-name "iso639-languages"
  183. #:iso3166-territories-name "iso3166-territories"))
  184. (timezone-data #~(string-append #$tzdata
  185. "/share/zoneinfo/zone.tab")))
  186. #~(lambda (current-installer)
  187. ((installer-parameters-menu current-installer)
  188. (lambda ()
  189. ((installer-parameters-page current-installer)
  190. (lambda _
  191. (#$(compute-keymap-step 'param)
  192. current-installer)))))
  193. (list
  194. ;; Ask the user to choose a locale among those supported by
  195. ;; the glibc. Install the selected locale right away, so that
  196. ;; the user may benefit from any available translation for the
  197. ;; installer messages.
  198. (installer-step
  199. (id 'locale)
  200. (description (G_ "Locale"))
  201. (compute (lambda _
  202. (#$locale-step current-installer)))
  203. (configuration-formatter locale->configuration))
  204. ;; Welcome the user and ask them to choose between manual
  205. ;; installation and graphical install.
  206. (installer-step
  207. (id 'welcome)
  208. (compute (lambda _
  209. ((installer-welcome-page current-installer)
  210. #$(local-file "installer/aux-files/logo.txt")))))
  211. ;; Ask the user to select a timezone under glibc format.
  212. (installer-step
  213. (id 'timezone)
  214. (description (G_ "Timezone"))
  215. (compute (lambda _
  216. ((installer-timezone-page current-installer)
  217. #$timezone-data)))
  218. (configuration-formatter posix-tz->configuration))
  219. ;; The installer runs in a kmscon virtual terminal where loadkeys
  220. ;; won't work. kmscon uses libxkbcommon as a backend for keyboard
  221. ;; input. It is possible to update kmscon current keymap by sending
  222. ;; it a keyboard model, layout, variant and options, in a somehow
  223. ;; similar way as what is done with setxkbmap utility.
  224. ;;
  225. ;; So ask for a keyboard model, layout and variant to update the
  226. ;; current kmscon keymap. For non-Latin layouts, we add an
  227. ;; appropriate second layout and toggle via Alt+Shift.
  228. (installer-step
  229. (id 'keymap)
  230. (description (G_ "Keyboard mapping selection"))
  231. (compute (lambda _
  232. (#$(compute-keymap-step 'default)
  233. current-installer)))
  234. (configuration-formatter keyboard-layout->configuration))
  235. ;; Ask the user to input a hostname for the system.
  236. (installer-step
  237. (id 'hostname)
  238. (description (G_ "Hostname"))
  239. (compute (lambda _
  240. ((installer-hostname-page current-installer))))
  241. (configuration-formatter hostname->configuration))
  242. ;; Provide an interface above connmanctl, so that the user can select
  243. ;; a network susceptible to acces Internet.
  244. (installer-step
  245. (id 'network)
  246. (description (G_ "Network selection"))
  247. (compute (lambda _
  248. ((installer-network-page current-installer)))))
  249. ;; Prompt for users (name, group and home directory).
  250. (installer-step
  251. (id 'user)
  252. (description (G_ "User creation"))
  253. (compute (lambda _
  254. ((installer-user-page current-installer))))
  255. (configuration-formatter users->configuration))
  256. ;; Ask the user to choose one or many desktop environment(s).
  257. (installer-step
  258. (id 'services)
  259. (description (G_ "Services"))
  260. (compute (lambda _
  261. ((installer-services-page current-installer))))
  262. (configuration-formatter system-services->configuration))
  263. ;; Run a partitioning tool allowing the user to modify
  264. ;; partition tables, partitions and their mount points.
  265. ;; Do this last so the user has something to boot if any
  266. ;; of the previous steps didn't go as expected.
  267. (installer-step
  268. (id 'partition)
  269. (description (G_ "Partitioning"))
  270. (compute (lambda _
  271. ((installer-partition-page current-installer))))
  272. (configuration-formatter user-partitions->configuration))
  273. (installer-step
  274. (id 'final)
  275. (description (G_ "Configuration file"))
  276. (compute
  277. (lambda (result prev-steps)
  278. ((installer-final-page current-installer)
  279. result prev-steps))))))))
  280. (define (installer-program)
  281. "Return a file-like object that runs the given INSTALLER."
  282. (define init-gettext
  283. ;; Initialize gettext support, so that installer messages can be
  284. ;; translated.
  285. #~(begin
  286. (bindtextdomain "guix" (string-append #$guix "/share/locale"))
  287. (textdomain "guix")))
  288. (define set-installer-path
  289. ;; Add the specified binary to PATH for later use by the installer.
  290. #~(let* ((inputs
  291. '#$(list bash ;start subshells
  292. connman ;call connmanctl
  293. cryptsetup
  294. dosfstools ;mkfs.fat
  295. e2fsprogs ;mkfs.ext4
  296. btrfs-progs
  297. jfsutils ;jfs_mkfs
  298. kbd ;chvt
  299. guix ;guix system init call
  300. util-linux ;mkwap
  301. shadow
  302. coreutils)))
  303. (with-output-to-port (%make-void-port "w")
  304. (lambda ()
  305. (set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
  306. (define steps (installer-steps))
  307. (define modules
  308. (scheme-modules*
  309. (string-append (current-source-directory) "/..")
  310. "gnu/installer"))
  311. (define installer-builder
  312. ;; Note: Include GUIX as an extension to get all the (gnu system …), (gnu
  313. ;; packages …), etc. modules.
  314. (with-extensions (list guile-gcrypt guile-newt
  315. guile-parted guile-bytestructures
  316. guile-json-3 guile-git guix)
  317. (with-imported-modules `(,@(source-module-closure
  318. `(,@modules
  319. (gnu services herd)
  320. (guix build utils))
  321. #:select? module-to-import?)
  322. ((guix config) => ,(make-config.scm)))
  323. #~(begin
  324. (use-modules (gnu installer record)
  325. (gnu installer keymap)
  326. (gnu installer steps)
  327. (gnu installer final)
  328. (gnu installer hostname)
  329. (gnu installer locale)
  330. (gnu installer parted)
  331. (gnu installer services)
  332. (gnu installer timezone)
  333. (gnu installer user)
  334. (gnu installer utils)
  335. (gnu installer newt)
  336. ((gnu installer newt keymap)
  337. #:select (keyboard-layout->configuration))
  338. (gnu services herd)
  339. (guix i18n)
  340. (guix build utils)
  341. ((system repl debug)
  342. #:select (terminal-width))
  343. (ice-9 match))
  344. ;; Initialize gettext support so that installers can use
  345. ;; (guix i18n) module.
  346. #$init-gettext
  347. ;; Add some binaries used by the installers to PATH.
  348. #$set-installer-path
  349. ;; Arrange for language and territory name translations to be
  350. ;; available. We need them at run time, not just compile time,
  351. ;; because some territories have several corresponding languages
  352. ;; (e.g., "French" is always displayed as "français", but
  353. ;; "Belgium" could be translated to Dutch, French, or German.)
  354. (bindtextdomain "iso_639-3" ;languages
  355. #+(file-append iso-codes "/share/locale"))
  356. (bindtextdomain "iso_3166-1" ;territories
  357. #+(file-append iso-codes "/share/locale"))
  358. ;; Likewise for XKB keyboard layout names.
  359. (bindtextdomain "xkeyboard-config"
  360. #+(file-append xkeyboard-config "/share/locale"))
  361. ;; Initialize 'terminal-width' in (system repl debug)
  362. ;; to a large-enough value to make backtrace more
  363. ;; verbose.
  364. (terminal-width 200)
  365. (let* ((current-installer newt-installer)
  366. (steps (#$steps current-installer)))
  367. ((installer-init current-installer))
  368. (catch #t
  369. (lambda ()
  370. (define results
  371. (run-installer-steps
  372. #:rewind-strategy 'menu
  373. #:menu-proc (installer-menu-page current-installer)
  374. #:steps steps))
  375. (match (result-step results 'final)
  376. ('success
  377. ;; We did it! Let's reboot!
  378. (sync)
  379. (stop-service 'root))
  380. (_
  381. ;; The installation failed, exit so that it is restarted
  382. ;; by login.
  383. #f)))
  384. (const #f)
  385. (lambda (key . args)
  386. (syslog "crashing due to uncaught exception: ~s ~s~%"
  387. key args)
  388. (let ((error-file "/tmp/last-installer-error"))
  389. (call-with-output-file error-file
  390. (lambda (port)
  391. (display-backtrace (make-stack #t) port)
  392. (print-exception port
  393. (stack-ref (make-stack #t) 1)
  394. key args)))
  395. ((installer-exit-error current-installer)
  396. error-file key args))
  397. (primitive-exit 1)))
  398. ((installer-exit current-installer)))))))
  399. (program-file
  400. "installer"
  401. #~(begin
  402. ;; Set the default locale to install unicode support. For
  403. ;; some reason, unicode support is not correctly installed
  404. ;; when calling this in 'installer-builder'.
  405. (setenv "LANG" "en_US.UTF-8")
  406. (execl #$(program-file "installer-real" installer-builder
  407. #:guile guile-3.0-latest)
  408. "installer-real"))))