update-mib.lisp

;;;; -*- Mode: Lisp -*-
;;;; $Id$

(in-package :snmp)

(defparameter *preload-mibs*
  '("MIB:ietf;SNMPv2-SMI"
    "MIB:ietf;SNMPv2-TC"
    "MIB:ietf;SNMPv2-TM"
    "MIB:ietf;SNMPv2-CONF"
    "MIB:ietf;SNMPv2-MIB"
    "MIB:iana;IANAifType-MIB"
    "MIB:ietf;IF-MIB"
    "MIB:ietf;HOST-RESOURCES-MIB"))

(defparameter *lisp-mibs*
  '("MIB:lisp;LISP-MIB.txt"
    "MIB:lisp;ABCL-MIB.txt"
    "MIB:lisp;CLOZURE-MIB.txt"
    "MIB:lisp;CMUCL-MIB.txt"
    "MIB:lisp;ECL-MIB.txt"
    "MIB:lisp;FRANZ-MIB.txt"
    "MIB:lisp;LISPWORKS-MIB.txt"
    "MIB:lisp;SBCL-MIB.txt"
    "MIB:lisp;SCL-MIB.txt"))

(defun compile-mib (&rest args)
  (apply #'compile-asn.1 args))

(defun load-mib (&rest args)
  (apply #'load-asn.1 args))

(defvar *mib-expression* "SNMP:mib.lisp-expr")
(defvar *mib-dependency-file* "SNMP:mib-depend.lisp")

(defvar *pathname-base*)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defmacro make-mib-pathname (type pathname)
    `(merge-pathnames (make-pathname :name (string-downcase
					    (pathname-name (translate-logical-pathname ,pathname)))
                                     :type ,type
                                     :directory (append (pathname-directory *pathname-base*)
                                                        '("compiled-mibs")))
                      *pathname-base*)))

(defun lisp-file (pathname)
  (make-mib-pathname "lisp" pathname))

(defun expr-file (pathname)
  (make-mib-pathname "lisp-expr" pathname))

(defun update-mib-internal (mib-list &key (global t))
  "Update mib.lisp-expr"
  (setq *pathname-base*
        (translate-logical-pathname "SNMP:"))
  (let ((mib.lisp-expr '())
        (mib-depend.lisp '())
        (*package* *asn.1-package*))
    (dolist (i mib-list)
      (format t "; Compiling ~A~%" i)
      (compile-asn.1 (pathname i) :to (lisp-file i))
      (let ((depends (with-open-file (s (expr-file i) :direction :input)
                       (read s)))
            (name (string-downcase (pathname-name (lisp-file i)))))
        (push (if (cdr depends)
                  `(:file ,name
                    :depends-on ,(mapcar #'(lambda (x) (string-downcase (symbol-name x)))
                                         (cdr depends)))
                `(:file ,name))
              mib.lisp-expr)
        (if (cdr depends)
            (push depends mib-depend.lisp))))

    ;;; Update MIB Dependency, it's for ASDF
    (when global
      (with-open-file (s *mib-expression*
                         :direction :output
                         :if-exists :supersede)
        (format s ";;;; -*- Mode: Lisp -*-~%;;;; Generated by #p\"SNMP:UPDATE-MIB.LISP\"~%")
        (pprint (setf mib.lisp-expr (nreverse mib.lisp-expr)) s)
        (terpri s)))

    ;;; Update MIB Dependency, it's for MIB Browser
    (when global
      (with-open-file (s *mib-dependency-file*
                         :direction :output
                         :if-exists :supersede)
        (format s ";;;; -*- Mode: Lisp -*-~%;;;; Generated by #p\"SNMP:UPDATE-MIB.LISP\"~%")
        (dolist (i `((in-package :asn.1)
                     :break-line
                     (eval-when (:load-toplevel :execute)
                       (mapcar #'(lambda (asn.1::x)
                                   (setf (gethash (car asn.1::x)
                                                  asn.1:*mib-module-dependency*)
                                         (cdr asn.1::x)))
                               ',mib-depend.lisp))))
          (if (eq i :break-line)
              (terpri s)
            (pprint i s)))
        (terpri s)))))

(defun update-mib ()
  (update-mib-internal *preload-mibs* :global t)
  (update-mib-internal *lisp-mibs* :global nil)
  (asdf:clear-system :snmp)
  (asdf:load-system :snmp))