mirror of git://bitreich.org/reed-alert
180 lines
7.1 KiB
Common Lisp
180 lines
7.1 KiB
Common Lisp
;;; let's hide the loading
|
|
(let ((*standard-output* (make-broadcast-stream)))
|
|
(require 'asdf))
|
|
|
|
(defparameter *tries* 3)
|
|
(defparameter *reminder* 0)
|
|
(defparameter *alerts* '())
|
|
(defparameter *states-dir* "~/.reed-alert/states/")
|
|
(ensure-directories-exist *states-dir*)
|
|
|
|
;; simple hash function (Fowler Noll Vo)
|
|
;; https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function
|
|
(defun fnv-hash(string)
|
|
"return a hash from a string"
|
|
(let ((FNV_prime 2)
|
|
(hash 26123230013))
|
|
(loop for octet-of-data across string
|
|
do
|
|
(setf hash (* FNV_prime
|
|
(logxor hash (char-code octet-of-data)))))
|
|
hash))
|
|
|
|
;; common-lisp don't have a split string function natively
|
|
(defun replace-all (string part replacement &key (test #'char=))
|
|
(with-output-to-string (out)
|
|
(loop with part-length = (length part)
|
|
for old-pos = 0 then (+ pos part-length)
|
|
for pos = (search part string
|
|
:start2 old-pos
|
|
:test test)
|
|
do (write-string string out
|
|
:start old-pos
|
|
:end (or pos (length string)))
|
|
when pos do (write-string replacement out)
|
|
while pos)))
|
|
|
|
(defmacro create-probe(name &body code)
|
|
`(progn
|
|
(defparameter ,name ',name)
|
|
(defun ,name(params) ,@code)))
|
|
|
|
(defun get-file-size(path)
|
|
(with-open-file (stream path)
|
|
(and stream (file-length path))))
|
|
|
|
(defun command-return-code(command)
|
|
(let ((code (nth-value 2 (uiop:run-program command :ignore-error-status t))))
|
|
(if (= 0 code)
|
|
t
|
|
(list nil (format nil "return code = ~a" code)))))
|
|
|
|
(defmacro alert(name string)
|
|
`(progn
|
|
(defparameter ,name ',name)
|
|
(push (list ',name ,string)
|
|
*alerts*)))
|
|
|
|
(defmacro strcat(&body body)
|
|
`(progn
|
|
(concatenate 'string ,@body)))
|
|
|
|
(defun trigger-alert(level function params result state)
|
|
(let* ((notifier-command (assoc level *alerts*))
|
|
(command-string (cadr notifier-command)))
|
|
(setf command-string (replace-all command-string "%state%" (cond
|
|
((eql state 'START) "Begin")
|
|
((eql state 'REMINDER) "Reminder")
|
|
(t "End"))))
|
|
(setf command-string (replace-all command-string "%result%" (format nil "~a" result)))
|
|
(setf command-string (replace-all command-string "%hostname%" (machine-instance)))
|
|
(setf command-string (replace-all command-string "%os%" (software-type)))
|
|
(setf command-string (replace-all command-string "%function%" (format nil "~a" function)))
|
|
(setf command-string (replace-all command-string "%params%" (format nil "~a" params)))
|
|
(setf command-string (replace-all command-string "%desc%" (getf params :desc "")))
|
|
(setf command-string (replace-all command-string "%newline%" (string #\Newline)))
|
|
(setf command-string (replace-all command-string "%level%" level))
|
|
(setf command-string (replace-all command-string "%date%"
|
|
(multiple-value-bind
|
|
(second minute hour day month year)
|
|
(get-decoded-time)
|
|
(format nil "~d-~2,'0d-~2,'0d ~2,'0d:~2,'0d:~2,'0d" year month day hour minute second))))
|
|
command-string))
|
|
|
|
(defmacro stop-if-error(&body body)
|
|
`(progn
|
|
(and ,@body)))
|
|
|
|
(defmacro escalation(&body body)
|
|
`(progn
|
|
(or ,@body)))
|
|
|
|
(defun =>(level fonction &rest params)
|
|
(let* ((hash (fnv-hash (format nil "~{~a~}" (remove-if #'symbolp params))))
|
|
(result (funcall fonction params))
|
|
(filename (format nil "~a-~a-~a" level fonction hash))
|
|
(filepath (format nil "~a/~a" *states-dir* filename))
|
|
(current-state nil) ;; default state is a failure
|
|
(previous-state nil)
|
|
(trigger-state 'no))
|
|
|
|
;; we open the file to read the number of tries
|
|
;; if no fail then we have 0 try
|
|
(let* ((tries (if (not (probe-file filepath))
|
|
0
|
|
(with-open-file (stream filepath :direction :input)
|
|
(parse-integer (read-line stream 0 nil)))))
|
|
(triggered-before? (>= tries (getf params :try *tries*))))
|
|
|
|
;; if result is a list then the check had fail a return both nil and the error value
|
|
;; if result is not a list, then it was successful
|
|
(if (not (listp result))
|
|
|
|
;; SUCCESS HANDLING
|
|
(progn
|
|
|
|
;; mark state as success
|
|
(setf current-state t)
|
|
|
|
;; we delete the file with previous states
|
|
(when (probe-file filepath)
|
|
(delete-file filepath))
|
|
|
|
;; it was a failure and then it's back to normal state
|
|
(if triggered-before?
|
|
(progn
|
|
(uiop:run-program (trigger-alert level fonction params t 'success) :output t)
|
|
(setf previous-state nil))
|
|
(setf previous-state t)))
|
|
|
|
;; FAILURE HANDLING
|
|
(let ((trigger-now? (or
|
|
;; we add +1 to tries because it's failing right now
|
|
(and (= (+ 1 tries) (getf params :try *tries*))
|
|
'START) ;; it starts failing
|
|
|
|
;; if reminder is set and a valid value (> 0)
|
|
(when (< 0 (getf params :reminder *reminder*))
|
|
(and (= 0 (mod (+ 1 tries) (getf params :reminder *reminder*)))
|
|
'REMINDER))))) ;; do we need to remind it's failing?
|
|
|
|
;; more error than limit, send alert once
|
|
(when trigger-now?
|
|
(setf trigger-state 'YES)
|
|
(uiop:run-program (trigger-alert level fonction params (cadr result) trigger-now?)))
|
|
;; increment the number of tries by 1
|
|
(with-open-file (stream-out filepath :direction :output
|
|
:if-exists :supersede)
|
|
(format stream-out "~a~%~a~%" (+ 1 tries) params))
|
|
nil))
|
|
|
|
(format t "~a ~A ~{~A ~} ~A ~A ~A ~A ~A~%"
|
|
level
|
|
fonction
|
|
|
|
;; returns params without :desc keyword and associated value
|
|
(let ((desc-pos (position :desc params)))
|
|
(if desc-pos
|
|
(remove nil
|
|
(loop for i in params
|
|
counting t into j
|
|
collect
|
|
(when (not (or
|
|
(= j (+ 1 desc-pos))
|
|
(= j (+ 2 desc-pos))))
|
|
i)))
|
|
params))
|
|
(getf params :desc "")
|
|
(if previous-state "SUCCESS" "ERROR")
|
|
(if current-state "SUCCESS" "ERROR")
|
|
trigger-state
|
|
;; use tries variable only if previous errors
|
|
(if previous-state
|
|
0
|
|
(+ 1 tries))))
|
|
current-state))
|
|
|
|
;; abort when using ctrl+c instead of dropping to debugger
|
|
#+ecl
|
|
(ext:set-signal-handler ext:+sigint+ #'quit)
|