From imattsson at common-lisp.net Tue Apr 28 17:53:08 2009 From: imattsson at common-lisp.net (imattsson) Date: Tue, 28 Apr 2009 13:53:08 -0400 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv8227 Modified Files: noctool.asd classes.lisp Added Files: todolist.lisp Log Message: IM To-do list added to the system, no Obvious Intended Use at the moment, but it seems to fit and is an easy implementation. There may be some new things for the Nagios shimmage, including but not limited to, a new dependency on cl+ssl. --- /project/noctool/cvsroot/source/noctool.asd 2009/02/11 16:41:22 1.7 +++ /project/noctool/cvsroot/source/noctool.asd 2009/04/28 17:53:07 1.8 @@ -4,7 +4,7 @@ :author "Ingvar Mattsson / Jim Prewett" :license "GPL" :version "0.1" - :depends-on (:usocket :cl-ppcre :ironclad :image :sb-posix) + :depends-on (:usocket :cl-ppcre :ironclad :image :sb-posix :cl+ssl) :components ((:file "packages") (:file "scheduler" :depends-on ("packages")) (:file "network-globals" :depends-on ("packages")) @@ -22,4 +22,6 @@ (:file "network-utils" :depends-on ("packages" "network-globals")) (:file "network" :depends-on ("scheduler" "packages" "network-utils" "network-globals")) (:file "network-remote-calls" :depends-on ("packages" "network-globals" "network")) + (:file "todolist" :depends-on ("packages" "scheduler" "classes")) + (:file "nagios-shim" :depends-on ("packages" "utils" "classes")) )) --- /project/noctool/cvsroot/source/classes.lisp 2009/03/15 19:48:41 1.23 +++ /project/noctool/cvsroot/source/classes.lisp 2009/04/28 17:53:07 1.24 @@ -259,14 +259,14 @@ ;; Default do-naught method (values)) -(defmethod post-config-fixup ((instance load-monitor) &key) +(defmethod post-config-fixup ((instance load-monitor)) (unless *dont-muck-with-instance* (add-graphs instance))) ;; if an instance has a name, but no address, give it an address ;; if an instance has an address, but no name, give it a name ;; if it has neither, signal an error -(defmethod post-config-fixup ((instance equipment) &key) +(defmethod post-config-fixup ((instance equipment)) ;; set the alert-level to the max of the children (setf (alert-level instance) (reduce #'max (monitors instance) :key 'alert-level :initial-value 0)) @@ -331,3 +331,11 @@ (if (parent alert-level) (update-alert (parent alert-level))))) +(defclass todo-item () + ((interval :reader interval :initarg :interval) + (last-dequeued :accessor last-dequeued :initarg :last-dequeued) + (last-scheduled :accessor last-scheduled :initarg :last-scheduled) + (last-status :accessor last-status :initarg :last-status) + (thing :reader thing :initarg :thing) + (description :reader description :initarg :description) + )) --- /project/noctool/cvsroot/source/todolist.lisp 2009/04/28 17:53:08 NONE +++ /project/noctool/cvsroot/source/todolist.lisp 2009/04/28 17:53:08 1.1 (in-package #:noctool) (defvar *todo-list* nil) (defvar *todo-mutex* (sb-thread:make-mutex :name 'todo-mutex)) (defmethod process ((todo todo-item)) (sb-thread:with-mutex (*todo-mutex*) (push todo *todo-list*)) (setf (last-dequeued todo) (get-universal-time))) (defun enqueue-todo (todo) (let ((now (get-universal-time))) (setf (last-scheduled now)) (sb-thread:with-mutex (*todo-list*) (setf *todo-list* (delete todo *todo-list*)) (schedule todo (+ now (interval todo)))))) (defgeneric pass (item)) (defgeneric fail (item)) (defmethod pass ((todo todo-item)) (setf (last-status todo) 'ok) (enqueue-todo todo)) (defmethod fail ((todo todo-item)) (setf (last-status todo) 'fail) (enqueue-todo todo)) (defun new-todo-item (thing description &key (interval 86400)) "Create and enqueue a new todo item for THING, with DESCRIPTION, to be re-scheduled for INTERVAL seconds after a pass or fail." (let ((todo (make-instance 'todo-item :thing thing :description description :interval interval :last-status 'unknown :last-dequeued 0))) (enqueue-todo todo) todo))