From ac98f81671c7c2b4edd2e3527fb11019ed5083a2 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <mathieu@berlin.guix.gnu.org>
Date: Mon, 8 Feb 2021 12:25:47 +0100
Subject: [PATCH] Add Zabbix support.
---
Makefile.am | 3 +-
src/cuirass/http.scm | 58 +++++++++++++
src/cuirass/templates.scm | 129 +++++++++++++++++++++++++++-
src/cuirass/zabbix.scm | 172 ++++++++++++++++++++++++++++++++++++++
4 files changed, 358 insertions(+), 4 deletions(-)
create mode 100644 src/cuirass/zabbix.scm
diff --git a/Makefile.am b/Makefile.am
index 9cc0bb23..d1c54521 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -62,7 +62,8 @@ dist_pkgmodule_DATA = \
src/cuirass/ui.scm \
src/cuirass/utils.scm \
src/cuirass/templates.scm \
- src/cuirass/watchdog.scm
+ src/cuirass/watchdog.scm \
+ src/cuirass/zabbix.scm
nodist_pkgmodule_DATA = \
src/cuirass/config.scm
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 2d3d4cb8..f80311f3 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -30,6 +30,7 @@
#:use-module (cuirass logging)
#:use-module (cuirass remote)
#:use-module (cuirass rss)
+ #:use-module (cuirass zabbix)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
@@ -46,6 +47,7 @@
#:use-module ((rnrs bytevectors) #:select (utf8->string))
#:use-module (sxml simple)
#:use-module (cuirass templates)
+ #:use-module (guix progress)
#:use-module (guix utils)
#:use-module ((guix store) #:select (%store-prefix))
#:use-module (guix build union)
@@ -276,6 +278,58 @@ Hydra format."
'percentage-failed-eval-per-spec)))
'()))
+(define (machine-page name)
+ (define zabbix-info
+ (if (zabbix-available?)
+ (with-zabbix-connection
+ (let* ((host-id (zabbix-host-id name))
+ (enabled? (zabbix-host-enabled? name))
+ (value (cut zabbix-item-value <> host-id))
+ (history (lambda (key type)
+ (zabbix-history
+ (zabbix-item-id key host-id)
+ #:limit 100
+ #:type type))))
+ (if enabled?
+ `((#:hostname . ,(value "system.hostname"))
+ (#:info . ,(value "system.uname"))
+ (#:boottime . ,(string->number
+ (value "system.boottime")))
+ (#:ram . ,(byte-count->string
+ (string->number
+ (value "vm.memory.size[total]"))))
+ (#:root-space . ,(byte-count->string
+ (string->number
+ (value "vfs.fs.size[/,total]"))))
+ (#:store-space
+ . ,(byte-count->string
+ (string->number
+ (value "vfs.fs.size[/gnu/store,total]"))))
+ (#:cpu-idle . ,(history "system.cpu.util[,idle]" 'float))
+ (#:ram-available . ,(history "vm.memory.size[available]"
+ 'unsigned))
+ (#:store-free . ,(history "vfs.fs.size[/gnu/store,pfree]"
+ 'float)))
+ '())))
+ '()))
+
+ (let ((builds (db-get-builds `((status . started)
+ (order . status+submission-time))))
+ (workers (filter (lambda (worker)
+ (string=? name (worker-machine worker)))
+ (db-get-workers))))
+ (html-page
+ name
+ (machine-status name workers
+ (map (lambda (worker)
+ (filter (lambda (build)
+ (string=? (assq-ref build #:worker)
+ (worker-name worker)))
+ builds))
+ workers)
+ zabbix-info)
+ '())))
+
;;;
;;; Web server.
@@ -723,6 +777,10 @@ Hydra format."
500
"Could not find the request build product."))))
+ (('GET "machine" name)
+ (respond-html
+ (machine-page name)))
+
(('GET "static" path ...)
(respond-static-file path))
(_
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index bc3eadef..ae3de203 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -46,7 +46,8 @@
evaluation-build-table
running-builds-table
global-metrics-content
- workers-status))
+ workers-status
+ machine-status))
(define (navigation-items navigation)
(match navigation
@@ -922,6 +923,7 @@ and BUILD-MAX are global minimal and maximal row identifiers."
xaxes-labels
x-label
y-label
+ (x-unit "day")
title
labels
colors)
@@ -932,7 +934,7 @@ and BUILD-MAX are global minimal and maximal row identifiers."
. ((display . #t)
(labelString . ,x-label))))))
(time-xAxes (vector `((type . "time")
- (time . ((unit . "day")))
+ (time . ((unit . ,x-unit)))
(display . #t)
(distribution . "series")
(scaleLabel
@@ -1126,7 +1128,8 @@ completed builds divided by the time required to build them.")
((build _ ...) build)))
workers)))
`(div (@ (class "col-sm-4 mt-3"))
- (h6 ,machine)
+ (a (@(href "/machine/" ,machine))
+ (h6 ,machine))
,(map (lambda (build)
(let ((style (format #f
"width: ~a%"
@@ -1164,3 +1167,123 @@ text-dark d-flex position-absolute w-100"))
(div (@ (class "container"))
(div (@ (class "row"))
,@(map machine-row machines))))))
+
+(define* (machine-status name workers builds info)
+ (define (history->json-scm history)
+ (apply vector
+ (map (match-lambda
+ ((field . value)
+ `((x . ,(* field 1000)) (y . ,value))))
+ history)))
+
+ (define (ram-available->json-scm history)
+ (apply vector
+ (map (match-lambda
+ ((field . value)
+ `((x . ,(* field 1000))
+ (y . ,(/ value (expt 2 30))))))
+ history)))
+
+ `((p (@ (class "lead")) "Machine " ,name)
+ ,@(if (null? info)
+ '()
+ `((table
+ (@ (class "table table-sm table-hover table-striped"))
+ (tbody
+ (tr (th "Hostname")
+ (td ,(assq-ref info #:hostname)))
+ (tr (th "Info")
+ (td ,(assq-ref info #:info)))
+ (tr (th "Boot time")
+ (td ,(time->string
+ (assq-ref info #:boottime))))
+ (tr (th "Total RAM")
+ (td ,(assq-ref info #:ram)))
+ (tr (th "Total root disk space")
+ (td ,(assq-ref info #:root-space)))
+ (tr (th "Total store disk space")
+ (td ,(assq-ref info #:store-space)))))))
+ (h6 "Workers")
+ (table
+ (@ (class "table table-sm table-hover table-striped"))
+ ,@(if (null? workers)
+ `((th (@ (scope "col")) "No elements here."))
+ `((thead
+ (tr
+ (th (@ (scope "col")) "Name")
+ (th (@ (scope "col")) "Systems")
+ (th (@ (scope "col")) "Building")
+ (th (@ (scope "col")) "Last seen")))
+ (tbody
+ ,@(map
+ (lambda (worker build)
+ `(tr (td ,(worker-name worker))
+ (td ,(string-join (worker-systems worker)
+ ", "))
+ (td ,(match build
+ (() "idle")
+ ((build)
+ `(a (@ (class "text-truncate")
+ (style "max-width: 150px")
+ (href "/build/"
+ ,(assq-ref build #:id)
+ "/details"))
+ ,(assq-ref build #:job-name)))))
+ (td ,(time->string
+ (worker-last-seen worker)))))
+ workers builds)))))
+ ,@(if (null? info)
+ '((div (@ (class "alert alert-danger"))
+ "Could not find machine information using Zabbix."))
+ `((h6 "CPU idle time")
+ ,@(let ((cpu-idle (assq-ref info #:cpu-idle))
+ (cpu-idle-chart "cpu_idle_chart"))
+ `((script (@ (src "/static/js/chart.js")))
+ (br)
+ (canvas (@ (id ,cpu-idle-chart)))
+ ,@(make-line-chart cpu-idle-chart
+ (list (history->json-scm cpu-idle))
+ #:time-x-axes? #t
+ #:x-label "Time"
+ #:y-label "Percentage"
+ #:x-unit "minute"
+ #:title "CPU idle time"
+ #:labels '("CPU idle time")
+ #:colors (list "#3e95cd"))))
+ (br)
+ (h6 "Available memory")
+ ,@(let ((ram-available (assq-ref info #:ram-available))
+ (ram-available-chart "ram_available_chart"))
+ `((script (@ (src "/static/js/chart.js")))
+ (br)
+ (canvas (@ (id ,ram-available-chart)))
+ ,@(make-line-chart ram-available-chart
+ (list
+ (ram-available->json-scm ram-available))
+ #:time-x-axes? #t
+ #:x-label "Time"
+ #:y-label "GiB"
+ #:x-unit "minute"
+ #:title
+ "Available memory"
+ #:labels
+ '("Available memory")
+ #:colors (list "#3e95cd"))))
+ (br)
+ (h6 "Free store disk space percentage")
+ ,@(let ((store-free (assq-ref info #:store-free))
+ (store-free-chart "store_free_chart"))
+ `((script (@ (src "/static/js/chart.js")))
+ (br)
+ (canvas (@ (id ,store-free-chart)))
+ ,@(make-line-chart store-free-chart
+ (list (history->json-scm store-free))
+ #:time-x-axes? #t
+ #:x-label "Time"
+ #:y-label "Percentage"
+ #:x-unit "minute"
+ #:title
+ "Free store disk space percentage"
+ #:labels
+ '("Free store disk space percentage")
+ #:colors (list "#3e95cd"))))))))
diff --git a/src/cuirass/zabbix.scm b/src/cuirass/zabbix.scm
new file mode 100644
index 00000000..3ceff342
--- /dev/null
+++ b/src/cuirass/zabbix.scm
@@ -0,0 +1,172 @@
+;;; zabbix.scm -- Zabbix API connection.
+;;; Copyright 漏 2021 Mathieu Othacehe <othacehe@gnu.org>
+;;;
+;;; This file is part of Cuirass.
+;;;
+;;; 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 (cuirass zabbix)
+ #:use-module (guix import json)
+ #:use-module (web uri)
+ #:use-module (web client)
+ #:use-module (web response)
+ #:use-module (json)
+ #:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-11)
+ #:use-module (ice-9 match)
+ #:export (zabbix-api-version
+ zabbix-available?
+ zabbix-login
+ zabbix-logout
+ with-zabbix-connection
+ zabbix-host-id
+ zabbix-host-enabled?
+ zabbix-item-id
+ zabbix-item-value
+ zabbix-history))
+
+(define %zabbix-auth
+ (make-parameter #f))
+
+(define %zabbix-uri
+ (make-parameter
+ (getenv "CUIRASS_ZABBIX_URI")))
+
+(define %zabbix-user
+ (make-parameter
+ (or (getenv "CUIRASS_ZABBIX_USER") "Admin")))
+
+(define %zabbix-password
+ (make-parameter
+ (or (getenv "CUIRASS_ZABBIX_PASSWORD") "zabbix")))
+
+(define* (zabbix-request params)
+ (let ((headers `((User-Agent . "Cuirass")
+ (Accept . "application/json")
+ (Content-Type . "application/json"))))
+ (let-values (((response port)
+ (http-post (%zabbix-uri)
+ #:headers headers
+ #:body (string->utf8
+ (scm->json-string params))
+ #:streaming? #t)))
+ (cond ((= 200 (response-code response))
+ (let ((result (json->scm port)))
+ (close-port port)
+ (and result (assoc-ref result "result"))))
+ (else
+ (close-port port)
+ #f)))))
+
+(define* (zabbix-params method #:optional extra-params)
+ (let ((auth (%zabbix-auth)))
+ `(("jsonrpc" . "2.0")
+ ("method" . ,method)
+ ,@(if auth
+ `(("auth" . ,auth))
+ '())
+ ("params" . ,(or extra-params (vector)))
+ ("id" . 1))))
+
+(define (zabbix-type type)
+ (case type
+ ((float) 0)
+ ((character) 1)
+ ((log) 2)
+ ((unsigned) 3)
+ ((text) 4)))
+
+(define (zabbix-api-version)
+ (let* ((params (zabbix-params "apiinfo.version"))
+ (result (zabbix-request params)))
+ result))
+
+(define (zabbix-available?)
+ (and (%zabbix-uri)
+ (string? (zabbix-api-version))))
+
+(define (zabbix-login)
+ (let* ((params (zabbix-params "user.login"
+ `(("user" . ,(%zabbix-user))
+ ("password" . ,(%zabbix-password)))))
+ (result (zabbix-request params)))
+ (%zabbix-auth result)
+ result))
+
+(define (zabbix-logout)
+ (let* ((params (zabbix-params "user.logout"))
+ (result (zabbix-request params)))
+ (%zabbix-auth #f)
+ result))
+
+(define-syntax-rule (with-zabbix-connection exp ...)
+ (dynamic-wind
+ (lambda ()
+ (zabbix-login))
+ (lambda ()
+ exp ...)
+ (lambda ()
+ (zabbix-logout))))
+
+(define (zabbix-host-search host)
+ (let* ((params (zabbix-params "host.get"
+ `(("filter"
+ . (("host" . ,(vector host)))))))
+ (result (zabbix-request params)))
+ (match (vector->list result)
+ ((host) host)
+ (else #f))))
+
+(define (zabbix-host-id host)
+ (let ((host (zabbix-host-search host)))
+ (assoc-ref host "hostid")))
+
+(define (zabbix-host-enabled? host)
+ (let* ((host (zabbix-host-search host))
+ (status (assoc-ref host "status")))
+ (and status
+ (eq? (string->number status) 0))))
+
+(define (zabbix-item-search key host-id)
+ (let* ((params (zabbix-params "item.get"
+ `(("hostids" . ,host-id)
+ ("search"
+ . (("key_" . ,key))))))
+ (result (zabbix-request params)))
+ (match (vector->list result)
+ ((item) item )
+ (else #f))))
+
+(define (zabbix-item-id key host-id)
+ (let ((item (zabbix-item-search key host-id)))
+ (assoc-ref item "itemid")))
+
+(define (zabbix-item-value key host-id)
+ (let ((item (zabbix-item-search key host-id)))
+ (assoc-ref item "lastvalue")))
+
+(define* (zabbix-history item-id #:key limit type)
+ (define (format-item item)
+ (let ((clock (assoc-ref item "clock"))
+ (value (assoc-ref item "value")))
+ (cons (string->number clock) (string->number value))))
+
+ (let* ((params (zabbix-params "history.get"
+ `(("history" . ,(zabbix-type type))
+ ("itemids" . ,item-id)
+ ("sortfield" . "clock")
+ ("sortorder" . "DESC")
+ ("limit" . ,limit))))
+ (result (zabbix-request params)))
+ (map format-item (vector->list result))))
--
GitLab