;;; 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)