01/01: hydra: Remove install-berlin script.

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository maintenance.

commit 54bb2a9bebbd948a3d8c5b3e5ec13ff7b645e34f
Author: Ricardo Wurmus <address@hidden>
Date:   Wed Aug 7 12:51:16 2019 +0200

    hydra: Remove install-berlin script.
    
    We have "guix deploy" now, so this is no longer needed.
    
    * hydra/install-berlin.scm: Remove file.
---
 hydra/install-berlin.scm | 181 -----------------------------------------------
 1 file changed, 181 deletions(-)

diff --git a/hydra/install-berlin.scm b/hydra/install-berlin.scm
deleted file mode 100644
index 8e3a9f6..0000000
--- a/hydra/install-berlin.scm
+++ /dev/null
@@ -1,181 +0,0 @@
-;; Run this script as:
-;; GUILE_LOAD_COMPILED_PATH= guile --no-auto-compile install-berlin.scm 1 2 3
-
-(define %hydra-modules "/root/maintenance/hydra/modules")
-(set! %load-path
-      (cons* "/root/.config/guix/current/share/guile/site/2.2"
-             %hydra-modules %load-path))
-;; Without this the info-dir.drv will be miscompiled!
-(set! %load-compiled-path
-      (cons* "/root/.config/guix/current/lib/guile/2.2/site-ccache"
-             %load-compiled-path))
-
-(use-modules (sysadmin build-machines)
-             (sysadmin people)
-             (ssh auth)
-             (ssh session)
-             (ssh popen)                ; remote pipes
-             (ssh channel)              ; channel-set-pty-size!
-             (guix derivations)
-             (guix inferior)
-             (guix ssh)
-             (guix gexp)
-             (guix grafts)
-             (guix store)
-             (guix packages)
-             (gnu system)
-             ((gnu packages package-management) #:select (guix))
-             (srfi srfi-1)
-             (srfi srfi-11)             ; let-values
-             (srfi srfi-41)             ; streams
-             (ice-9 match))
-
-
-(define (open-remote-input-pipe/pty session command . args)
-  "Open remote input pipe with PTY, run a COMMAND with ARGS."
-  (define OPEN_PTY_READ (string-append OPEN_PTY OPEN_BOTH))
-  (let ((p (open-remote-pipe session command OPEN_PTY_READ)))
-    (channel-set-pty-size! p 80 40)
-    p))
-
-(define (pipe->stream p)
-  "Convert a pipe P to a SRFI-41 stream."
-  (stream-let loop ((c (read-char p)))
-              (if (eof-object? c)
-                  (begin
-                    (close-input-port p)
-                    stream-null)
-                  (stream-cons c (loop (read-char p))))))
-
-(define (remote-inferior* session guix-directory)
-  "Return a remote inferior for the given SESSION."
-  (let ((pipe (open-remote-pipe* session OPEN_BOTH
-                                 (string-append guix-directory "/bin/guix")
-                                 "repl" "-t" "machine")))
-    (port->inferior pipe)))
-
-(define (inferior-remote-eval* exp session guix-directory)
-  "Evaluate EXP in a new inferior running in SESSION, and close the inferior
-right away."
-  (let ((inferior (remote-inferior* session guix-directory)))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (inferior-eval exp inferior))
-      (lambda ()
-        ;; Close INFERIOR right away to prevent finalization from happening in
-        ;; another thread at the wrong time (see
-        ;; <https://bugs.gnu.org/26976>.)
-        (close-inferior inferior)))))
-
-(define (host-for-id id)
-  "Return a host IP address for the given ID."
-  (format #f "141.80.167.~d" (+ id 131)))
-
-
-(define (build-os id)
-  "Build Guix and then use it to build the operating system
-configuration for the target host with the given ID.  Return the
-derivations and store file names as the first value and the directory
-of Guix as the second value."
-  (let ((host (host-for-id id)))
-    (format #t "building operating system for ~a...~%" host)
-    (with-store local
-      (let* ((guixdrv (run-with-store local (package->derivation guix)))
-             (guixdir (and (build-derivations local (list guixdrv))
-                           (derivation->output-path guixdrv)))
-             (inferior-local (open-inferior guixdir))
-             (osdrv (and=> (inferior-eval-with-store
-                            inferior-local local
-                            `(lambda (store)
-                               (add-to-load-path ,%hydra-modules)
-                               (use-modules (sysadmin build-machines) (guix 
grafts))
-                               (parameterize ((%graft? #f))
-                                 (let* ((host ,host)
-                                        (os (berlin-build-machine-os ,id))
-                                        (osdrv (run-with-store store 
(operating-system-derivation os))))
-                                   (and (build-derivations store (list osdrv))
-                                        (derivation-file-name osdrv))))))
-                           read-derivation-from-file)))
-        (close-inferior inferior-local)
-        (values
-         (append (map derivation->output-path (list osdrv guixdrv))
-                 (map derivation-file-name (list osdrv guixdrv)))
-         guixdir)))))
-
-(define (push-os drvs id)
-  "Copy the derivations DRVS to the target with ID."
-  (let* ((host (host-for-id id))
-         (session (open-ssh-session host #:user "hydra" #:port 22)))
-    (format #t "pushing store items to ~a...~%" host)
-    (with-store local (send-files local drvs
-                                  (connect-to-remote-daemon session)
-                                  #:recursive? #t))
-    #t))
-
-;; XXX: This seems to work, but it's dreadfully silent.
-(define (reconfigure-remote id guix-directory)
-  "Reconfigure the remote system with the given ID using Guix from
-GUIX-DIRECTORY."
-  (let* ((host    (host-for-id id))
-         (session (open-ssh-session host #:user "root" #:port 22)))
-    (and=> (or (connected? session)
-               (match (connect! session)
-                 ('error (pk (get-error session) #f))
-                 (_ (userauth-agent! session))))
-           (lambda _
-             (format #t "reconfiguring ~a...~%" host)
-             (inferior-remote-eval*
-              `(begin
-                 (add-to-load-path ,%hydra-modules)
-                 (use-modules (sysadmin build-machines)
-                              (guix grafts)
-                              (guix scripts system))
-                 ;; XXX: The reconfigure output confuses the inferior 
mechanism :(
-                 (parameterize ((current-error-port (%make-void-port "rw+"))
-                                (current-output-port (%make-void-port "rw+"))
-                                (%graft? #f))
-                   (guix-system "reconfigure" "--no-grafts"
-                                "-e"
-                                (format #f "~s" `(begin
-                                                   (add-to-load-path 
,,%hydra-modules)
-                                                   (use-modules (sysadmin 
build-machines))
-                                                   (berlin-build-machine-os 
,,id)))))
-                 #t)
-              session guix-directory)
-             (format #t "DONE!~%")
-             #t))))
-
-(define (reconfigure-remote* id guix-directory)
-  "Reconfigure the remote system with the given ID using Guix from
-GUIX-DIRECTORY."
-  (let* ((host    (host-for-id id))
-         (session (open-ssh-session host #:user "root" #:port 22)))
-    (and=> (or (connected? session)
-               (match (connect! session)
-                 ('error (pk (get-error session) #f))
-                 (_ (userauth-agent! session))))
-           (lambda _
-             (let* ((command (string-append
-                              guix-directory "/bin/guix system reconfigure "
-                              "--no-grafts "
-                              "-e "
-                              (format #f "'~s'"
-                                      `(begin
-                                         (add-to-load-path ,%hydra-modules)
-                                         (use-modules (sysadmin 
build-machines))
-                                         (berlin-build-machine-os ,id)))))
-                    (rs (pipe->stream (open-remote-input-pipe/pty session 
command))))
-               (stream-for-each (lambda (c)
-                                  (match c
-                                    (#\newline (format #t "\n~a: " host))
-                                    (c (display c))))
-                                rs))))))
-
-
-(for-each (lambda (id)
-            (parameterize ((%graft? #f))
-              (let-values (((drvs guix-directory) (build-os id)))
-                (push-os drvs id)
-                (reconfigure-remote* id guix-directory))))
-          (map string->number (cdr (command-line))))