Add weather.

* loadavg/scripts/weather.scm: New file.

1 files changed, 129 insertions, 0 deletions

diff --git a/loadavg/scripts/weather.scm b/loadavg/scripts/weather.scm
new file mode 100644
index 0000000..47185cf
--- /dev/null
+++ b/loadavg/scripts/weather.scm
@@ -0,0 +1,129 @@
+;;; Guile loadavg --- loadavg command-line interface.
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;;
+;;; This file is part of Guile loadavg.
+;;;
+;;; Guile loadavg 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.
+;;;
+;;; Guile loadavg 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 Guile loadavg.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (loadavg scripts weather)
+  #:use-module ((guix scripts) #:select (parse-command-line))
+  #:use-module ((guix ui) #:select (colorize-string G_ leave))
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (loadavg ui)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-37)
+  #:use-module (ssh auth)
+  #:use-module (ssh popen)
+  #:use-module (ssh session)
+
+  #:use-module (guix records)
+  #:export (loadavg-weather))
+
+(define (show-help)
+  (display (G_ "Usage: loadavg weather [OPTION ...] ACTION [ARG ...]
+Fetch data about user.\n"))
+  (newline)
+  (display (G_ "The valid values for ACTION are:\n"))
+  (newline)
+  (newline)
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  ;; TODO: version
+  #;(display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  ;; (show-bug-report-information)
+  )
+
+(define %options
+  ;; Specifications of the command-line options.
+  (list (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))))
+
+(define %default-options '())
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define-record-type* <loadavg>
+  loadavg make-loadavg
+  loadavg?
+  (host loadavg-host) ;string
+  (l1 loadavg-l1) ;number
+  (l5 loadavg-l5) ;number
+  (l15 loadavg-l15) ;number
+  )
+
+(define* (loadavg-host #:key
+                       host
+                       (user "sup")
+                       (port 1022))
+  (let ((session (make-session #:host host
+                               #:user user
+                               #:port port)))
+    (connect! session)
+    (authenticate-server session)
+    (userauth-public-key/auto! session)
+    (let ((channel (open-remote-input-pipe session "cat /proc/loadavg")))
+      (match (string-split (read-line channel) #\space)
+        ((l1 l5 l15 _ _)
+         (loadavg (host host)
+                  (l1 (string->number l1))
+                  (l5 (string->number l5))
+                  (l15 (string->number l15))))))))
+
+
+(define (loadavg-weather . args)
+  ;; TODO: with-error-handling
+  ;; Make a session with local machine and the current user.
+  (define colorize? #t)
+
+  (define good
+    (if colorize?
+        (cut colorize-string <> 'GREEN 'BOLD)
+        identity))
+
+  (define failure
+    (if colorize?
+        (cut colorize-string <> 'RED 'BOLD)
+        identity))
+
+  (map (compose (match-lambda
+                  (($ <loadavg> host l1 l5 l15)
+                   (if (or (> l1 200)
+                           (> l5 200)
+                           (> l15 200))
+                       (format #t "~a: ~{~a ~}~%"
+                               host
+                               (map (lambda (number)
+                                      (let* ((out (match (string-split (number->string number)
+                                                                       #\.)
+                                                    ((numerator denominator)
+                                                     (string->number numerator))))
+                                             (more (cut > out <>)))
+                                        (cond ((more 200)
+                                               (failure (number->string out)))
+                                              (else (good (number->string out))))))
+                                    (list l1 l5 l15)))
+                       '())))
+                loadavg-host)
+       args))