Commit | Line | Data |
---|---|---|
fa9edf09 JK |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2019 David Thompson <davet@gnu.org> | |
3 | ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.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 | ||
20 | (define-module (gnu machine) | |
21 | #:use-module (gnu system) | |
22 | #:use-module (guix derivations) | |
23 | #:use-module (guix monads) | |
24 | #:use-module (guix records) | |
25 | #:use-module (guix store) | |
26 | #:use-module ((guix utils) #:select (source-properties->location)) | |
9c70c460 | 27 | #:use-module (srfi srfi-35) |
fa9edf09 JK |
28 | #:export (environment-type |
29 | environment-type? | |
30 | environment-type-name | |
31 | environment-type-description | |
32 | environment-type-location | |
33 | ||
34 | machine | |
35 | machine? | |
36 | this-machine | |
37 | ||
d97ce204 | 38 | machine-operating-system |
fa9edf09 JK |
39 | machine-environment |
40 | machine-configuration | |
41 | machine-display-name | |
42 | ||
43 | deploy-machine | |
9c70c460 JK |
44 | roll-back-machine |
45 | machine-remote-eval | |
46 | ||
47 | &deploy-error | |
48 | deploy-error? | |
49 | deploy-error-should-roll-back | |
50 | deploy-error-captured-args)) | |
fa9edf09 JK |
51 | |
52 | ;;; Commentary: | |
53 | ;;; | |
54 | ;;; This module provides the types used to declare individual machines in a | |
55 | ;;; heterogeneous Guix deployment. The interface allows users of specify system | |
56 | ;;; configurations and the means by which resources should be provisioned on a | |
57 | ;;; per-host basis. | |
58 | ;;; | |
59 | ;;; Code: | |
60 | ||
61 | \f | |
62 | ;;; | |
63 | ;;; Declarations for resources that can be provisioned. | |
64 | ;;; | |
65 | ||
66 | (define-record-type* <environment-type> environment-type | |
67 | make-environment-type | |
68 | environment-type? | |
69 | ||
70 | ;; Interface to the environment type's deployment code. Each procedure | |
71 | ;; should take the same arguments as the top-level procedure of this file | |
72 | ;; that shares the same name. For example, 'machine-remote-eval' should be | |
73 | ;; of the form '(machine-remote-eval machine exp)'. | |
74 | (machine-remote-eval environment-type-machine-remote-eval) ; procedure | |
75 | (deploy-machine environment-type-deploy-machine) ; procedure | |
9c70c460 | 76 | (roll-back-machine environment-type-roll-back-machine) ; procedure |
fa9edf09 JK |
77 | |
78 | ;; Metadata. | |
79 | (name environment-type-name) ; symbol | |
80 | (description environment-type-description ; string | |
81 | (default #f)) | |
82 | (location environment-type-location ; <location> | |
83 | (default (and=> (current-source-location) | |
84 | source-properties->location)) | |
85 | (innate))) | |
86 | ||
87 | \f | |
88 | ;;; | |
89 | ;;; Declarations for machines in a deployment. | |
90 | ;;; | |
91 | ||
92 | (define-record-type* <machine> machine | |
93 | make-machine | |
94 | machine? | |
95 | this-machine | |
d97ce204 JK |
96 | (operating-system machine-operating-system) ; <operating-system> |
97 | (environment machine-environment) ; symbol | |
98 | (configuration machine-configuration ; configuration object | |
99 | (default #f))) ; specific to environment | |
fa9edf09 JK |
100 | |
101 | (define (machine-display-name machine) | |
102 | "Return the host-name identifying MACHINE." | |
d97ce204 | 103 | (operating-system-host-name (machine-operating-system machine))) |
fa9edf09 JK |
104 | |
105 | (define (machine-remote-eval machine exp) | |
106 | "Evaluate EXP, a gexp, on MACHINE. Ensure that all the elements EXP refers to | |
107 | are built and deployed to MACHINE beforehand." | |
108 | (let ((environment (machine-environment machine))) | |
109 | ((environment-type-machine-remote-eval environment) machine exp))) | |
110 | ||
111 | (define (deploy-machine machine) | |
112 | "Monadic procedure transferring the new system's OS closure to the remote | |
113 | MACHINE, activating it on MACHINE and switching MACHINE to the new generation." | |
114 | (let ((environment (machine-environment machine))) | |
115 | ((environment-type-deploy-machine environment) machine))) | |
9c70c460 JK |
116 | |
117 | (define (roll-back-machine machine) | |
118 | "Monadic procedure rolling back to the previous system generation on | |
119 | MACHINE. Return the number of the generation that was current before switching | |
120 | and the new generation number." | |
121 | (let ((environment (machine-environment machine))) | |
122 | ((environment-type-roll-back-machine environment) machine))) | |
123 | ||
124 | \f | |
125 | ;;; | |
126 | ;;; Error types. | |
127 | ;;; | |
128 | ||
129 | (define-condition-type &deploy-error &error | |
130 | deploy-error? | |
131 | (should-roll-back deploy-error-should-roll-back) | |
132 | (captured-args deploy-error-captured-args)) |