108 lines
3.8 KiB
Scheme
108 lines
3.8 KiB
Scheme
|
;;; 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)
|
|||
|
|
#:use-module ((guix utils) #:select (source-properties->location))
|
|||
|
|
#:export (environment-type
|
|||
|
|
environment-type?
|
|||
|
|
environment-type-name
|
|||
|
|
environment-type-description
|
|||
|
|
environment-type-location
|
|||
|
|
|
|||
|
|
machine
|
|||
|
|
machine?
|
|||
|
|
this-machine
|
|||
|
|
|
|||
|
|
machine-system
|
|||
|
|
machine-environment
|
|||
|
|
machine-configuration
|
|||
|
|
machine-display-name
|
|||
|
|
|
|||
|
|
deploy-machine
|
|||
|
|
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:
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;;
|
|||
|
|
;;; Declarations for resources that can be provisioned.
|
|||
|
|
;;;
|
|||
|
|
|
|||
|
|
(define-record-type* <environment-type> environment-type
|
|||
|
|
make-environment-type
|
|||
|
|
environment-type?
|
|||
|
|
|
|||
|
|
;; Interface to the environment type's deployment code. Each procedure
|
|||
|
|
;; should take the same arguments as the top-level procedure of this file
|
|||
|
|
;; that shares the same name. For example, 'machine-remote-eval' should be
|
|||
|
|
;; of the form '(machine-remote-eval machine exp)'.
|
|||
|
|
(machine-remote-eval environment-type-machine-remote-eval) ; procedure
|
|||
|
|
(deploy-machine environment-type-deploy-machine) ; procedure
|
|||
|
|
|
|||
|
|
;; Metadata.
|
|||
|
|
(name environment-type-name) ; symbol
|
|||
|
|
(description environment-type-description ; string
|
|||
|
|
(default #f))
|
|||
|
|
(location environment-type-location ; <location>
|
|||
|
|
(default (and=> (current-source-location)
|
|||
|
|
source-properties->location))
|
|||
|
|
(innate)))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;;
|
|||
|
|
;;; Declarations for machines in a deployment.
|
|||
|
|
;;;
|
|||
|
|
|
|||
|
|
(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 (machine-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."
|
|||
|
|
(let ((environment (machine-environment machine)))
|
|||
|
|
((environment-type-machine-remote-eval environment) machine exp)))
|
|||
|
|
|
|||
|
|
(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."
|
|||
|
|
(let ((environment (machine-environment machine)))
|
|||
|
|
((environment-type-deploy-machine environment) machine)))
|