guix
/
guix-cuirass
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Add Zabbix support.

This commit is contained in:
Mathieu Othacehe 2021-02-08 12:25:47 +01:00 committed by Mathieu Othacehe
parent 7aa1d9156a
commit ac98f81671
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
4 changed files with 358 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile.am
View File

@ -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

58
src/cuirass/http.scm
View File

@ -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))
(_

129
src/cuirass/templates.scm
View File

@ -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"))))))))

172
src/cuirass/zabbix.scm Normal file
View File

@ -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))))