thodg/cl-unix-cybernetics/core/defs.lisp

• Show log

  Commit

• Hash : 34f3771c
  Author :
  Date : 2014-11-03T17:33:27
  

  Refactor code into modules. Implement SPECIFY macro.

Download

• core/defs.lisp

• ;;
  ;;  adams  -  Remote system administration tools
  ;;
  ;;  Copyright 2013,2014 Thomas de Grivel <thomas@lowh.net>
  ;;
  ;;  Permission to use, copy, modify, and distribute this software for any
  ;;  purpose with or without fee is hereby granted, provided that the above
  ;;  copyright notice and this permission notice appear in all copies.
  ;;
  ;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  ;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  ;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  ;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  ;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  ;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  ;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  ;;
  
  (in-package :adams)
  
  (unless (boundp '+undefined+)
    (defconstant +undefined+ '#:undefined))
  
  ;;  Probe
  
  (defclass probe ()
    ((name :initarg :name
  	 :initform (error "Probe without a name.")
  	 :reader probe-name
  	 :type symbol)
     (properties :initarg :properties
  	       :initform (error "Probe without properties.")
  	       :reader probe-properties)))
  
  (defgeneric probe-generic-function (probe))
  
  ;;  Resource metaclass
  
  (defvar *the-resource-class*)
  
  (defclass resource-class (standard-class)
    ((direct-probes :initarg :direct-probes
  		  :initform ()
  		  :reader direct-probes
  		  :type list)
     (probes :reader probes-of
  	   :type list))
    (:default-initargs :direct-superclasses (list *the-resource-class*)))
  
  (defmethod closer-mop:validate-superclass ((c resource-class)
  					   (super standard-class))
    t)
  
  (defmacro define-resource-class (name direct-superclasses
  				 direct-slots direct-probes
  				 &optional options)
    `(defclass ,name ,(or direct-superclasses
  			'(resource))
       ,direct-slots
       (:metaclass resource-class)
       (:direct-probes ,@direct-probes)
       ,@options))
  
  (defgeneric probe-class (resource-class))
  (defgeneric compute-probes (resource-class))
  
  ;;  Resource base class
  
  (defclass resource (standard-object)
    ((id :type atom
         :initarg :id
         :initform (error "Missing ID for resource.")
         :reader resource-id)
     (specified-properties :type list
  			 :initarg :specified-properties
  			 :initform nil
  			 :accessor specified-properties)
     (probed-properties :type list
  		      :initarg :probed-properties
  		      :initform nil
  		      :accessor probed-properties))
    (:metaclass resource-class))
  
  (setq *the-resource-class* (find-class 'resource))
  
  ;;  Resource registry
  
  (defun make-*resources* ()
    (make-hash-table :test 'equalp))
  
  (defvar *resources*
    (make-*resources*))
  
  ;;  Resource tree class
  
  (defclass resource-tree (resource)
    ((resources :initarg :resources
  	      :initform (make-*resources*)
  	      :type hashtable
  	      :reader resources-of))
    (:metaclass resource-class))
  
  ;;  Specifying resources
  
  (defgeneric specified-property (resource property))
  (defgeneric (setf specified-property) (value resource property))
  
  (defvar *specification*)
  (defgeneric parse-next-specification (resource spec))
  (defgeneric parse-specification (resource spec))
  
  ;;  OS
  
  (defclass os ()
    ((machine :initarg :machine
  	    :reader os-machine
  	    :type string)
     (name :initarg :name
  	 :reader os-name
  	 :type string)
     (release :initarg :release
  	    :reader os-release
  	    :type string)
     (version :initarg :version
  	    :reader os-version
  	    :type string)))
  
  ;;  Probing resources
  
  (define-condition resource-probe-error (error)
    ((resource :initarg :resource)
     (property :initarg :property)
     (host :initarg :host
  	 :initform *host*)
     (os :initarg :os)))
  
  (define-condition resource-probe-not-found (resource-probe-error)
    ())
  
  (define-condition resource-probe-failed (resource-probe-error)
    ((probe :initarg :probe)))
  
  (defgeneric find-probe (resource property os))
  (defgeneric probe (resource property))
  (defgeneric get-probed (resource property))
  
  (defvar *resource*)
  
  ;;  BSD cksum
  
  (defvar *cksum-algorithms*
    '(cksum md4 md5 rmd160 sha1 sha224 sha256 sha384 sha512 sum sysvsum))
  
  ;;  Host
  
  (define-resource-class host (resource-tree)
    ((shell :initarg :shell
  	  :type shell))
    ((probe-os-using-uname :properties (os))
     (probe-hostname :properties (hostname))
     (probe-uptime :properties (uptime))))
  
  (defgeneric host-connect (host))
  (defgeneric host-disconnect (host))
  (defgeneric host-shell (host))
  (defgeneric (setf host-shell) (shell host))
  
  (defgeneric host-run (host command &rest format-args))
  
  (define-resource-class ssh-host (host)
    ()
    ())
  
  (defvar *localhost*)
  (defvar *host*)
  

Download