unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
blob 4fde7d5c010c8765098606d3b38d3085254762cd 2137 bytes (raw)
name: gnu/machine.scm 	 # note: path name is non-authoritative(*)

 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
 
(define-module (gnu machine)
  #:use-module ((gnu packages package-management) #:select (guix))
  #:use-module (gnu system)
  #:use-module (guix derivations)
  #:use-module (guix inferior)
  #:use-module (guix packages)
  #:use-module (guix ssh)
  #:use-module (guix store)
  #:use-module (oop goops)
  #:use-module (ssh session)
  #:export (<machine>
            system
            display-name
            build-os
            deploy-os
            remote-eval

            <sshable-machine>
            host-name
            ssh-port
            ssh-user))

(define-class <machine> ()
  (system #:getter system #:init-keyword #:system))

(define-method (display-name (machine <machine>))
  (operating-system-host-name (system machine)))

(define-method (build-os (machine <machine>) store)
  (let* ((guixdrv (run-with-store store (package->derivation guix)))
         (guixdir (and (build-derivations store (list guixdrv))
                       (derivation->output-path guixdrv)))
         (osdrv (run-with-store store (operating-system-derivation
                                       (system machine)))))
    (and (build-derivations store (list osdrv))
         (list (derivation-file-name osdrv)
               (derivation->output-path osdrv)))))

(define-method (deploy-os (machine <machine>) store osdrv)
  (error "not implemented"))

(define-method (remote-eval (machine <machine>) exp)
  (error "not implemented"))

(define-class <sshable-machine> (<machine>)
  (host-name #:getter host-name #:init-keyword #:host-name)
  (ssh-port #:getter ssh-port #:init-keyword #:ssh-port #:init-form 22)
  (ssh-user #:getter ssh-user #:init-keyword #:ssh-user #:init-form "root")
  ;; ??? - SSH key config?
  )

(define-method (deploy-os (machine <sshable-machine>) store osdrvs)
  (let ((session (open-ssh-session (host-name machine)
                                   #:user (ssh-user machine)
                                   #:port (ssh-port machine))))
    (with-store store (send-files store osdrvs
                                  (connect-to-remote-daemon session)
                                  #:recursive? #t))
    #t))

debug log:

solving 4fde7d5c01 ...
found 4fde7d5c01 in https://git.savannah.gnu.org/cgit/guix.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).