blob: 47185cf09f9a7ad4c0c4190fe95406f0eb743787 (
about) (
plain)
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
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))
|
