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