diff options
| -rw-r--r-- | guix.scm | 104 | ||||
| -rw-r--r-- | zabbix.scm | 138 | ||||
| -rw-r--r-- | zabbix_guix | 4 |
3 files changed, 246 insertions, 0 deletions
diff --git a/guix.scm b/guix.scm new file mode 100644 index 0000000..9fddd7f --- /dev/null +++ b/guix.scm @@ -0,0 +1,104 @@ +;; guix.scm --- Guix package for Zabbix-Guix +;; Copyright © 2019 Oleg Pykhalov <go.wigust@gmail.com> +;; Released under the GNU GPLv3 or any later version. + +(use-modules ((guix licenses) #:prefix license:) + (guix build-system guile) + (guix build utils) + (guix packages) + (guix gexp) + (guix git-download) + (ice-9 popen) + (ice-9 rdelim) + (gnu packages bash) + (gnu packages guile) + (gnu packages package-management)) + +(define %source-dir (dirname (current-filename))) + +(define (git . args) + "Execute 'git ARGS ...' command and return its output without trailing +newspace." + (with-directory-excursion %source-dir + (let* ((port (apply open-pipe* OPEN_READ "git" args)) + (output (read-string port))) + (close-port port) + (string-trim-right output #\newline)))) + +(let ((commit (git "log" "-n" "1" "--pretty=format:%H"))) + (package + (name "zabbix-guix") + (version (string-append "0.0.1" "-" (string-take commit 7))) + (source (local-file %source-dir + #:recursive? #t + #:select? (git-predicate %source-dir))) + (build-system guile-build-system) + (inputs + `(("bash" ,bash))) + (native-inputs + `(("guile" ,guile-2.2) + ("guile-json" ,guile-json) + ("guix" ,guix) + ,@(package-propagated-inputs guix))) + (arguments + `(#:modules ((guix build guile-build-system) + (guix build utils) + (srfi srfi-26) + (ice-9 popen) + (ice-9 rdelim)) + #:phases + (modify-phases %standard-phases + (replace 'unpack + (lambda* (#:key inputs #:allow-other-keys) + (for-each (lambda (file) + (copy-file (string-append (assoc-ref inputs "source") "/" file) + (string-append "./" file))) + '("zabbix_guix" "zabbix.scm")))) + (add-after 'unpack 'setenv + (lambda _ + (setenv "PATH" + (string-append (assoc-ref %build-inputs "bash") "/bin" ":" + (getenv "PATH"))))) + (add-after 'install 'install-script + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin")) + (zabbix-guix (string-append bin "/zabbix_guix")) + (guile (assoc-ref inputs "guile")) + (guile-bin (string-append guile "/bin/guile")) + (git (assoc-ref inputs "guile-git")) + (bs (assoc-ref inputs "guile-bytestructures")) + (gcrypt (assoc-ref inputs "guile-gcrypt")) + (json (assoc-ref inputs "guile-json")) + (guix (assoc-ref inputs "guix")) + (deps (list out gcrypt json bs git guix)) + (effective + (read-line + (open-pipe* OPEN_READ guile-bin + "-c" "(display (effective-version))"))) + (path (string-join + (map (cut string-append <> + "/share/guile/site/" + effective) + deps) + ":")) + (gopath (string-join + (map (cut string-append <> + "/lib/guile/" effective + "/site-ccache") + deps) + ":"))) + (mkdir-p bin) + (substitute* "./zabbix_guix" + (("\\$\\(which guile\\)") guile-bin)) + (install-file "./zabbix_guix" bin) + (chmod zabbix-guix #o555) + (wrap-program zabbix-guix + `("GUILE_LOAD_PATH" ":" prefix (,path)) + `("GUILE_LOAD_COMPILED_PATH" ":" prefix (,gopath))) + #t)))))) + (home-page "https://anongit.duckdns.org/guix/zabbix-guix") + (description "This package provides a Guile script to monitor Guix +channels difference.") + (synopsis "Monitor Guix in Zabbix") + (license license:gpl3+))) diff --git a/zabbix.scm b/zabbix.scm new file mode 100644 index 0000000..4237140 --- /dev/null +++ b/zabbix.scm @@ -0,0 +1,138 @@ +;; zabbix.scm --- Monitor Guix in Zabbix. +;; Copyright © 2019 Oleg Pykhalov <go.wigust@gmail.com> +;; Released under the GNU GPLv3 or any later version. + +(define-module (zabbix) + #:use-module (guix channels) + #:use-module (guix describe) + #:use-module (guix profiles) + #:use-module (ice-9 match) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) + #:use-module (json) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37)) + +(define (git . args) + "Execute 'git ARGS ...' command and return its output without trailing +newspace." + (let* ((port (apply open-pipe* OPEN_READ "git" args)) + (output (read-string port))) + (close-port port) + (string-trim-right output #\newline))) + +(define (remote-channels channels) + (map (lambda (c) + (match (string-split (git "ls-remote" (channel-url c) + (string-append "*/" (channel-branch c))) + #\tab) + ((commit ref) + (channel (name (channel-name c)) + (url (channel-url c)) + (commit commit) + (branch (channel-branch c)) + (location #f))))) + (eval (begin (use-modules (guix channels)) + (with-input-from-file channels read)) + (current-module)))) + +(define (channels profile) + (define number + (generation-number profile)) + + (map (lambda (entry) + (match (assq 'source (manifest-entry-properties entry)) + (('source ('repository ('version 0) + ('url url) + ('branch branch) + ('commit commit) + _ ...)) + (channel (name (string->symbol (manifest-entry-name entry))) + (url url) + (commit commit) + (location #f))) + + ;; Pre-0.15.0 Guix does not provide that information, + ;; so there's not much we can do in that case. + (_ (channel (name 'guix) + (url "?") + (commit "?"))))) + + ;; Show most recently installed packages last. + (reverse + (manifest-entries + (profile-manifest + (if (zero? number) + profile + (generation-file-name profile number))))))) + +(define %options + (let ((display-and-exit-proc (lambda (msg) + (lambda (opt name arg loads) + (display msg) (quit))))) + (list (option '(#\v "version") #f #f + (display-and-exit-proc "Guiz version 0.0.1\n")) + (option '(#\h "help") #f #f + (display-and-exit-proc + "Usage: foo scheme-file ...")) + (option '(#\A "available") #f #t + (lambda (opt name arg loads) + (cons `(query list-available ,(or arg "")) + loads))) + (option '(#\d "diff") #t #f + (lambda (opt name arg loads) + (cons `(query diff ,(or arg "")) + loads))) + (option '(#\p "profile") #t #f + (lambda (opt name arg loads) + (alist-cons 'profile (canonicalize-profile arg) + loads))) + (option '(#\r "remote") #t #f + (lambda (opt name arg loads) + (alist-cons 'remote arg loads)))))) + +(define %default-options + '()) + +(define (main args) + (define opts + (args-fold (cdr (program-arguments)) + %options + (lambda (opt name arg loads) + (error "Unrecognized option `~A'" name)) + (lambda (op loads) + (cons op loads)) + %default-options)) + + (define (find-channel-name name channels) + (fold (lambda (x xs) + (if (string=? (symbol->string (channel-name x)) name) + (cons x xs) + xs)) + '() + channels)) + + (define remote (or (assq-ref opts 'remote) + (string-append (getenv "HOME") "/.config/guix/channels.scm"))) + + (define profile (or (assq-ref opts 'profile) (current-profile))) + + (match (assoc-ref opts 'query) + (('list-available name) + (scm->json + `((data ,@(map (lambda (local remote) + `(("{#REMOTE_NAME}" . ,(channel-name remote)) + ("{#REMOTE_URL}" . ,(channel-url remote)) + ("{#REMOTE_COMMIT}" . ,(channel-commit remote)) + ("{#LOCAL_NAME}" . ,(channel-name local)) + ("{#LOCAL_URL}" . ,(channel-url local)) + ("{#LOCAL_COMMIT}" . ,(channel-commit local)))) + (channels profile) + (remote-channels remote)))))) + (('diff name) + (map (lambda (local remote) + (if (string=? name (symbol->string (channel-name local))) + (begin (display 0) (exit 1)) + (begin (display 1) (exit 0)))) + (channels profile) + (remote-channels remote))))) diff --git a/zabbix_guix b/zabbix_guix new file mode 100644 index 0000000..b220d40 --- /dev/null +++ b/zabbix_guix @@ -0,0 +1,4 @@ +#!/bin/sh +# -*- scheme -*- +exec ${GUILE:-$(which guile)} $GUILE_FLAGS --no-auto-compile -e '(@@ (zabbix) main)' -s "$0" "$@" +!# |