01/03: hydra: Remove 'machine-status.scm' program.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository maintenance.

commit 33c73f0a0d4981034f36a9394a6091e46401934d
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jan 17 10:21:52 2019 +0100

    hydra: Remove 'machine-status.scm' program.
    
    * hydra/machine-status.scm: Remove.  This is superseded by 'guix offload
    status'.
---
 hydra/machine-status.scm | 123 -----------------------------------------------
 1 file changed, 123 deletions(-)

diff --git a/hydra/machine-status.scm b/hydra/machine-status.scm
deleted file mode 100755
index aa48bb5..0000000
--- a/hydra/machine-status.scm
+++ /dev/null
@@ -1,123 +0,0 @@
-#!/bin/sh
-exec guile -e '(@@ (machine-status) machine-status)' -s "$0" "$@"
-!#
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <address@hidden>
-;;;
-;;; 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 (machine-status)
-  #:use-module (ssh auth)
-  #:use-module (ssh dist)
-  #:use-module (ssh session)
-  #:use-module (ssh channel)
-  #:use-module (ssh dist node)
-  #:use-module (guix records)
-  #:use-module (srfi srfi-1)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 rdelim)
-  #:export (machine-status))
-
-;;; Commentary:
-;;;
-;;; Report the status (CPU load, etc.) of each build farm machine.
-;;;
-;;; Code:
-
-(define (read-records port)
-  "Read as many recutils-formatted records from PORT as possible and return
-them as alists."
-  (let loop ((result '()))
-    (match (recutils->alist port)
-      (()
-       (reverse result))
-      ((alist ...)
-       (loop (cons alist result))))))
-
-(define %machines
-  ;; The build farm's machines.
-  (map (lambda (alist)
-         (list (assoc-ref alist "Hostname")
-               (or (and=> (assoc-ref alist "Port") string->number)
-                   22)))
-       (call-with-input-file "machines.rec"
-         read-records)))
-
-(define (machine-session host port)
-  "Return an SSH session for HOST at PORT, or #f."
-  (format #t "connecting to ~a:~a...~%" host port)
-  (let ((session (make-session #:host host #:port port #:user "hydra"
-                               #:timeout 5)))
-    (match (connect! session)
-      ('ok
-       (match (userauth-public-key/auto! session)
-         ('success
-          session)
-         (status
-          (format #t "  authentication failed: ~a~%" status)
-          #f)))
-      (_
-       (format #t "  failed to connect to ~a:~a: ~a~%"
-               host port (get-error session))
-       #f))))
-
-(define (machine-load session)
-  "Return the load on the machine behind SESSION."
-  (let ((channel (make-channel session)))
-    (channel-open-session channel)
-    (channel-request-exec channel "cat /proc/loadavg")
-    (match (string-tokenize (read-line channel))
-      ((current-load _ ...)
-       (channel-request-send-exit-status channel 0)
-       current-load))))
-
-(define (report-machine-status host load uts)
-  (format #t "~a~%  kernel: ~a ~a~%  architecture: ~a~%\
-  host name: ~a~%  load: ~a~%"
-          host
-          (utsname:sysname uts) (utsname:release uts)
-          (utsname:machine uts)
-          (utsname:nodename uts)
-          load))
-
-
-;;;
-;;; Entry point.
-;;;
-
-(define (machine-status . args)
-  (let* ((hosts+sessions
-          (filter-map (match-lambda
-                        ((host port)
-                         (match (machine-session host port)
-                           ((? session? session)
-                            (list host session))
-                           (_
-                            #f))))
-                      %machines))
-         (hosts    (match hosts+sessions
-                     (((hosts sessions) ...)
-                      hosts)))
-         (sessions (match hosts+sessions
-                     (((hosts sessions) ...)
-                      sessions)))
-         (nodes    (map make-node sessions))
-         (loads    (map machine-load sessions))
-         (uts      (map (lambda (node)
-                          (node-eval node '(uname)))
-                        nodes)))
-    (for-each report-machine-status hosts loads uts)
-    (for-each disconnect! sessions)))