ifunctions.lisp - reed-alert - Lightweight agentless alerting system for server Err bitreich.org 70 hgit clone git://bitreich.org/reed-alert/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/reed-alert/ URL:git://bitreich.org/reed-alert/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/reed-alert/ bitreich.org 70 1Log /scm/reed-alert/log.gph bitreich.org 70 1Files /scm/reed-alert/files.gph bitreich.org 70 1Refs /scm/reed-alert/refs.gph bitreich.org 70 1Tags /scm/reed-alert/tag bitreich.org 70 1README /scm/reed-alert/file/README.gph bitreich.org 70 1LICENSE /scm/reed-alert/file/LICENSE.gph bitreich.org 70 i--- Err bitreich.org 70 ifunctions.lisp (7313B) Err bitreich.org 70 i--- Err bitreich.org 70 i 1 ;;; let's hide the loading Err bitreich.org 70 i 2 (let ((*standard-output* (make-broadcast-stream))) Err bitreich.org 70 i 3 (require 'asdf)) Err bitreich.org 70 i 4 Err bitreich.org 70 i 5 (defparameter *tries* 3) Err bitreich.org 70 i 6 (defparameter *reminder* 0) Err bitreich.org 70 i 7 (defparameter *alerts* '()) Err bitreich.org 70 i 8 (defparameter *states-dir* "~/.reed-alert/states/") Err bitreich.org 70 i 9 (ensure-directories-exist *states-dir*) Err bitreich.org 70 i 10 Err bitreich.org 70 i 11 ;; simple hash function (Fowler Noll Vo) Err bitreich.org 70 i 12 ;; https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function Err bitreich.org 70 i 13 (defun fnv-hash(string) Err bitreich.org 70 i 14 "return a hash from a string" Err bitreich.org 70 i 15 (let ((FNV_prime 2) Err bitreich.org 70 i 16 (hash 26123230013)) Err bitreich.org 70 i 17 (loop for octet-of-data across string Err bitreich.org 70 i 18 do Err bitreich.org 70 i 19 (setf hash (* FNV_prime Err bitreich.org 70 i 20 (logxor hash (char-code octet-of-data))))) Err bitreich.org 70 i 21 hash)) Err bitreich.org 70 i 22 Err bitreich.org 70 i 23 ;; common-lisp don't have a split string function natively Err bitreich.org 70 i 24 (defun replace-all (string part replacement &key (test #'char=)) Err bitreich.org 70 i 25 (with-output-to-string (out) Err bitreich.org 70 i 26 (loop with part-length = (length part) Err bitreich.org 70 i 27 for old-pos = 0 then (+ pos part-length) Err bitreich.org 70 i 28 for pos = (search part string Err bitreich.org 70 i 29 :start2 old-pos Err bitreich.org 70 i 30 :test test) Err bitreich.org 70 i 31 do (write-string string out Err bitreich.org 70 i 32 :start old-pos Err bitreich.org 70 i 33 :end (or pos (length string))) Err bitreich.org 70 i 34 when pos do (write-string replacement out) Err bitreich.org 70 i 35 while pos))) Err bitreich.org 70 i 36 Err bitreich.org 70 i 37 (defmacro create-probe(name &body code) Err bitreich.org 70 i 38 `(progn Err bitreich.org 70 i 39 (defparameter ,name ',name) Err bitreich.org 70 i 40 (defun ,name(params) ,@code))) Err bitreich.org 70 i 41 Err bitreich.org 70 i 42 (defun get-file-size(path) Err bitreich.org 70 i 43 (with-open-file (stream path) Err bitreich.org 70 i 44 (and stream (file-length path)))) Err bitreich.org 70 i 45 Err bitreich.org 70 i 46 (defun command-return-code(command) Err bitreich.org 70 i 47 (let ((code (nth-value 2 (uiop:run-program command :ignore-error-status t)))) Err bitreich.org 70 i 48 (if (= 0 code) Err bitreich.org 70 i 49 t Err bitreich.org 70 i 50 (list nil (format nil "return code = ~a" code))))) Err bitreich.org 70 i 51 Err bitreich.org 70 i 52 (defmacro alert(name string) Err bitreich.org 70 i 53 `(progn Err bitreich.org 70 i 54 (defparameter ,name ',name) Err bitreich.org 70 i 55 (push (list ',name ,string) Err bitreich.org 70 i 56 *alerts*))) Err bitreich.org 70 i 57 Err bitreich.org 70 i 58 (defmacro strcat(&body body) Err bitreich.org 70 i 59 `(progn Err bitreich.org 70 i 60 (concatenate 'string ,@body))) Err bitreich.org 70 i 61 Err bitreich.org 70 i 62 (defun trigger-alert(level function params result state) Err bitreich.org 70 i 63 (let* ((notifier-command (assoc level *alerts*)) Err bitreich.org 70 i 64 (command-string (cadr notifier-command))) Err bitreich.org 70 i 65 (setf command-string (replace-all command-string "%state%" (cond Err bitreich.org 70 i 66 ((eql state 'START) "Begin") Err bitreich.org 70 i 67 ((eql state 'REMINDER) "Reminder") Err bitreich.org 70 i 68 (t "End")))) Err bitreich.org 70 i 69 (setf command-string (replace-all command-string "%result%" (format nil "~a" result))) Err bitreich.org 70 i 70 (setf command-string (replace-all command-string "%hostname%" (machine-instance))) Err bitreich.org 70 i 71 (setf command-string (replace-all command-string "%os%" (software-type))) Err bitreich.org 70 i 72 (setf command-string (replace-all command-string "%function%" (format nil "~a" function))) Err bitreich.org 70 i 73 (setf command-string (replace-all command-string "%params%" (format nil "~a" params))) Err bitreich.org 70 i 74 (setf command-string (replace-all command-string "%desc%" (getf params :desc ""))) Err bitreich.org 70 i 75 (setf command-string (replace-all command-string "%newline%" (string #\Newline))) Err bitreich.org 70 i 76 (setf command-string (replace-all command-string "%level%" level)) Err bitreich.org 70 i 77 (setf command-string (replace-all command-string "%date%" Err bitreich.org 70 i 78 (multiple-value-bind Err bitreich.org 70 i 79 (second minute hour day month year) Err bitreich.org 70 i 80 (get-decoded-time) Err bitreich.org 70 i 81 (format nil "~d-~2,'0d-~2,'0d ~2,'0d:~2,'0d:~2,'0d" year month day hour minute second)))) Err bitreich.org 70 i 82 command-string)) Err bitreich.org 70 i 83 Err bitreich.org 70 i 84 (defmacro stop-if-error(&body body) Err bitreich.org 70 i 85 `(progn Err bitreich.org 70 i 86 (and ,@body))) Err bitreich.org 70 i 87 Err bitreich.org 70 i 88 (defmacro escalation(&body body) Err bitreich.org 70 i 89 `(progn Err bitreich.org 70 i 90 (or ,@body))) Err bitreich.org 70 i 91 Err bitreich.org 70 i 92 (defun =>(level fonction &rest params) Err bitreich.org 70 i 93 (let* ((hash (fnv-hash (format nil "~{~a~}" (remove-if #'symbolp params)))) Err bitreich.org 70 i 94 (result (funcall fonction params)) Err bitreich.org 70 i 95 (filename (format nil "~a-~a-~a" level fonction hash)) Err bitreich.org 70 i 96 (filepath (format nil "~a/~a" *states-dir* filename)) Err bitreich.org 70 i 97 (current-state nil) ;; default state is a failure Err bitreich.org 70 i 98 (previous-state nil) Err bitreich.org 70 i 99 (trigger-state 'no)) Err bitreich.org 70 i 100 Err bitreich.org 70 i 101 ;; we open the file to read the number of tries Err bitreich.org 70 i 102 ;; if no fail then we have 0 try Err bitreich.org 70 i 103 (let* ((tries (if (not (probe-file filepath)) Err bitreich.org 70 i 104 0 Err bitreich.org 70 i 105 (with-open-file (stream filepath :direction :input) Err bitreich.org 70 i 106 (parse-integer (read-line stream 0 nil))))) Err bitreich.org 70 i 107 (triggered-before? (>= tries (getf params :try *tries*)))) Err bitreich.org 70 i 108 Err bitreich.org 70 i 109 ;; if result is a list then the check had fail a return both nil and the error value Err bitreich.org 70 i 110 ;; if result is not a list, then it was successful Err bitreich.org 70 i 111 (if (not (listp result)) Err bitreich.org 70 i 112 Err bitreich.org 70 i 113 ;; SUCCESS HANDLING Err bitreich.org 70 i 114 (progn Err bitreich.org 70 i 115 Err bitreich.org 70 i 116 ;; mark state as success Err bitreich.org 70 i 117 (setf current-state t) Err bitreich.org 70 i 118 Err bitreich.org 70 i 119 ;; we delete the file with previous states Err bitreich.org 70 i 120 (when (probe-file filepath) Err bitreich.org 70 i 121 (delete-file filepath)) Err bitreich.org 70 i 122 Err bitreich.org 70 i 123 ;; it was a failure and then it's back to normal state Err bitreich.org 70 i 124 (if triggered-before? Err bitreich.org 70 i 125 (progn Err bitreich.org 70 i 126 (uiop:run-program (trigger-alert level fonction params t 'success) :output t) Err bitreich.org 70 i 127 (setf previous-state nil)) Err bitreich.org 70 i 128 (setf previous-state t))) Err bitreich.org 70 i 129 Err bitreich.org 70 i 130 ;; FAILURE HANDLING Err bitreich.org 70 i 131 (let ((trigger-now? (or Err bitreich.org 70 i 132 ;; we add +1 to tries because it's failing right now Err bitreich.org 70 i 133 (and (= (+ 1 tries) (getf params :try *tries*)) Err bitreich.org 70 i 134 'START) ;; it starts failing Err bitreich.org 70 i 135 Err bitreich.org 70 i 136 ;; if reminder is set and a valid value (> 0) Err bitreich.org 70 i 137 (when (< 0 (getf params :reminder *reminder*)) Err bitreich.org 70 i 138 (and (= 0 (mod (+ 1 tries) (getf params :reminder *reminder*))) Err bitreich.org 70 i 139 'REMINDER))))) ;; do we need to remind it's failing? Err bitreich.org 70 i 140 Err bitreich.org 70 i 141 ;; more error than limit, send alert once Err bitreich.org 70 i 142 (when trigger-now? Err bitreich.org 70 i 143 (setf trigger-state 'YES) Err bitreich.org 70 i 144 (uiop:run-program (trigger-alert level fonction params (cadr result) trigger-now?))) Err bitreich.org 70 i 145 ;; increment the number of tries by 1 Err bitreich.org 70 i 146 (with-open-file (stream-out filepath :direction :output Err bitreich.org 70 i 147 :if-exists :supersede) Err bitreich.org 70 i 148 (format stream-out "~a~%~a~%" (+ 1 tries) params)) Err bitreich.org 70 i 149 nil)) Err bitreich.org 70 i 150 Err bitreich.org 70 i 151 (format t "~a ~A ~{~A ~} ~A ~A ~A ~A ~A~%" Err bitreich.org 70 i 152 level Err bitreich.org 70 i 153 fonction Err bitreich.org 70 i 154 Err bitreich.org 70 i 155 ;; returns params without :desc keyword and associated value Err bitreich.org 70 i 156 (let ((desc-pos (position :desc params))) Err bitreich.org 70 i 157 (if desc-pos Err bitreich.org 70 i 158 (remove nil Err bitreich.org 70 i 159 (loop for i in params Err bitreich.org 70 i 160 counting t into j Err bitreich.org 70 i 161 collect Err bitreich.org 70 i 162 (when (not (or Err bitreich.org 70 i 163 (= j (+ 1 desc-pos)) Err bitreich.org 70 i 164 (= j (+ 2 desc-pos)))) Err bitreich.org 70 i 165 i))) Err bitreich.org 70 i 166 params)) Err bitreich.org 70 i 167 (getf params :desc "") Err bitreich.org 70 i 168 (if previous-state "SUCCESS" "ERROR") Err bitreich.org 70 i 169 (if current-state "SUCCESS" "ERROR") Err bitreich.org 70 i 170 trigger-state Err bitreich.org 70 i 171 ;; use tries variable only if previous errors Err bitreich.org 70 i 172 (if previous-state Err bitreich.org 70 i 173 0 Err bitreich.org 70 i 174 (+ 1 tries)))) Err bitreich.org 70 i 175 current-state)) Err bitreich.org 70 i 176 Err bitreich.org 70 i 177 ;; abort when using ctrl+c instead of dropping to debugger Err bitreich.org 70 i 178 #+ecl Err bitreich.org 70 i 179 (ext:set-signal-handler ext:+sigint+ #'quit) Err bitreich.org 70 .