summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArtyom V. Poptsov <poptsov.artyom@gmail.com>2017-01-01 00:59:26 +0300
committerArtyom V. Poptsov <poptsov.artyom@gmail.com>2017-01-01 00:59:26 +0300
commitb2b31fa7e3a853976743f0bdfbb322a02a111b45 (patch)
tree136abf8502b3954d4bb756efa582e6d210fc550b
parentshell.scm (loadavg): New procedure (diff)
downloadguile-ssh-b2b31fa7e3a853976743f0bdfbb322a02a111b45.tar.gz
node.scm (node-loadavg): New procedure
* modules/ssh/dist.scm (with-ssh): Move to (ssh dist node); re-export the procedure. * modules/ssh/dist/node.scm (node-loadavg): New procedure.
-rw-r--r--modules/ssh/dist.scm11
-rw-r--r--modules/ssh/dist/node.scm31
2 files changed, 33 insertions, 9 deletions
diff --git a/modules/ssh/dist.scm b/modules/ssh/dist.scm
index 06027dc..dbac7a2 100644
--- a/modules/ssh/dist.scm
+++ b/modules/ssh/dist.scm
@@ -50,8 +50,8 @@
#:use-module (ssh channel)
#:use-module (ssh dist node)
#:use-module (ssh dist job)
- #:re-export (node? node-session node-repl-port make-node)
- #:export (distribute dist-map with-ssh rrepl))
+ #:re-export (node? node-session node-repl-port make-node with-ssh)
+ #:export (distribute dist-map rrepl))
;;; Helper procedures
@@ -114,13 +114,6 @@ result of computation."
results))
-(define-syntax-rule (with-ssh node exp ...)
- "Evaluate expressions on a remote REPL using a NODE, return four values: an
-evaluation result, a number of the evaluation, a module name and a language
-name. Throw 'node-error' or 'node-repl-error' on an error."
- (node-eval node (quote (begin exp ...))))
-
-
(define (rrepl node)
"Start an interactive remote REPL (RREPL) session using NODE."
(let ((repl-channel (node-open-rrepl node)))
diff --git a/modules/ssh/dist/node.scm b/modules/ssh/dist/node.scm
index f58d9f1..e4926fc 100644
--- a/modules/ssh/dist/node.scm
+++ b/modules/ssh/dist/node.scm
@@ -36,6 +36,9 @@
;; node-run-server
;; node-stop-server
;; node-server-running?
+;; node-loadavg
+;; with-ssh
+;;
;; rrepl-eval
;; rrepl-skip-to-prompt
;;
@@ -73,6 +76,8 @@
node-run-server
node-stop-server
node-server-running?
+ node-loadavg
+ with-ssh
node-open-rrepl
rrepl-eval
@@ -370,4 +375,30 @@ procedure returns the 1st evaluated value if multiple values were returned."
(and (zero? rc)
(car result))))
+
+(define-syntax-rule (with-ssh node exp ...)
+ "Evaluate expressions on a remote REPL using a NODE, return four values: an
+evaluation result, a number of the evaluation, a module name and a language
+name. Throw 'node-error' or 'node-repl-error' on an error."
+ (node-eval node (quote (begin exp ...))))
+
+(define (node-loadavg node)
+ "Get average load of a NODE. Return an alist of five elements as described in
+proc(5) man page."
+ (with-ssh node
+ (use-modules (ice-9 rdelim))
+ (define (list-element->number l n)
+ (string->number (list-ref l n)))
+ (let* ((p (open-input-file "/proc/loadavg"))
+ (raw (read-line p)))
+ (close p)
+ (let ((raw-list (string-split raw #\space)))
+ `((one . ,(list-element->number raw-list 0))
+ (five . ,(list-element->number raw-list 1))
+ (fifteen . ,(list-element->number raw-list 2))
+ (scheduling-entities . ,(map string->number
+ (string-split (list-ref raw-list 3)
+ #\/)))
+ (last-pid . ,(list-element->number raw-list 4)))))))
+
;;; node.scm ends here