path: root/elisp/cmk.el

;;; cmk.el --- CMK livestatus -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2022 Óscar Nájera
;;
;; Author: Óscar Nájera <hi@oscarnajera.com>
;; Maintainer: Óscar Nájera <hi@oscarnajera.com>
;; Created: July 08, 2022
;; Modified: July 08, 2022
;; Version: 0.0.1
;; Keywords: abbrev bib c calendar comm convenience data docs emulations extensions faces files frames games hardware help hypermedia i18n internal languages lisp local maint mail matching mouse multimedia news outlines processes terminals tex tools unix vc wp
;; Homepage: https://github.com/titan/cmk
;; Package-Requires: ((emacs "29.1"))
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;;  CMK livestatus
;;
;;; Code:

(require 'cl-lib)
;; (require 'company)
(require 'map)
(require 'csv-mode)
(require 'dash)
(require 'subr-x)
(require 'vtable)

(defun cmk-state-coloring (state)
  "Font color for numeric STATE input as string."
  (pcase state
    (0 (propertize "OK" 'face 'font-lock-string-face))
    (1 (propertize "WARN" 'face 'font-lock-warning-face))
    (2 (propertize "CRIT" 'face 'font-lock-keyword-face))
    (3 (propertize "UNKN" 'face 'font-lock-builtin-face))
    (_ state)))

(defun cmk-timestamp-to-date (timestamp &optional fmt-str)
  "TIMESTAMP to human readable date follownig FMT-STR.
Default is  \"%Y-%m-%d %H:%M\"."
  (thread-last
    (if (stringp timestamp)
        (string-to-number timestamp)
      timestamp)
    (seconds-to-time)
    (format-time-string (or fmt-str "%Y-%m-%d %H:%M"))))

(defun cmk-purge-bangs (str)
  "Remove cmk status output bangs from STR."
  (replace-regexp-in-string (rx "(" (+ "!") ")") "" str))

(defun cmk-oneshot (&optional keep-buffer)
  "One shot socket connection. non-nil KEEP-BUFFER after socket closes."
  (make-network-process
   :name "Checkmk"
   :host 'local
   :service 6565
   :buffer "CMK"
   :sentinel (lambda (process event)
               (message "Process: %s had the event '%s'" process (string-trim event))
               (unless keep-buffer
                 (kill-buffer (process-buffer process))))))

(defun cmk-colums-from-spec (spec)
  "Extract the column names from SPEC and return a livestatus column command."
  (concat "Columns: "
          (mapconcat
           (lambda (column)
             (or (plist-get column :column)
                 (plist-get column :name)))
           spec
           " ")))

(defconst cmk-problem-col-spec
  `((:name "STATE"        :column "service_state" :formatter cmk-state-coloring :min-width 6)
    (:name "Host"         :column "host_name")
    (:name "Service"      :column "service_description")
    (:name "Since"        :column "service_last_state_change" :formatter cmk-timestamp-to-date :min-width 18)
    (:name "Check output" :column "service_plugin_output" :formatter cmk-purge-bangs)))

(defconst cmk-log-col-spec
  '(;("host_state" :column "host_state" :parser cmk-state-coloring)
    (:name "STATE" :min-width 6 :column "log_state" :formatter cmk-state-coloring)
    ;; ("lsttype" :column "log_state_type")
    (:name "Host" :column "host_name")
    (:name "Service" :column "service_description")
    (:name "log_time" :min-width 18 :column "log_time" :formatter cmk-timestamp-to-date)
    ;; ("log_command_name" :column "log_command_name")
    ;; ("log_comment" :column "log_comment")
    ;; ("lineno" :column "log_lineno")
    (:name "log_type" :column "log_type")
    ;; ("host_scheduled_downtime_depth" :column "host_scheduled_downtime_depth")
    ;; ("host_has_been_checked" :column "host_has_been_checked")
    (:name "log_plugin_output" :column "log_plugin_output")))

(defun cmk-livestatus-query (query)
  "One shot livestatus QUERY, return network process."
  (let ((cmks (cmk-oneshot 'keep)))
    (with-current-buffer (process-buffer cmks) (erase-buffer))
    (process-send-string cmks query)
    cmks))

(defvar-local cmk-livestatus-query ""
  "Livestatus query in buffer.")

(defun cmk-timestamp-eldoc-documentation ()
  (when-let ((number (thing-at-point 'number)))
    (format-time-string "%Y-%m-%d %H:%M" (seconds-to-time number))))

(defconst cmk-livestatus-headers
  '("Filter" "Columns" "Stats" "Limit" "ColumnHeaders" "OutputFormat"))

(define-derived-mode cmk-livestatus-mode prog-mode "livestatus"
  "Major mode for viewing journalctl output."
  (add-function :before-until (local 'eldoc-documentation-function)
                #'cmk-timestamp-eldoc-documentation)
  ;; (setq-local company-backends (cons 'company-cmk-lq company-backends))
  ;; (setq-local completion-at-point-functions '(cmk-lq-capf))
  (add-hook 'completion-at-point-functions 'cmk-lq-capf nil 'local)
  ;; code for syntax highlighting
  (setq font-lock-defaults `(((,(rx bol "GET" eow) . font-lock-keyword-face)
                              (,(rx word-start (or "hosts" "services")  word-end) . font-lock-constant-face)
                              (,(concat "^" (regexp-opt cmk-livestatus-headers 'words) ":[[:space:]]") . font-lock-function-name-face)
                              (,(rx bol (or "And" "Or" "Negate") ":" whitespace) . font-lock-keyword-face)
                              (,(rx whitespace (or "~" "=" "=~" "~~" "<" ">" "<=" ">=") whitespace) . font-lock-keyword-face)))))

(defun cmk-custom-livestatus-query ()
  "Open buffer to write a livestatus query."
  (interactive)
  (let ((query cmk-livestatus-query)
        (edit-buffer (get-buffer-create "*LQ*")))
    (with-current-buffer edit-buffer
      (cmk-livestatus-mode)
      (if (string-blank-p query) (insert "GET ") (insert query))
      (local-set-key "\C-c\C-c"
                     (lambda ()
                       (interactive)
                       (let ((new-query (-> (buffer-string) (string-trim) (concat "\n\n"))))
                         (kill-buffer)
                         (let ((cmk (cmk-livestatus-query new-query)))
                           (switch-to-buffer (process-buffer cmk))
                           (csv-set-separator ?\;)
                           (csv-align-mode)
                           (setq-local cmk-livestatus-query new-query))))))
    (switch-to-buffer edit-buffer)))

(defun company-cmk-lq (command &optional arg &rest _ignored)
  (interactive (list 'interactive))
  (cl-case command
    (interactive (company-begin-backend 'company-cmk-lq))
    (prefix (company-grab-word))
    (candidates (cl-loop for header in cmk-livestatus-headers
                         when (string-prefix-p arg header t) collect header))
    (meta (format "This value is named %s" arg))))

(defun cmk-lq-capf ()
  (when (looking-back (rx bol (+ alpha)) 1)
    (list (match-beginning 0)
          (match-end 0)
          (cl-loop for header in cmk-livestatus-headers
                   when (string-prefix-p (match-string-no-properties 0) header t)
                   collect (concat header ": ")))))

(defun cmk-livestatus->json (query)
  "Send QUERY to livestatus then parse the result assuming is JSON."
  (let ((cmks (cmk-livestatus-query query)))
    (accept-process-output cmks 0.1)
    (with-current-buffer (process-buffer cmks)
      (goto-char (point-min))
      (json-parse-buffer :array-type 'list))))

(defun cmk-vtable-revert (livestatus-query)
  "Regenerate the table under point with the updated LIVESTATUS-QUERY."
  (let ((table (vtable-current-table))
        (object (vtable-current-object))
        (column (vtable-current-column))
        (inhibit-read-only t))
    (unless table
      (user-error "No table under point"))
    (setf (vtable-objects table) (cmk-livestatus->json livestatus-query))
    (vtable--clear-cache table)
    (delete-region (progn (text-property-search-backward 'vtable) (point))
                   (progn (text-property-search-forward 'vtable) (point)))
    (vtable-insert table)
    (cmk-add-text-properties-to-table (list 'livestatus-query livestatus-query))
    (when object
      (vtable-goto-object object))
    (when column
      (vtable-goto-column column))))

(defun cmk-add-text-properties-to-table (properties)
  "Add PROPERTIES a plist to the current table under point."
  (add-text-properties (progn (text-property-search-backward 'vtable) (point))
                       (progn (text-property-search-forward 'vtable) (point))
                       properties))

(cl-defun cmk-edit-lq ()
  "Open window to edit the livestatus query of current BUFFER."
  (interactive)
  (let ((buffer (current-buffer))
        (edit-buffer (get-buffer-create "*LQ*"))
        (query (get-text-property (point) 'livestatus-query)))
    (with-current-buffer edit-buffer
      (cmk-livestatus-mode)
      (insert query)
      (local-set-key "\C-c\C-c"
                     (lambda ()
                       (interactive)
                       (let ((new-query (-> (buffer-string) (string-trim) (concat "\n\n"))))
                         (kill-buffer)
                         (switch-to-buffer buffer)
                         (cmk-vtable-revert new-query)))))
    (switch-to-buffer edit-buffer)))

(defun cmk-vtable (table spec filters)
  "Render a tabular view for livestatus TABLE with SPEC columns using FILTERS."
  (let ((livestatus-query
         (format "GET %s\n%s\n%s\n%s\n\n"
                 table
                 (cmk-colums-from-spec spec)
                 filters
                 "OutputFormat: json")))
    (make-vtable
     :columns (mapcar (lambda (li) (map-delete (map-copy li) :column)) spec)
     :use-header-line nil
     :objects (cmk-livestatus->json livestatus-query)
     :keymap (define-keymap
               "Q" #'cmk-edit-lq
               "q" #'kill-current-buffer))
    (cmk-add-text-properties-to-table (list 'livestatus-query livestatus-query))))

(defun cmk-problems ()
  "Render default problems view."
  (interactive)
  (let ((inhibit-read-only t))
    (with-current-buffer (get-buffer-create "*CMK View*")
      (special-mode)
      (erase-buffer)
      (cmk-vtable "services" cmk-problem-col-spec
                  "Filter: service_state = 0
Filter: service_has_been_checked = 1
And: 2
Negate:
Filter: service_has_been_checked = 1
Filter: service_scheduled_downtime_depth = 0
Filter: host_scheduled_downtime_depth = 0
And: 2
Filter: service_acknowledged = 0
Filter: host_state = 1
Filter: host_has_been_checked = 1
And: 2
Negate:
Filter: host_state = 2
Filter: host_has_been_checked = 1
And: 2
Negate:")
      (goto-char (point-max))
      (insert "\n")
      (cmk-vtable "log" cmk-log-col-spec
                  (format
                   "Filter: log_time >= %d
Filter: class = 1
Filter: class = 3
Filter: class = 8
Or: 3
Filter: log_state_type = HARD"
                   (floor
                    (- (time-to-seconds (current-time))
                       (* 24 3600)))))
      (display-buffer (current-buffer)))))

(provide 'cmk)
;;; cmk.el ends here