aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.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 installer tests) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 pretty-print) #:export (&pattern-not-matched pattern-not-matched? %installer-socket-file open-installer-socket converse conversation-log-port choose-locale+keyboard enter-host-name+passwords choose-kernel choose-services choose-partitioning start-installation complete-installation edit-configuration-file)) ;;; Commentary: ;;; ;;; This module provides tools to test the guided "graphical" installer in a ;;; non-interactive fashion. The core of it is 'converse': it allows you to ;;; state Expect-style dialogues, which happen over the Unix-domain socket the ;;; installer listens to. Higher-level procedures such as ;;; 'choose-locale+keyboard' are provided to perform specific parts of the ;;; dialogue. ;;; ;;; Code: (define %installer-socket-file ;; Socket the installer listens to. "/var/guix/installer-socket") (define* (open-installer-socket #:optional (file %installer-socket-file)) "Return a socket connected to the installer." (let ((sock (socket AF_UNIX SOCK_STREAM 0))) (connect sock AF_UNIX file) sock)) (define-condition-type &pattern-not-matched &error pattern-not-matched? (pattern pattern-not-matched-pattern) (sexp pattern-not-matched-sexp)) (define (pattern-error pattern sexp) (raise (condition (&pattern-not-matched (pattern pattern) (sexp sexp))))) (define conversation-log-port ;; Port where debugging info is logged (make-parameter (current-error-port))) (define (converse-debug pattern) (format (conversation-log-port) "conversation expecting pattern ~s~%" pattern)) (define-syntax converse (lambda (s) "Convert over PORT: read sexps from there, match them against each PATTERN, and send the corresponding REPLY. Raise to '&pattern-not-matched' when one of the PATTERNs is not matched." ;; XXX: Strings that appear in PATTERNs must be in the language the ;; installer is running in. In the future, we should add support to allow ;; writing English strings in PATTERNs and have the pattern matcher ;; automatically translate them. ;; Here we emulate 'pmatch' syntax on top of 'match'. This is ridiculous ;; but that's because 'pmatch' compares objects with 'eq?', making it ;; pretty useless, and it doesn't support ellipses and such. (define (quote-pattern s) ;; Rewrite the pattern S from pmatch style (a ,b) to match style like ;; ('a b). (with-ellipsis ::: (syntax-case s (unquote _ ...) ((unquote id) #'id) (_ #'_) (... #'...) (id (identifier? #'id) #''id) ((lst :::) (map quote-pattern #'(lst :::))) (pattern #'pattern