1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 David Thompson <davet@gnu.org>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.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 machine)
#:use-module (gnu system)
#:use-module (guix derivations)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix store)
#:export (machine
machine?
this-machine
machine-system
machine-environment
machine-configuration
machine-display-name
build-machine
deploy-machine
remote-eval))
;;; Commentary:
;;;
;;; This module provides the types used to declare individual machines in a
;;; heterogeneous Guix deployment. The interface allows users of specify system
;;; configurations and the means by which resources should be provisioned on a
;;; per-host basis.
;;;
;;; Code:
(define-record-type* <machine> machine
make-machine
machine?
this-machine
(system machine-system) ; <operating-system>
(environment machine-environment) ; symbol
(configuration machine-configuration ; configuration object
(default #f))) ; specific to environment
(define (machine-display-name machine)
"Return the host-name identifying MACHINE."
(operating-system-host-name (machine-system machine)))
(define (build-machine machine)
"Monadic procedure that builds the system derivation for MACHINE and returning
a list containing the path of the derivation file and the path of the derivation
output."
(let ((os (machine-system machine)))
(mlet* %store-monad ((osdrv (operating-system-derivation os))
(_ ((store-lift build-derivations) (list osdrv))))
(return (list (derivation-file-name osdrv)
(derivation->output-path osdrv))))))
(define (remote-eval machine exp)
"Evaluate EXP, a gexp, on MACHINE. Ensure that all the elements EXP refers to
are built and deployed to MACHINE beforehand."
(case (machine-environment machine)
((managed-host)
((@@ (gnu machine ssh) remote-eval) machine exp))
(else
(let ((type (machine-environment machine)))
(error "unsupported environment type" type)))))
(define (deploy-machine machine)
"Monadic procedure transferring the new system's OS closure to the remote
MACHINE, activating it on MACHINE and switching MACHINE to the new generation."
(case (machine-environment machine)
((managed-host)
((@@ (gnu machine ssh) deploy-machine) machine))
(else
(let ((type (machine-environment machine)))
(error "unsupported environment type" type)))))
|