September 2007 - cl-net-snmp-cvs@common-lisp.net

[cl-net-snmp-cvs] r46 - trunk
by ctian＠common-lisp.net 19 Sep '07

19 Sep '07

Author: ctian Date: Wed Sep 19 08:37:12 2007 New Revision: 46 Modified: trunk/net-snmp.asd Log: Change ASDF Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Wed Sep 19 08:37:12 2007 @@ -15,12 +15,11 @@ :iolib :zebu) :components ((:module asn.1 :components ((:file "package") + (:file "syntax" :depends-on ("package")) (:file "ber" :depends-on ("package")) - (:file "oid" :depends-on ("ber")) - (:file "mib" :depends-on ("oid")) - (:zebu-source-file "asn.1") - (:file "mib-parse" - :depends-on ("mib" "asn.1")))) + (:file "smi" :depends-on ("ber")) + (:file "oid" :depends-on ("syntax" "ber")) + (:file "mib" :depends-on ("syntax" "oid")))) (:file "package") (:file "constants" :depends-on ("package")) (:file "typedefs" :depends-on ("constants"))

1 0

[cl-net-snmp-cvs] r45 - trunk/asn.1
by ctian＠common-lisp.net 19 Sep '07

19 Sep '07

Author: ctian Date: Wed Sep 19 08:35:54 2007 New Revision: 45 Added: trunk/asn.1/asn.1-domain.lisp trunk/asn.1/asn.1.tab trunk/asn.1/smi.lisp trunk/asn.1/syntax.lisp Modified: trunk/asn.1/ber.lisp trunk/asn.1/mib-parse.lisp trunk/asn.1/mib.lisp trunk/asn.1/stream-test.lisp Log: Commit Changes: code reorgnize Added: trunk/asn.1/asn.1-domain.lisp ============================================================================== --- (empty file) +++ trunk/asn.1/asn.1-domain.lisp Wed Sep 19 08:35:54 2007 @@ -0,0 +1,445 @@ +;;; This file was generated by Zebu (Version 3.5.5) + +(IN-PACKAGE "ASN.1") +(REQUIRE "zebu-package") +(USE-PACKAGE "ZEBU") + +(DEFSTRUCT (OBJECT-IDENTIFIER-VALUE + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (OBJECT-IDENTIFIER-VALUE-VALUE ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "{~a}" + (LET ((OBJ-ID-COMPONENTS+ %R)) + (IF (NULL OBJ-ID-COMPONENTS+) + "" + (ZEBU::KB-SEQUENCE-PRINT OBJ-ID-COMPONENTS+ + NIL + NIL))))))) + VALUE) + +(DEFSTRUCT (VALUE-ASSIGNMENT + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (VALUE-ASSIGNMENT-NAME ITEM)) + (%S (VALUE-ASSIGNMENT-TYPE ITEM)) + (%T (VALUE-ASSIGNMENT-VALUE ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM "~a ~a::=~a" %R %S %T)))) + NAME + TYPE + VALUE) + +(DEFSTRUCT (OBJECT-TYPE-ASSIGNMENT + (:INCLUDE VALUE-ASSIGNMENT) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (OBJECT-TYPE-ASSIGNMENT-NAME ITEM)) + (%S (OBJECT-TYPE-ASSIGNMENT-SYNTAX ITEM)) + (%T (OBJECT-TYPE-ASSIGNMENT-MAX-ACCESS ITEM)) + (%U (OBJECT-TYPE-ASSIGNMENT-STATUS ITEM)) + (%V (OBJECT-TYPE-ASSIGNMENT-DESCRIPTION ITEM)) + (%W (OBJECT-TYPE-ASSIGNMENT-INDEX ITEM)) + (%X (OBJECT-TYPE-ASSIGNMENT-VALUE ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a OBJECT-TYPESYNTAX ~a MAX-ACCESS ~a STATUS ~a DESCRIPTION ~s ~a::=~a" + %R + %S + %T + %U + %V + %W + %X)))) + SYNTAX + MAX-ACCESS + STATUS + DESCRIPTION + INDEX) + +(DEFSTRUCT (ASSIGNMENT + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX (%R (ASSIGNMENT-VALUE ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a" + (LET ((TYPE-ASSIGNMENT %R)) + (ZEBU::KB-SEQUENCE-PRINT TYPE-ASSIGNMENT + NIL + NIL)))))) + TYPE + VALUE) + +(DEFSTRUCT (SYMBOLS-FROM-MODULE + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (SYMBOLS-FROM-MODULE-SYMBOLS ITEM)) + (%S + (SYMBOLS-FROM-MODULE-GLOBAL-MODULE-REFERENCE ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a FROM ~a" + (LET ((SYMBOL+\,1$ %R)) + (IF (NULL SYMBOL+\,1$) + "" + (LET ((*KB-SEQUENCE-SEPARATOR* ",")) + (DECLARE (SPECIAL + *KB-SEQUENCE-SEPARATOR*)) + (ZEBU::KB-SEQUENCE-PRINT SYMBOL+\,1$ + NIL + NIL)))) + %S)))) + SYMBOLS + GLOBAL-MODULE-REFERENCE) + +(DEFSTRUCT (IMPORTS + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA (ITEM STREAM LEVEL &AUX (%R (IMPORTS-LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "IMPORTS ~a;" + (LET ((SYMBOLS-FROM-MODULE* %R)) + (ZEBU::KB-SEQUENCE-PRINT SYMBOLS-FROM-MODULE* + NIL + NIL)))))) + (LIST NIL :TYPE (OR NULL KB-SEQUENCE)) + VALID) + +(DEFSTRUCT (EXPORTS + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA (ITEM STREAM LEVEL &AUX (%R (EXPORTS-LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (COND ((KB-SEQUENCE-P %R) + (FORMAT STREAM + "EXPORTS ~a;" + (LET ((SYMBOL*\,1$ %R)) + (LET + ((*KB-SEQUENCE-SEPARATOR* ",")) + (DECLARE + (SPECIAL *KB-SEQUENCE-SEPARATOR*)) + (ZEBU::KB-SEQUENCE-PRINT + SYMBOL*\,1$ + NIL + NIL))))) + (T (FORMAT STREAM "EXPORTSALL;")))))) + (LIST NIL :TYPE (OR NULL KB-SEQUENCE)) + ALL-EXPORTS) + +(DEFSTRUCT (MODULE-BODY + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (MODULE-BODY-EXPORTS ITEM)) + (%S (MODULE-BODY-IMPORTS ITEM)) + (%T (MODULE-BODY-ASSIGNMENT-LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a ~a ~a" + %R + %S + (LET ((ASSIGNMENT* %T)) + (ZEBU::KB-SEQUENCE-PRINT ASSIGNMENT* + NIL + NIL)))))) + EXPORTS + IMPORTS + (ASSIGNMENT-LIST NIL :TYPE (OR NULL KB-SEQUENCE))) + +(DEFSTRUCT (MODULE-DEFINITION + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (MODULE-DEFINITION-IDENTIFIER ITEM)) + (%S (MODULE-DEFINITION-BODY ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM "~a DEFINITIONS::=BEGIN ~a END" %R %S)))) + IDENTIFIER + BODY) + +(DEFUN ASSIGNMENT*0 (ASSIGNMENT ASSIGNMENT*) + (MAKE-KB-SEQUENCE :FIRST ASSIGNMENT :REST ASSIGNMENT*)) + +(DEFUN SYMBOL*\,1$1 (SYMBOL |Rest-SYMBOL*,1$|) + (MAKE-KB-SEQUENCE :FIRST SYMBOL :REST |Rest-SYMBOL*,1$|)) + +(DEFUN |Rest-SYMBOL*,1$2| (DUMMY SYMBOL |Rest-SYMBOL*,1$|) + (DECLARE (IGNORE DUMMY)) + (MAKE-KB-SEQUENCE :FIRST SYMBOL :REST |Rest-SYMBOL*,1$|)) + +(DEFUN SYMBOLS-FROM-MODULE*3 (SYMBOLS-FROM-MODULE SYMBOLS-FROM-MODULE*) + (MAKE-KB-SEQUENCE :FIRST + SYMBOLS-FROM-MODULE + :REST + SYMBOLS-FROM-MODULE*)) + +(DEFUN SYMBOL+\,1$4 (SYMBOL) (MAKE-KB-SEQUENCE :FIRST SYMBOL)) + +(DEFUN SYMBOL+\,1$5 (SYMBOL DUMMY SYMBOL+\,1$) + (DECLARE (IGNORE DUMMY)) + (MAKE-KB-SEQUENCE :FIRST SYMBOL :REST SYMBOL+\,1$)) + +(DEFUN GARBAGE+6 (GARBAGE) (MAKE-KB-SEQUENCE :FIRST GARBAGE)) + +(DEFUN GARBAGE+7 (GARBAGE GARBAGE+) + (MAKE-KB-SEQUENCE :FIRST GARBAGE :REST GARBAGE+)) + +(DEFUN MODULE-REVISION*8 (MODULE-REVISION MODULE-REVISION*) + (MAKE-KB-SEQUENCE :FIRST MODULE-REVISION :REST MODULE-REVISION*)) + +(DEFUN IDENTIFIER+\,1$9 (IDENTIFIER) + (MAKE-KB-SEQUENCE :FIRST IDENTIFIER)) + +(DEFUN IDENTIFIER+\,1$10 (IDENTIFIER DUMMY IDENTIFIER+\,1$) + (DECLARE (IGNORE DUMMY)) + (MAKE-KB-SEQUENCE :FIRST IDENTIFIER :REST IDENTIFIER+\,1$)) + +(DEFUN MODULE-COMPLIANCE-GROUP+11 (MODULE-COMPLIANCE-GROUP) + (MAKE-KB-SEQUENCE :FIRST MODULE-COMPLIANCE-GROUP)) + +(DEFUN MODULE-COMPLIANCE-GROUP+12 + (MODULE-COMPLIANCE-GROUP MODULE-COMPLIANCE-GROUP+) + (MAKE-KB-SEQUENCE :FIRST + MODULE-COMPLIANCE-GROUP + :REST + MODULE-COMPLIANCE-GROUP+)) + +(DEFUN OBJ-ID-COMPONENTS+13 (OBJ-ID-COMPONENTS) + (MAKE-KB-SEQUENCE :FIRST OBJ-ID-COMPONENTS)) + +(DEFUN OBJ-ID-COMPONENTS+14 (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) + (MAKE-KB-SEQUENCE :FIRST OBJ-ID-COMPONENTS :REST OBJ-ID-COMPONENTS+)) + +(DEFUN NAMED-NUMBER+\,1$15 (NAMED-NUMBER) + (MAKE-KB-SEQUENCE :FIRST NAMED-NUMBER)) + +(DEFUN NAMED-NUMBER+\,1$16 (NAMED-NUMBER DUMMY NAMED-NUMBER+\,1$) + (DECLARE (IGNORE DUMMY)) + (MAKE-KB-SEQUENCE :FIRST NAMED-NUMBER :REST NAMED-NUMBER+\,1$)) + +(DEFUN GARBAGE*17 (GARBAGE GARBAGE*) + (MAKE-KB-SEQUENCE :FIRST GARBAGE :REST GARBAGE*)) + +(DEFUN OBJECT-IDENTIFIER-VALUE18 (DUMMY OBJ-ID-COMPONENTS+ DUMMY1) + (DECLARE (IGNORE DUMMY1 DUMMY)) + (MAKE-OBJECT-IDENTIFIER-VALUE :VALUE OBJ-ID-COMPONENTS+)) + +(DEFUN VALUE-ASSIGNMENT19 (VALUE-REFERENCE TYPE DUMMY VALUE) + (DECLARE (IGNORE DUMMY)) + (MAKE-VALUE-ASSIGNMENT :NAME VALUE-REFERENCE :TYPE TYPE :VALUE VALUE)) + +(DEFUN VALUE-ASSIGNMENT20 + (VALUE-REFERENCE DUMMY DUMMY1 TYPE DUMMY2 OBJECT-TYPE-ACCESS + DUMMY3 OBJECT-TYPE-STATUS DUMMY4 STRING OBJECT-TYPE-INDEX + DUMMY5 OBJECT-IDENTIFIER-VALUE) + (DECLARE (IGNORE DUMMY5 DUMMY4 DUMMY3 DUMMY2 DUMMY1 DUMMY)) + (MAKE-OBJECT-TYPE-ASSIGNMENT :NAME + VALUE-REFERENCE + :TYPE + :OBJECT-TYPE + :SYNTAX + TYPE + :MAX-ACCESS + OBJECT-TYPE-ACCESS + :STATUS + OBJECT-TYPE-STATUS + :DESCRIPTION + STRING + :INDEX + OBJECT-TYPE-INDEX + :VALUE + OBJECT-IDENTIFIER-VALUE)) + +(DEFUN ASSIGNMENT21 (TYPE-ASSIGNMENT) + (MAKE-ASSIGNMENT :TYPE :TYPE :VALUE TYPE-ASSIGNMENT)) + +(DEFUN ASSIGNMENT22 (VALUE-ASSIGNMENT) + (MAKE-ASSIGNMENT :TYPE :VALUE :VALUE VALUE-ASSIGNMENT)) + +(DEFUN SYMBOLS-FROM-MODULE23 + (SYMBOL+\,1$ DUMMY GLOBAL-MODULE-REFERENCE) + (DECLARE (IGNORE DUMMY)) + (MAKE-SYMBOLS-FROM-MODULE :SYMBOLS + SYMBOL+\,1$ + :GLOBAL-MODULE-REFERENCE + GLOBAL-MODULE-REFERENCE)) + +(DEFUN IMPORTS24 (DUMMY SYMBOLS-FROM-MODULE* DUMMY1) + (DECLARE (IGNORE DUMMY1 DUMMY)) + (MAKE-IMPORTS :VALID T :LIST SYMBOLS-FROM-MODULE*)) + +(DEFUN EXPORTS25 (DUMMY SYMBOL*\,1$ DUMMY1) + (DECLARE (IGNORE DUMMY1 DUMMY)) + (MAKE-EXPORTS :LIST SYMBOL*\,1$)) + +(DEFUN EXPORTS26 (DUMMY DUMMY1 DUMMY2) + (DECLARE (IGNORE DUMMY2 DUMMY1 DUMMY)) + (MAKE-EXPORTS :ALL-EXPORTS T)) + +(DEFUN MODULE-BODY27 (EXPORTS IMPORTS ASSIGNMENT*) + (MAKE-MODULE-BODY :ASSIGNMENT-LIST + ASSIGNMENT* + :EXPORTS + EXPORTS + :IMPORTS + IMPORTS)) + +(DEFUN MODULE-DEFINITION28 + (MODULE-IDENTIFIER DUMMY DUMMY1 DUMMY2 MODULE-BODY DUMMY3) + (DECLARE (IGNORE DUMMY3 DUMMY2 DUMMY1 DUMMY)) + (MAKE-MODULE-DEFINITION :IDENTIFIER + MODULE-IDENTIFIER + :BODY + MODULE-BODY)) + + +(EVAL-WHEN (:COMPILE-TOPLEVEL) + (UNLESS (MEMBER "zebu-regex" *MODULES* :TEST #'EQUAL) + (WARN "Load the Zebu Compiler!"))) +(DECLAIM (SPECIAL ZEBU::*REGEX-GROUPS* ZEBU::*REGEX-GROUPINGS*)) +(DEFUN TYPE-REFERENCE + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000011111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN SIGNED-NUMBER + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (PROGN + (BLOCK ZEBU::COMPARE + (IF (AND (< ZEBU::INDEX LENGTH) + (EQL (CHAR STRING ZEBU::INDEX) #\-)) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + T) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE + (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN ANYTHING + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE + (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) Added: trunk/asn.1/asn.1.tab ============================================================================== --- (empty file) +++ trunk/asn.1/asn.1.tab Wed Sep 19 08:35:54 2007 @@ -0,0 +1,573 @@ + +(:FILE "/home/binghe/cl-net-snmp/asn.1/asn.1.zb" :NAME "ASN.1" :DOMAIN-FILE "asn.1-domain.lisp" :PACKAGE "ASN.1" :GRAMMAR "zebu-mg" :IDENTIFIER-START-CHARS "abcdefghijklmnopqrstuvwxyz" :IDENTIFIER-CONTINUE-CHARS "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" :CASE-SENSITIVE T :LEX-CATS ((TYPE-REFERENCE "[A-Z][a-zA-Z0-9-]*") (SIGNED-NUMBER "-?[0-9]+") (ANYTHING "[^ ]+")) :DOMAIN (KB-DOMAIN :SUBTYPE (OBJECT-IDENTIFIER-VALUE :SLOTS (VALUE)) :SUBTYPE (VALUE-ASSIGNMENT :SLOTS (NAME TYPE VALUE) :SUBTYPE (OBJECT-TYPE-ASSIGNMENT :SLOTS (SYNTAX MAX-ACCESS STATUS DESCRIPTION INDEX))) :SUBTYPE (ASSIGNMENT :SLOTS (TYPE VALUE)) :SUBTYPE (SYMBOLS-FROM-MODULE :SLOTS (SYMBOLS GLOBAL-MODULE-REFERENCE)) :SUBTYPE (IMPORTS :SLOTS ((LIST KB-SEQUENCE) VALID)) :SUBTYPE (EXPORTS :SLOTS ((LIST KB-SEQUENCE) ALL-EXPORTS)) :SUBTYPE (MODULE-BODY :SLOTS (EXPORTS IMPORTS (ASSIGNMENT-LIST KB-SEQUENCE))) :SUBTYPE (MODULE-DEFINITION :SLOTS (IDENTIFIER BODY))) :DOMAIN-FILE "/home/binghe/cl-net-snmp/asn.1/asn.1-domain.lisp") +#124(ZEBU::THE-EMPTY-STRING ZEBU::AUGMENTED-START ZEBU::THE-END-G-SYMBOL MODULE-DEFINITION MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END" MODULE-REFERENCE TYPE-REFERENCE EXPORTS IMPORTS ASSIGNMENT* "EXPORTS" SYMBOL*\,1$ ";" "ALL" SYMBOL REFERENCE "IMPORTS" SYMBOLS-FROM-MODULE* SYMBOLS-FROM-MODULE SYMBOL+\,1$ "FROM" GLOBAL-MODULE-REFERENCE VALUE-REFERENCE IDENTIFIER ASSIGNMENT TYPE-ASSIGNMENT VALUE-ASSIGNMENT TYPE "MACRO" GARBAGE+ GARBAGE ANYTHING VALUE "OBJECT-IDENTITY" "STATUS" "DESCRIPTION" STRING OBJECT-IDENTIFIER-VALUE "MODULE-IDENTITY" "LAST-UPDATED" "ORGANIZATION" "CONTACT-INFO" MODULE-REVISION* "OBJECT-TYPE" "SYNTAX" "MAX-ACCESS" OBJECT-TYPE-ACCESS OBJECT-TYPE-STATUS OBJECT-TYPE-INDEX "NOTIFICATION-TYPE" "NOTIFICATION-GROUP" "NOTIFICATIONS" "{" IDENTIFIER+\,1$ "}" "MODULE-COMPLIANCE" "MODULE" "MANDATORY-GROUPS" MODULE-COMPLIANCE-GROUP+ "OBJECT-GROUP" "OBJECTS" MODULE-REVISION "REVISION" "INDEX" MODULE-COMPLIANCE-GROUP "GROUP" BUILTIN-TYPE NAMED-TYPE OBJECT-IDENTIFIER-TYPE CHOICE-TYPE STRING-TYPE INTEGER-TYPE SEQUENCE-OF-TYPE SEQUENCE-TYPE TEXTUAL-CONVENTION-TYPE TAGGED-TYPE "TEXTUAL-CONVENTION" TEXTUAL-CONVENTION-DISPLAY-HINT TEXTUAL-CONVENTION-REFERENCE "DISPLAY-HINT" "REFERENCE" "OBJECT" "IDENTIFIER" BUILTIN-VALUE OBJ-ID-COMPONENTS+ OBJ-ID-COMPONENTS NAME-AND-NUMBER-FORM NAME-FORM NUMBER-FORM "(" ")" SIGNED-NUMBER "CHOICE" "OCTET" "STRING" STRING-OPTIONS "DisplayString" "SIZE" NUMBERS "|" ".." "INTEGER" NAMED-NUMBER+\,1$ NAMED-NUMBER "SEQUENCE" GARBAGE* "OF" TAG "IMPLICIT" "EXPLICIT" "[" CLASS CLASS-NUMBER "]" "UNIVERSAL" "APPLICATION" "PRIVATE" "," |Rest-SYMBOL*,1$| ) + + +#63(5 6 7 9 11 15 17 18 21 25 28 33 36 38 39 40 41 43 44 45 46 48 49 50 54 55 56 57 59 60 61 62 64 65 67 68 70 81 84 85 86 87 94 95 96 97 98 99 101 102 104 105 106 109 111 113 114 115 118 119 120 121 122 ) + +#108((1 . 1)(3 . 6)(4 . 1)(10 . 1)(8 . 3)(8 . 0)(12 . 3)(12 . 3)(12 . 0)(19 . 1)(13 . 3)(13 . 0)(23 . 3)(26 . 1)(20 . 1)(20 . 1)(27 . 1)(29 . 1)(29 . 1)(30 . 3)(30 . 6)(35 . 1)(31 . 4)(31 . 8)(31 . 13)(31 . 13)(31 . 8)(31 . 12)(31 . 14)(31 . 12)(51 . 1)(52 . 1)(66 . 4)(53 . 2)(53 . 0)(69 . 4)(32 . 1)(32 . 1)(71 . 1)(71 . 1)(71 . 1)(71 . 1)(71 . 1)(71 . 1)(71 . 1)(71 . 1)(72 . 1)(79 . 9)(82 . 2)(82 . 0)(83 . 2)(83 . 0)(73 . 2)(37 . 1)(88 . 1)(42 . 3)(90 . 1)(90 . 1)(90 . 1)(91 . 4)(92 . 1)(93 . 1)(74 . 4)(75 . 3)(75 . 2)(100 . 6)(100 . 0)(103 . 3)(103 . 3)(103 . 1)(76 . 6)(76 . 4)(108 . 4)(78 . 4)(77 . 3)(80 . 2)(80 . 3)(80 . 3)(112 . 4)(117 . 1)(116 . 1)(116 . 1)(116 . 1)(116 . 0)(110 . 0)(110 . 2)(107 . 1)(107 . 3)(89 . 1)(89 . 2)(63 . 1)(63 . 2)(58 . 1)(58 . 3)(47 . 0)(47 . 2)(34 . 1)(34 . 2)(24 . 1)(24 . 3)(22 . 0)(22 . 2)(123 . 0)(123 . 3)(16 . 0)(16 . 2)(14 . 0)(14 . 2)) + +#249( +((11 :S 9)) +((2 :A 0)) +((5 :S 3)) +((6 :S 4)) +((7 :S 5)) +((9 :R 5) (11 :R 8) (15 :S 235) (21 :R 8) (28 :R 8)) +((9 :S 7)) +((2 :R 1)) +((5 :R 2)) +((5 :R 3) (11 :R 3) (17 :R 3) (28 :R 3)) +((9 :R 11) (11 :R 11) (21 :S 18) (28 :R 11)) +((9 :R 106) (11 :S 236) (28 :S 27)) +((9 :R 4)) +((17 :S 14)) +((9 :R 6) (11 :R 6) (21 :R 6) (28 :R 6)) +((17 :S 16)) +((9 :R 7) (11 :R 7) (21 :R 7) (28 :R 7)) +((17 :R 9) (25 :R 9) (122 :R 9)) +((11 :S 25) (17 :R 100) (28 :S 27)) +((17 :S 20)) +((9 :R 10) (11 :R 10) (28 :R 10)) +((25 :S 22)) +((11 :S 9)) +((11 :R 12) (17 :R 12) (28 :R 12)) +((11 :R 13) (17 :R 13) (28 :R 13)) +((17 :R 14) (25 :R 14) (122 :R 14)) +((17 :R 15) (25 :R 15) (122 :R 15)) +((11 :R 16) (17 :R 16) (25 :R 16) (38 :R 16) (43 :R 16) (48 :R 16) (54 :R 16) (55 :R 16) (60 :R 16) (64 :R 16) (81 :R 16) (86 :R 16) (97 :R 16) (98 :R 16) (101 :R 16) (106 :R 16) (109 :R 16) (115 :R 16) (122 :R 16)) +((9 :R 17) (11 :R 17) (28 :R 17)) +((9 :R 18) (11 :R 18) (28 :R 18)) +((11 :S 136) (81 :S 137) (86 :S 150) (97 :S 164) (98 :S 168) (101 :S 171) (106 :S 238) (109 :S 239) (115 :S 205)) +((9 :R 19) (11 :R 19) (28 :R 19)) +((6 :S 33)) +((7 :S 34)) +((36 :S 37)) +((9 :S 36)) +((9 :R 20) (11 :R 20) (28 :R 20)) +((9 :R 21) (36 :R 21) (59 :R 21)) +((6 :S 39)) +((57 :S 154)) +((9 :R 22) (11 :R 22) (28 :R 22)) +((39 :S 42)) +((28 :S 43)) +((40 :S 44)) +((41 :S 45)) +((6 :S 46)) +((57 :S 154)) +((9 :R 23) (11 :R 23) (28 :R 23)) +((44 :S 49)) +((41 :S 50)) +((45 :S 51)) +((41 :S 52)) +((46 :S 53)) +((41 :S 54)) +((40 :S 55)) +((41 :S 56)) +((6 :R 94) (67 :S 116)) +((6 :S 58)) +((57 :S 154)) +((9 :R 24) (11 :R 24) (28 :R 24)) +((49 :S 61)) +((11 :S 136) (81 :S 137) (86 :S 150) (97 :S 164) (98 :S 168) (101 :S 171) (106 :S 238) (109 :S 239) (115 :S 205)) +((50 :S 63)) +((28 :S 114)) +((39 :S 65)) +((28 :S 115)) +((40 :S 67)) +((41 :S 68)) +((6 :R 34) (68 :S 120)) +((6 :S 70)) +((57 :S 154)) +((9 :R 25) (11 :R 25) (28 :R 25)) +((39 :S 73)) +((28 :S 74)) +((40 :S 75)) +((41 :S 76)) +((6 :S 77)) +((57 :S 154)) +((9 :R 26) (11 :R 26) (28 :R 26)) +((56 :S 80)) +((57 :S 81)) +((28 :S 243)) +((59 :S 83)) +((39 :S 84)) +((28 :S 85)) +((40 :S 86)) +((41 :S 87)) +((6 :S 88)) +((57 :S 154)) +((9 :R 27) (11 :R 27) (28 :R 27)) +((39 :S 91)) +((28 :S 92)) +((40 :S 93)) +((41 :S 94)) +((61 :S 95)) +((62 :S 96)) +((57 :S 97)) +((28 :S 243)) +((59 :S 99)) +((70 :S 122)) +((6 :S 101)) +((57 :S 154)) +((9 :R 28) (11 :R 28) (28 :R 28)) +((65 :S 104)) +((57 :S 105)) +((28 :S 243)) +((59 :S 107)) +((39 :S 108)) +((28 :S 109)) +((40 :S 110)) +((41 :S 111)) +((6 :S 112)) +((57 :S 154)) +((9 :R 29) (11 :R 29) (28 :R 29)) +((39 :R 30)) +((40 :R 31)) +((41 :S 117)) +((40 :S 118)) +((41 :S 119)) +((6 :R 32) (67 :R 32)) +((57 :S 154)) +((6 :R 33)) +((28 :S 123)) +((40 :S 124)) +((41 :S 125)) +((6 :R 35) (70 :R 35)) +((6 :R 36) (9 :R 36) (11 :R 36) (28 :R 36) (50 :R 36)) +((6 :R 37) (9 :R 37) (11 :R 37) (28 :R 37) (50 :R 37)) +((6 :R 38) (9 :R 38) (11 :R 38) (28 :R 38) (50 :R 38)) +((6 :R 39) (9 :R 39) (11 :R 39) (28 :R 39) (50 :R 39)) +((6 :R 40) (9 :R 40) (11 :R 40) (28 :R 40) (50 :R 40)) +((6 :R 41) (9 :R 41) (11 :R 41) (28 :R 41) (50 :R 41)) +((6 :R 42) (9 :R 42) (11 :R 42) (28 :R 42) (50 :R 42)) +((6 :R 43) (9 :R 43) (11 :R 43) (28 :R 43) (50 :R 43)) +((6 :R 44) (9 :R 44) (11 :R 44) (28 :R 44) (50 :R 44)) +((6 :R 45) (9 :R 45) (11 :R 45) (28 :R 45) (50 :R 45)) +((6 :R 46) (9 :R 46) (11 :R 46) (28 :R 46) (50 :R 46)) +((39 :R 49) (84 :S 146)) +((39 :S 139)) +((28 :S 140)) +((40 :S 141)) +((41 :S 142)) +((49 :R 51) (85 :S 148)) +((49 :S 144)) +((11 :S 136) (81 :S 137) (86 :S 150) (97 :S 164) (98 :S 168) (101 :S 171) (106 :S 238) (109 :S 239) (115 :S 205)) +((6 :R 47) (9 :R 47) (11 :R 47) (28 :R 47) (50 :R 47)) +((41 :S 147)) +((39 :R 48)) +((41 :S 149)) +((49 :R 50)) +((87 :S 151)) +((6 :R 52) (9 :R 52) (11 :R 52) (28 :R 52) (50 :R 52)) +((9 :R 53) (11 :R 53) (28 :R 53)) +((9 :R 54) (11 :R 54) (28 :R 54)) +((28 :S 237) (96 :S 163)) +((59 :S 156)) +((6 :R 55) (9 :R 55) (11 :R 55) (28 :R 55)) +((28 :R 56) (59 :R 56) (96 :R 56)) +((28 :R 57) (59 :R 57) (96 :R 57)) +((28 :R 58) (59 :R 58) (96 :R 58)) +((96 :S 163)) +((95 :S 162)) +((28 :R 59) (59 :R 59) (96 :R 59)) +((28 :R 61) (59 :R 61) (95 :R 61) (96 :R 61)) +((57 :S 165)) +((36 :S 37)) +((59 :S 167)) +((6 :R 62) (9 :R 62) (11 :R 62) (28 :R 62) (50 :R 62)) +((99 :S 169)) +((6 :R 66) (9 :R 66) (11 :R 66) (28 :R 66) (50 :R 66) (94 :S 173)) +((6 :R 63) (9 :R 63) (11 :R 63) (28 :R 63) (50 :R 63)) +((6 :R 66) (9 :R 66) (11 :R 66) (28 :R 66) (50 :R 66) (94 :S 173)) +((6 :R 64) (9 :R 64) (11 :R 64) (28 :R 64) (50 :R 64)) +((102 :S 174)) +((94 :S 175)) +((96 :S 246)) +((95 :S 177)) +((95 :S 178)) +((6 :R 65) (9 :R 65) (11 :R 65) (28 :R 65) (50 :R 65)) +((96 :S 180)) +((95 :R 67)) +((96 :S 182)) +((95 :R 68)) +((96 :S 184)) +((105 :S 185)) +((96 :S 186)) +((95 :S 187)) +((6 :R 70) (9 :R 70) (11 :R 70) (28 :R 70) (50 :R 70)) +((28 :S 191)) +((59 :S 190)) +((6 :R 71) (9 :R 71) (11 :R 71) (28 :R 71) (50 :R 71)) +((94 :S 192)) +((96 :S 193)) +((95 :S 194)) +((59 :R 72) (122 :R 72)) +((36 :S 37) (59 :R 84)) +((59 :S 197)) +((6 :R 73) (9 :R 73) (11 :R 73) (28 :R 73) (50 :R 73)) +((11 :S 136) (81 :S 137) (86 :S 150) (97 :S 164) (98 :S 168) (101 :S 171) (106 :S 238) (109 :S 239) (115 :S 205)) +((6 :R 74) (9 :R 74) (11 :R 74) (28 :R 74) (50 :R 74)) +((6 :R 75) (9 :R 75) (11 :R 75) (28 :R 75) (50 :R 75)) +((11 :S 136) (81 :S 137) (86 :S 150) (97 :S 164) (98 :S 168) (101 :S 171) (106 :S 238) (109 :S 239) (115 :S 205)) +((6 :R 76) (9 :R 76) (11 :R 76) (28 :R 76) (50 :R 76)) +((11 :S 136) (81 :S 137) (86 :S 150) (97 :S 164) (98 :S 168) (101 :S 171) (106 :S 238) (109 :S 239) (115 :S 205)) +((6 :R 77) (9 :R 77) (11 :R 77) (28 :R 77) (50 :R 77)) +((96 :R 83) (119 :S 210) (120 :S 211) (121 :S 212)) +((96 :S 209)) +((118 :S 208)) +((11 :R 78) (81 :R 78) (86 :R 78) (97 :R 78) (98 :R 78) (101 :R 78) (106 :R 78) (109 :R 78) (113 :R 78) (114 :R 78) (115 :R 78)) +((118 :R 79)) +((96 :R 80)) +((96 :R 81)) +((96 :R 82)) +((36 :S 37) (59 :R 84)) +((59 :R 85)) +((28 :S 191)) +((59 :R 87)) +((59 :R 89)) +((6 :R 91)) +((28 :S 243)) +((59 :R 93)) +((6 :R 94) (67 :S 116)) +((6 :R 95)) +((9 :R 97) (59 :R 97)) +((11 :S 25) (28 :S 27)) +((25 :R 99)) +((11 :S 25) (17 :R 100) (28 :S 27)) +((17 :R 101)) +((11 :S 25) (28 :S 27)) +((17 :R 102) (122 :S 228)) +((17 :R 103)) +((17 :R 102) (122 :S 228)) +((17 :R 105)) +((9 :R 106) (11 :S 236) (28 :S 27)) +((9 :R 107)) +((11 :S 25) (17 :R 104) (18 :S 15) (28 :S 27)) +((6 :S 30) (33 :S 32)) +((28 :R 60) (59 :R 60) (94 :S 160) (96 :R 60)) +((57 :S 188) (94 :S 183)) +((57 :S 195) (111 :S 198)) +((59 :R 86) (122 :S 215)) +((28 :S 237) (59 :R 88) (96 :S 163)) +((6 :R 90) (70 :S 122)) +((59 :R 92) (122 :S 219)) +((9 :R 96) (36 :S 37) (59 :R 96)) +((25 :R 98) (122 :S 224)) +((95 :R 69) (104 :S 179) (105 :S 181)) +((11 :S 136) (81 :S 137) (86 :S 150) (97 :S 164) (98 :S 168) (101 :S 171) (106 :S 238) (109 :S 239) (113 :S 201) (114 :S 203) (115 :S 205)) +((11 :S 136) (38 :S 41) (43 :S 48) (48 :S 60) (54 :S 72) (55 :S 79) (60 :S 90) (64 :S 103) (81 :S 137) (86 :S 150) (97 :S 164) (98 :S 168) (101 :S 171) (106 :S 238) (109 :S 239) (115 :S 205))) + +#249( +((3 . 1)(4 . 2)(10 . 8)) +() +() +() +() +((8 . 6)(12 . 10)) +() +() +() +() +((13 . 11)) +((14 . 12)(27 . 248)(29 . 233)(30 . 28)(31 . 29)) +() +() +() +() +() +() +((19 . 245)(20 . 17)(22 . 19)(23 . 226)(24 . 21)(27 . 26)) +() +() +() +((10 . 24)(26 . 23)) +() +() +() +() +() +() +() +((32 . 31)(71 . 126)(72 . 127)(73 . 128)(74 . 129)(75 . 130)(76 . 131)(77 . 132)(78 . 133)(79 . 134)(80 . 135)(112 . 247)) +() +() +() +((34 . 35)(35 . 244)) +() +() +() +() +((37 . 40)(42 . 153)(88 . 152)) +() +() +() +() +() +() +((42 . 47)) +() +() +() +() +() +() +() +() +() +((47 . 57)(66 . 221)) +() +((42 . 59)) +() +() +((32 . 62)(71 . 126)(72 . 127)(73 . 128)(74 . 129)(75 . 130)(76 . 131)(77 . 132)(78 . 133)(79 . 134)(80 . 135)(112 . 247)) +() +((51 . 64)) +() +((52 . 66)) +() +() +((53 . 69)) +() +((42 . 71)) +() +() +() +() +() +() +((42 . 78)) +() +() +() +((58 . 82)) +() +() +() +() +() +() +((42 . 89)) +() +() +() +() +() +() +() +() +((58 . 98)) +() +((63 . 100)(69 . 242)) +() +((42 . 102)) +() +() +() +((58 . 106)) +() +() +() +() +() +() +((42 . 113)) +() +() +() +() +() +() +() +((42 . 121)) +() +() +() +() +() +() +() +() +() +() +() +() +() +() +() +() +((82 . 138)) +() +() +() +() +((83 . 143)) +() +((32 . 145)(71 . 126)(72 . 127)(73 . 128)(74 . 129)(75 . 130)(76 . 131)(77 . 132)(78 . 133)(79 . 134)(80 . 135)(112 . 247)) +() +() +() +() +() +() +() +() +() +((89 . 155)(90 . 241)(91 . 157)(92 . 158)(93 . 159)) +() +() +() +() +() +((93 . 161)) +() +() +() +() +((34 . 166)(35 . 244)) +() +() +() +((100 . 170)) +() +((100 . 172)) +() +() +() +((103 . 176)) +() +() +() +() +() +() +() +() +() +() +() +() +((107 . 189)(108 . 240)) +() +() +() +() +() +() +((35 . 213)(110 . 196)) +() +() +((32 . 199)(71 . 126)(72 . 127)(73 . 128)(74 . 129)(75 . 130)(76 . 131)(77 . 132)(78 . 133)(79 . 134)(80 . 135)(112 . 247)) +() +() +((32 . 202)(71 . 126)(72 . 127)(73 . 128)(74 . 129)(75 . 130)(76 . 131)(77 . 132)(78 . 133)(79 . 134)(80 . 135)(112 . 247)) +() +((32 . 204)(71 . 126)(72 . 127)(73 . 128)(74 . 129)(75 . 130)(76 . 131)(77 . 132)(78 . 133)(79 . 134)(80 . 135)(112 . 247)) +() +((116 . 206)) +((117 . 207)) +() +() +() +() +() +() +((35 . 213)(110 . 214)) +() +((107 . 216)(108 . 240)) +() +() +() +((58 . 220)) +() +((47 . 222)(66 . 221)) +() +() +((19 . 245)(20 . 17)(24 . 225)(27 . 26)) +() +((19 . 245)(20 . 17)(22 . 227)(23 . 226)(24 . 21)(27 . 26)) +() +((19 . 229)(20 . 17)(27 . 26)) +((123 . 230)) +() +((123 . 232)) +() +((14 . 234)(27 . 248)(29 . 233)(30 . 28)(31 . 29)) +() +((16 . 13)(19 . 231)(20 . 17)(27 . 26)) +() +() +() +() +() +((89 . 217)(90 . 241)(91 . 157)(92 . 158)(93 . 159)) +((63 . 218)(69 . 242)) +() +((34 . 223)(35 . 244)) +() +() +((32 . 200)(71 . 126)(72 . 127)(73 . 128)(74 . 129)(75 . 130)(76 . 131)(77 . 132)(78 . 133)(79 . 134)(80 . 135)(112 . 247)) +((32 . 38)(71 . 126)(72 . 127)(73 . 128)(74 . 129)(75 . 130)(76 . 131)(77 . 132)(78 . 133)(79 . 134)(80 . 135)(112 . 247))) +0 + +2 + +#58((MODULE-DEFINITION . #S(ZEBU::ZB-RULE :-NAME MODULE-DEFINITION :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END") :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-DEFINITION :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL IDENTIFIER :-VALUE MODULE-IDENTIFIER) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL BODY :-VALUE MODULE-BODY))) :-BUILD-FN MODULE-DEFINITION28)))) +(MODULE-IDENTIFIER . #S(ZEBU::ZB-RULE :-NAME MODULE-IDENTIFIER :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(MODULE-REFERENCE . #S(ZEBU::ZB-RULE :-NAME MODULE-REFERENCE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(MODULE-BODY . #S(ZEBU::ZB-RULE :-NAME MODULE-BODY :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (EXPORTS IMPORTS ASSIGNMENT*) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-BODY :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL ASSIGNMENT-LIST :-VALUE ASSIGNMENT*) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL EXPORTS :-VALUE EXPORTS) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL IMPORTS :-VALUE IMPORTS))) :-BUILD-FN MODULE-BODY27) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(EXPORTS . #S(ZEBU::ZB-RULE :-NAME EXPORTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("EXPORTS" SYMBOL*\,1$ ";") :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE EXPORTS :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL LIST :-VALUE SYMBOL*\,1$))) :-BUILD-FN EXPORTS25) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("EXPORTS" "ALL" ";") :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE EXPORTS :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL ALL-EXPORTS :-VALUE T))) :-BUILD-FN EXPORTS26) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(SYMBOL . #S(ZEBU::ZB-RULE :-NAME SYMBOL :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(IMPORTS . #S(ZEBU::ZB-RULE :-NAME IMPORTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("IMPORTS" SYMBOLS-FROM-MODULE* ";") :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE IMPORTS :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL VALID :-VALUE T) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL LIST :-VALUE SYMBOLS-FROM-MODULE*))) :-BUILD-FN IMPORTS24) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(SYMBOLS-FROM-MODULE . #S(ZEBU::ZB-RULE :-NAME SYMBOLS-FROM-MODULE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL+\,1$ "FROM" GLOBAL-MODULE-REFERENCE) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE SYMBOLS-FROM-MODULE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL SYMBOLS :-VALUE SYMBOL+\,1$) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL GLOBAL-MODULE-REFERENCE :-VALUE GLOBAL-MODULE-REFERENCE))) :-BUILD-FN SYMBOLS-FROM-MODULE23)))) +(GLOBAL-MODULE-REFERENCE . #S(ZEBU::ZB-RULE :-NAME GLOBAL-MODULE-REFERENCE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(REFERENCE . #S(ZEBU::ZB-RULE :-NAME REFERENCE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(VALUE-REFERENCE . #S(ZEBU::ZB-RULE :-NAME VALUE-REFERENCE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL TYPE :-VALUE :TYPE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL VALUE :-VALUE TYPE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT21) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL TYPE :-VALUE :VALUE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL VALUE :-VALUE VALUE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT22)))) +(TYPE-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME TYPE-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE "::=" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE "MACRO" "::=" "BEGIN" GARBAGE+ "END") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(GARBAGE . #S(ZEBU::ZB-RULE :-NAME GARBAGE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ANYTHING) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(VALUE-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME VALUE-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE TYPE "::=" VALUE) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE VALUE-ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL NAME :-VALUE VALUE-REFERENCE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL TYPE :-VALUE TYPE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL VALUE :-VALUE VALUE))) :-BUILD-FN VALUE-ASSIGNMENT19) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE "OBJECT-IDENTITY" "STATUS" IDENTIFIER "DESCRIPTION" STRING "::=" OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE "MODULE-IDENTITY" "LAST-UPDATED" STRING "ORGANIZATION" STRING "CONTACT-INFO" STRING "DESCRIPTION" STRING MODULE-REVISION* "::=" OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE "OBJECT-TYPE" "SYNTAX" TYPE "MAX-ACCESS" OBJECT-TYPE-ACCESS "STATUS" OBJECT-TYPE-STATUS "DESCRIPTION" STRING OBJECT-TYPE-INDEX "::=" OBJECT-IDENTIFIER-VALUE) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE OBJECT-TYPE-ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL NAME :-VALUE VALUE-REFERENCE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL TYPE :-VALUE :OBJECT-TYPE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL SYNTAX :-VALUE TYPE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL MAX-ACCESS :-VALUE OBJECT-TYPE-ACCESS) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL STATUS :-VALUE OBJECT-TYPE-STATUS) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL DESCRIPTION :-VALUE STRING) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL INDEX :-VALUE OBJECT-TYPE-INDEX) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL VALUE :-VALUE OBJECT-IDENTIFIER-VALUE))) :-BUILD-FN VALUE-ASSIGNMENT20) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE "NOTIFICATION-TYPE" "STATUS" IDENTIFIER "DESCRIPTION" STRING "::=" OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE "NOTIFICATION-GROUP" "NOTIFICATIONS" "{" IDENTIFIER+\,1$ "}" "STATUS" IDENTIFIER "DESCRIPTION" STRING "::=" OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE "MODULE-COMPLIANCE" "STATUS" IDENTIFIER "DESCRIPTION" STRING "MODULE" "MANDATORY-GROUPS" "{" IDENTIFIER+\,1$ "}" MODULE-COMPLIANCE-GROUP+ "::=" OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE "OBJECT-GROUP" "OBJECTS" "{" IDENTIFIER+\,1$ "}" "STATUS" IDENTIFIER "DESCRIPTION" STRING "::=" OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(OBJECT-TYPE-ACCESS . #S(ZEBU::ZB-RULE :-NAME OBJECT-TYPE-ACCESS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(OBJECT-TYPE-STATUS . #S(ZEBU::ZB-RULE :-NAME OBJECT-TYPE-STATUS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(MODULE-REVISION . #S(ZEBU::ZB-RULE :-NAME MODULE-REVISION :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("REVISION" STRING "DESCRIPTION" STRING) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(OBJECT-TYPE-INDEX . #S(ZEBU::ZB-RULE :-NAME OBJECT-TYPE-INDEX :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("INDEX" OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(MODULE-COMPLIANCE-GROUP . #S(ZEBU::ZB-RULE :-NAME MODULE-COMPLIANCE-GROUP :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("GROUP" IDENTIFIER "DESCRIPTION" STRING) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TYPE . #S(ZEBU::ZB-RULE :-NAME TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (BUILTIN-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAMED-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(BUILTIN-TYPE . #S(ZEBU::ZB-RULE :-NAME BUILTIN-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJECT-IDENTIFIER-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (CHOICE-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (STRING-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (INTEGER-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SEQUENCE-OF-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SEQUENCE-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TEXTUAL-CONVENTION-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAGGED-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(NAMED-TYPE . #S(ZEBU::ZB-RULE :-NAME NAMED-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(TEXTUAL-CONVENTION-TYPE . #S(ZEBU::ZB-RULE :-NAME TEXTUAL-CONVENTION-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("TEXTUAL-CONVENTION" TEXTUAL-CONVENTION-DISPLAY-HINT "STATUS" IDENTIFIER "DESCRIPTION" STRING TEXTUAL-CONVENTION-REFERENCE "SYNTAX" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TEXTUAL-CONVENTION-DISPLAY-HINT . #S(ZEBU::ZB-RULE :-NAME TEXTUAL-CONVENTION-DISPLAY-HINT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("DISPLAY-HINT" STRING) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TEXTUAL-CONVENTION-REFERENCE . #S(ZEBU::ZB-RULE :-NAME TEXTUAL-CONVENTION-REFERENCE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("REFERENCE" STRING) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(OBJECT-IDENTIFIER-TYPE . #S(ZEBU::ZB-RULE :-NAME OBJECT-IDENTIFIER-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("OBJECT" "IDENTIFIER") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(VALUE . #S(ZEBU::ZB-RULE :-NAME VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (BUILTIN-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(BUILTIN-VALUE . #S(ZEBU::ZB-RULE :-NAME BUILTIN-VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(OBJECT-IDENTIFIER-VALUE . #S(ZEBU::ZB-RULE :-NAME OBJECT-IDENTIFIER-VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("{" OBJ-ID-COMPONENTS+ "}") :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE OBJECT-IDENTIFIER-VALUE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL VALUE :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJECT-IDENTIFIER-VALUE18)))) +(OBJ-ID-COMPONENTS . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAME-AND-NUMBER-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAME-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NUMBER-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(NAME-AND-NUMBER-FORM . #S(ZEBU::ZB-RULE :-NAME NAME-AND-NUMBER-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER "(" NUMBER-FORM ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(NAME-FORM . #S(ZEBU::ZB-RULE :-NAME NAME-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(NUMBER-FORM . #S(ZEBU::ZB-RULE :-NAME NUMBER-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SIGNED-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(CHOICE-TYPE . #S(ZEBU::ZB-RULE :-NAME CHOICE-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("CHOICE" "{" GARBAGE+ "}") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(STRING-TYPE . #S(ZEBU::ZB-RULE :-NAME STRING-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("OCTET" "STRING" STRING-OPTIONS) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("DisplayString" STRING-OPTIONS) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(STRING-OPTIONS . #S(ZEBU::ZB-RULE :-NAME STRING-OPTIONS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("(" "SIZE" "(" NUMBERS ")" ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(NUMBERS . #S(ZEBU::ZB-RULE :-NAME NUMBERS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SIGNED-NUMBER "|" SIGNED-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SIGNED-NUMBER ".." SIGNED-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SIGNED-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(INTEGER-TYPE . #S(ZEBU::ZB-RULE :-NAME INTEGER-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("INTEGER" "(" SIGNED-NUMBER ".." SIGNED-NUMBER ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("INTEGER" "{" NAMED-NUMBER+\,1$ "}") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(NAMED-NUMBER . #S(ZEBU::ZB-RULE :-NAME NAMED-NUMBER :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER "(" SIGNED-NUMBER ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(SEQUENCE-TYPE . #S(ZEBU::ZB-RULE :-NAME SEQUENCE-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("SEQUENCE" "{" GARBAGE* "}") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(SEQUENCE-OF-TYPE . #S(ZEBU::ZB-RULE :-NAME SEQUENCE-OF-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("SEQUENCE" "OF" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TAGGED-TYPE . #S(ZEBU::ZB-RULE :-NAME TAGGED-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAG TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAG "IMPLICIT" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAG "EXPLICIT" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TAG . #S(ZEBU::ZB-RULE :-NAME TAG :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("[" CLASS CLASS-NUMBER "]") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(CLASS-NUMBER . #S(ZEBU::ZB-RULE :-NAME CLASS-NUMBER :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SIGNED-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(CLASS . #S(ZEBU::ZB-RULE :-NAME CLASS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("UNIVERSAL") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("APPLICATION") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("PRIVATE") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(GARBAGE* . #S(ZEBU::ZB-RULE :-NAME GARBAGE* :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE GARBAGE*) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE GARBAGE*))) :-BUILD-FN GARBAGE*17)))) +(NAMED-NUMBER+\,1$ . #S(ZEBU::ZB-RULE :-NAME NAMED-NUMBER+\,1$ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAMED-NUMBER) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE NAMED-NUMBER))) :-BUILD-FN NAMED-NUMBER+\,1$15) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAMED-NUMBER "," NAMED-NUMBER+\,1$) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE NAMED-NUMBER) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE NAMED-NUMBER+\,1$))) :-BUILD-FN NAMED-NUMBER+\,1$16)))) +(OBJ-ID-COMPONENTS+ . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS))) :-BUILD-FN OBJ-ID-COMPONENTS+13) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJ-ID-COMPONENTS+14)))) +(MODULE-COMPLIANCE-GROUP+ . #S(ZEBU::ZB-RULE :-NAME MODULE-COMPLIANCE-GROUP+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-COMPLIANCE-GROUP) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE MODULE-COMPLIANCE-GROUP))) :-BUILD-FN MODULE-COMPLIANCE-GROUP+11) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-COMPLIANCE-GROUP MODULE-COMPLIANCE-GROUP+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE MODULE-COMPLIANCE-GROUP) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE MODULE-COMPLIANCE-GROUP+))) :-BUILD-FN MODULE-COMPLIANCE-GROUP+12)))) +(IDENTIFIER+\,1$ . #S(ZEBU::ZB-RULE :-NAME IDENTIFIER+\,1$ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE IDENTIFIER))) :-BUILD-FN IDENTIFIER+\,1$9) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER "," IDENTIFIER+\,1$) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE IDENTIFIER) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE IDENTIFIER+\,1$))) :-BUILD-FN IDENTIFIER+\,1$10)))) +(MODULE-REVISION* . #S(ZEBU::ZB-RULE :-NAME MODULE-REVISION* :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-REVISION MODULE-REVISION*) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE MODULE-REVISION) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE MODULE-REVISION*))) :-BUILD-FN MODULE-REVISION*8)))) +(GARBAGE+ . #S(ZEBU::ZB-RULE :-NAME GARBAGE+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE))) :-BUILD-FN GARBAGE+6) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE GARBAGE+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE GARBAGE+))) :-BUILD-FN GARBAGE+7)))) +(SYMBOL+\,1$ . #S(ZEBU::ZB-RULE :-NAME SYMBOL+\,1$ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL))) :-BUILD-FN SYMBOL+\,1$4) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL "," SYMBOL+\,1$) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE SYMBOL+\,1$))) :-BUILD-FN SYMBOL+\,1$5)))) +(SYMBOLS-FROM-MODULE* . #S(ZEBU::ZB-RULE :-NAME SYMBOLS-FROM-MODULE* :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOLS-FROM-MODULE SYMBOLS-FROM-MODULE*) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOLS-FROM-MODULE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE SYMBOLS-FROM-MODULE*))) :-BUILD-FN SYMBOLS-FROM-MODULE*3)))) +(|Rest-SYMBOL*,1$| . #S(ZEBU::ZB-RULE :-NAME |Rest-SYMBOL*,1$| :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("," SYMBOL |Rest-SYMBOL*,1$|) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE |Rest-SYMBOL*,1$|))) :-BUILD-FN |Rest-SYMBOL*,1$2|)))) +(SYMBOL*\,1$ . #S(ZEBU::ZB-RULE :-NAME SYMBOL*\,1$ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL |Rest-SYMBOL*,1$|) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE |Rest-SYMBOL*,1$|))) :-BUILD-FN SYMBOL*\,1$1)))) +(ASSIGNMENT* . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT* :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT ASSIGNMENT*) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE ASSIGNMENT) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE ASSIGNMENT*))) :-BUILD-FN ASSIGNMENT*0)))) +) \ No newline at end of file Modified: trunk/asn.1/ber.lisp ============================================================================== --- trunk/asn.1/ber.lisp (original) +++ trunk/asn.1/ber.lisp Wed Sep 19 08:35:54 2007 @@ -127,88 +127,27 @@ (read-byte stream)) nil) -;;;;;;;;;;;;;;;;;;;;;;; -;;;; Special Types ;;;; -;;;;;;;;;;;;;;;;;;;;;;; +;;;; Test Code -;;; Integer (:integer) - -(defmethod ber-encode ((value integer)) - (assert (<= 0 value)) - (labels ((iter (n acc l) - (if (zerop n) (values acc l) - (multiple-value-bind (q r) (floor n 256) - (iter q (cons r acc) (1+ l)))))) - (multiple-value-bind (v l) (iter value nil 0) - (nconc (ber-encode-type 0 0 2) - (ber-encode-length l) - v)))) - -(defmethod ber-decode-value ((stream stream) (type (eql :integer)) length) - (declare (type stream stream) - (type fixnum length) - (ignore type)) - (labels ((iter (i acc) - (if (= i length) acc - (iter (1+ i) (logior (ash acc 8) (read-byte stream)))))) - (iter 0 0))) - -;;; OCTET STRING (:octet-string) - -(defmethod ber-encode ((value simple-base-string)) - (nconc (ber-encode-type 0 0 4) - (ber-encode-length (length value)) - (map 'list #'char-code value))) - -(defmethod ber-decode-value ((stream stream) (type (eql :octet-string)) length) - (declare (type stream stream) - (type fixnum length) - (ignore type)) - (let ((str (make-string length))) - (map-into str #'(lambda () (code-char (read-byte stream)))))) - -;;; SEQUENCE (:sequence) - -(defmethod ber-encode ((value sequence)) - (let ((sub-encode (apply #'nconc - (map 'list #'ber-encode value)))) - (nconc (ber-encode-type 0 1 16) - (ber-encode-length (length sub-encode)) - sub-encode))) - -(defmethod ber-decode-value ((stream stream) (type (eql :sequence)) length) - (declare (type stream stream) - (type fixnum length) - (ignore type)) - (labels ((iter (length-left acc) - (if (zerop length-left) - (nreverse acc) - (multiple-value-bind (sub-type sub-type-length) - (ber-decode-type stream) - (multiple-value-bind (sub-length sub-length-length) - (ber-decode-length stream) - (iter (- length-left - sub-type-length - sub-length-length - sub-length) - (cons (ber-decode-value stream sub-type sub-length) acc))))))) - (iter length nil))) - -;;; NULL (:null) -(defmethod ber-encode ((value (eql nil))) - (declare (ignore value)) - (nconc (ber-encode-type 0 0 5) - (ber-encode-length 0))) - -(defmethod ber-decode-value ((stream stream) (type (eql :null)) length) - (declare (type stream stream) - (type fixnum length) - (ignore type)) - (assert (zerop length)) - nil) - -(eval-when (:load-toplevel :execute) - (install-asn.1-type :integer 0 0 2) - (install-asn.1-type :octet-string 0 0 4) - (install-asn.1-type :null 0 0 5) - (install-asn.1-type :sequence 0 1 16)) +(defclass ber-stream (fundamental-input-stream) + ((sequence :type sequence :initarg :seq :reader ber-sequence) + (length :type integer :accessor ber-length) + (position :type integer :initform 0 :accessor ber-position))) + +(defmethod shared-initialize :after ((instance ber-stream) slot-names &rest initargs) + (declare (ignore slot-names initargs)) + (setf (ber-length instance) (length (ber-sequence instance)))) + +(defmethod stream-read-byte ((instance ber-stream)) + (if (= (ber-position instance) (ber-length instance)) + :eof + (let ((byte (elt (ber-sequence instance) (ber-position instance)))) + (incf (ber-position instance)) + byte))) + +(defun ber-test (x) + (let ((code (ber-encode x))) + (format t "~A -> ~A~%~{~8,'0B ~}~%~{~D ~}~%" + x (ber-decode (make-instance 'ber-stream :seq code)) + code code) + x)) Modified: trunk/asn.1/mib-parse.lisp ============================================================================== --- trunk/asn.1/mib-parse.lisp (original) +++ trunk/asn.1/mib-parse.lisp Wed Sep 19 08:35:54 2007 @@ -1,16 +1,2 @@ (in-package :asn.1) -(defun parse-oid-def (syntax-tree) - (let ((module (car syntax-tree))) - (let ((assignment-list (Module-Body-assignment-list - (Module-Definition-body module)))) - (labels ((iter (kb-seq acc) - (if (null (kb-sequence-rest kb-seq)) - (nreverse (cons (kb-sequence-first kb-seq) acc)) - (iter (kb-sequence-rest kb-seq) - (cons (kb-sequence-first kb-seq) acc))))) - (mapcar #'cdr - (delete-if-not #'(lambda (x) (eq (car x) :value)) - (mapcar #'(lambda (x) (cons (assignment-type x) - (assignment-value x))) - (iter assignment-list nil)))))))) Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Wed Sep 19 08:35:54 2007 @@ -55,19 +55,40 @@ '("RFC1155-SMI" "SNMPv2-SMI")) -(defvar *asn.1-def* (merge-pathnames - (make-pathname :name "asn.1" :type "zb" - :directory '(:relative "asn.1")) - (asdf:component-pathname (asdf:find-system :net-snmp)))) - -(defparameter *asn.1-syntax* (merge-pathnames - (make-pathname :name "asn.1" :type "tab" - :directory '(:relative "asn.1")) - (asdf:component-pathname (asdf:find-system :net-snmp)))) - (defun parse-mib (file &key (verbose nil)) (let ((zb:*comment-start* "--") (zb:*comment-brackets* '(("/*" . "*/"))) (zb:*preserve-case* t)) - (zb:file-parser file :grammar (zb:find-grammar "ASN.1") :verbose verbose))) + (zb:file-parser file :grammar (find-grammar "ASN.1") :verbose verbose))) + +(defun parse-oid-def (syntax-tree) + (let ((module (car syntax-tree))) + (let ((assignment-list (Module-Body-assignment-list + (Module-Definition-body module)))) + (labels ((iter (kb-seq acc) + (if (null (kb-sequence-rest kb-seq)) + (nreverse (cons (kb-sequence-first kb-seq) acc)) + (iter (kb-sequence-rest kb-seq) + (cons (kb-sequence-first kb-seq) acc))))) + (mapcar #'cdr + (delete-if-not #'(lambda (x) (eq (car x) :value)) + (mapcar #'(lambda (x) (cons (assignment-type x) + (assignment-value x))) + (iter assignment-list nil)))))))) + +(defun test-parse (name) + (parse-oid-def (parse-mib (mib-pathname name)))) + +(defun mib-display (name &optional (lines 10)) + (let ((file (mib-pathname name))) + (with-open-file (s file :direction :input :element-type 'base-char) + (dotimes (i lines file) + (princ (read-line s)) + (fresh-line))))) + +(defun test-syntax (name) + (parse-mib (merge-pathnames + (make-pathname :name name :type "asn" + :directory '(:relative "asn.1" "test")) + (asdf:component-pathname (asdf:find-system :net-snmp))))) Added: trunk/asn.1/smi.lisp ============================================================================== --- (empty file) +++ trunk/asn.1/smi.lisp Wed Sep 19 08:35:54 2007 @@ -0,0 +1,87 @@ +(in-package :asn.1) + +;;;;;;;;;;;;;;;;;;;;;;; +;;;; Special Types ;;;; +;;;;;;;;;;;;;;;;;;;;;;; + +;;; Integer (:integer) + +(defmethod ber-encode ((value integer)) + (assert (<= 0 value)) + (labels ((iter (n acc l) + (if (zerop n) (values acc l) + (multiple-value-bind (q r) (floor n 256) + (iter q (cons r acc) (1+ l)))))) + (multiple-value-bind (v l) (iter value nil 0) + (nconc (ber-encode-type 0 0 2) + (ber-encode-length l) + v)))) + +(defmethod ber-decode-value ((stream stream) (type (eql :integer)) length) + (declare (type stream stream) + (type fixnum length) + (ignore type)) + (labels ((iter (i acc) + (if (= i length) acc + (iter (1+ i) (logior (ash acc 8) (read-byte stream)))))) + (iter 0 0))) + +;;; OCTET STRING (:octet-string) + +(defmethod ber-encode ((value simple-base-string)) + (nconc (ber-encode-type 0 0 4) + (ber-encode-length (length value)) + (map 'list #'char-code value))) + +(defmethod ber-decode-value ((stream stream) (type (eql :octet-string)) length) + (declare (type stream stream) + (type fixnum length) + (ignore type)) + (let ((str (make-string length))) + (map-into str #'(lambda () (code-char (read-byte stream)))))) + +;;; SEQUENCE (:sequence) + +(defmethod ber-encode ((value sequence)) + (let ((sub-encode (apply #'nconc + (map 'list #'ber-encode value)))) + (nconc (ber-encode-type 0 1 16) + (ber-encode-length (length sub-encode)) + sub-encode))) + +(defmethod ber-decode-value ((stream stream) (type (eql :sequence)) length) + (declare (type stream stream) + (type fixnum length) + (ignore type)) + (labels ((iter (length-left acc) + (if (zerop length-left) + (nreverse acc) + (multiple-value-bind (sub-type sub-type-length) + (ber-decode-type stream) + (multiple-value-bind (sub-length sub-length-length) + (ber-decode-length stream) + (iter (- length-left + sub-type-length + sub-length-length + sub-length) + (cons (ber-decode-value stream sub-type sub-length) acc))))))) + (iter length nil))) + +;;; NULL (:null) +(defmethod ber-encode ((value (eql nil))) + (declare (ignore value)) + (nconc (ber-encode-type 0 0 5) + (ber-encode-length 0))) + +(defmethod ber-decode-value ((stream stream) (type (eql :null)) length) + (declare (type stream stream) + (type fixnum length) + (ignore type)) + (assert (zerop length)) + nil) + +(eval-when (:load-toplevel :execute) + (install-asn.1-type :integer 0 0 2) + (install-asn.1-type :octet-string 0 0 4) + (install-asn.1-type :null 0 0 5) + (install-asn.1-type :sequence 0 1 16)) Modified: trunk/asn.1/stream-test.lisp ============================================================================== --- trunk/asn.1/stream-test.lisp (original) +++ trunk/asn.1/stream-test.lisp Wed Sep 19 08:35:54 2007 @@ -3,47 +3,3 @@ (eval-when (:compile-toplevel :load-toplevel) (clc:clc-require :zebu-compiler)) -(defclass ber-stream (fundamental-input-stream) - ((sequence :type sequence :initarg :seq :reader ber-sequence) - (length :type integer :accessor ber-length) - (position :type integer :initform 0 :accessor ber-position))) - -(defmethod shared-initialize :after ((instance ber-stream) slot-names &rest initargs) - (declare (ignore slot-names initargs)) - (setf (ber-length instance) (length (ber-sequence instance)))) - -(defmethod stream-read-byte ((instance ber-stream)) - (if (= (ber-position instance) (ber-length instance)) - :eof - (let ((byte (elt (ber-sequence instance) (ber-position instance)))) - (incf (ber-position instance)) - byte))) - -(defun ber-test (x) - (let ((code (ber-encode x))) - (format t "~A -> ~A~%~{~8,'0B ~}~%~{~D ~}~%" - x (ber-decode (make-instance 'ber-stream :seq code)) - code code) - x)) - -(defun mib-display (name &optional (lines 10)) - (let ((file (mib-pathname name))) - (with-open-file (s file :direction :input :element-type 'base-char) - (dotimes (i lines file) - (princ (read-line s)) - (fresh-line))))) - -(defun load-syntax (&optional (def *asn.1-def*) (syntax *asn.1-syntax*)) - (let ((zb:*warn-conflicts* t) - (zb:*allow-conflicts* t)) - (zb:zebu-compile-file def :output-file syntax)) - (zb:zebu-load-file syntax)) - -(defun test-syntax (name) - (parse-mib (merge-pathnames - (make-pathname :name name :type "asn" - :directory '(:relative "asn.1" "test")) - (asdf:component-pathname (asdf:find-system :net-snmp))))) - -(defun test-parse (name) - (parse-oid-def (parse-mib (mib-pathname name)))) Added: trunk/asn.1/syntax.lisp ============================================================================== --- (empty file) +++ trunk/asn.1/syntax.lisp Wed Sep 19 08:35:54 2007 @@ -0,0 +1,21 @@ +(in-package :asn.1) + +(defvar *asn.1-syntax-source* (merge-pathnames + (make-pathname :name "asn.1" :type "zb" + :directory '(:relative "asn.1")) + (asdf:component-pathname (asdf:find-system :net-snmp)))) + +(defparameter *asn.1-syntax* (merge-pathnames + (make-pathname :name "asn.1" :type "tab" + :directory '(:relative "asn.1")) + (asdf:component-pathname (asdf:find-system :net-snmp)))) + +(eval-when (:load-toplevel :execute) + (zebu-load-file *asn.1-syntax*)) + +(defun update-syntax (&optional (zb *asn.1-syntax-source*) (tab *asn.1-syntax*)) + (let ((*warn-conflicts* t) + (*allow-conflicts* t)) + (zebu-compile-file zb :output-file tab) + (zebu-load-file tab))) +

1 0

[cl-net-snmp-cvs] r44 - in trunk: . asn.1
by ctian＠common-lisp.net 17 Sep '07

17 Sep '07

Author: ctian Date: Mon Sep 17 14:16:05 2007 New Revision: 44 Modified: trunk/asn.1/asn.1.zb trunk/asn.1/mib.lisp trunk/asn.1/stream-test.lisp trunk/net-snmp.asd Log: Add zb asdf support Modified: trunk/asn.1/asn.1.zb ============================================================================== --- trunk/asn.1/asn.1.zb (original) +++ trunk/asn.1/asn.1.zb Mon Sep 17 14:16:05 2007 @@ -24,7 +24,6 @@ Value-Assignment := kb-domain: [(name) (type) (value)]; Object-Type-Assignment := Value-Assignment: [(syntax) (max-access) (status) (description) (index)]; -Type := kb-domain: []; Object-Identifier-Value := kb-domain: [(value)]; ;; Rule Definitions @@ -99,6 +98,7 @@ (syntax Type) (max-access Object-Type-Access) (status Object-Type-Status) + (description String) (index Object-Type-Index) (value Object-Identifier-Value)] } Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Mon Sep 17 14:16:05 2007 @@ -67,6 +67,7 @@ (defun parse-mib (file &key (verbose nil)) (let ((zb:*comment-start* "--") - (zb:*comment-brackets* '(("/*" . "*/")))) + (zb:*comment-brackets* '(("/*" . "*/"))) + (zb:*preserve-case* t)) (zb:file-parser file :grammar (zb:find-grammar "ASN.1") :verbose verbose))) Modified: trunk/asn.1/stream-test.lisp ============================================================================== --- trunk/asn.1/stream-test.lisp (original) +++ trunk/asn.1/stream-test.lisp Mon Sep 17 14:16:05 2007 @@ -34,7 +34,9 @@ (fresh-line))))) (defun load-syntax (&optional (def *asn.1-def*) (syntax *asn.1-syntax*)) - (zb:zebu-compile-file def :output-file syntax) + (let ((zb:*warn-conflicts* t) + (zb:*allow-conflicts* t)) + (zb:zebu-compile-file def :output-file syntax)) (zb:zebu-load-file syntax)) (defun test-syntax (name) Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Mon Sep 17 14:16:05 2007 @@ -18,7 +18,9 @@ (:file "ber" :depends-on ("package")) (:file "oid" :depends-on ("ber")) (:file "mib" :depends-on ("oid")) - (:file "mib-parse" :depends-on ("mib")))) + (:zebu-source-file "asn.1") + (:file "mib-parse" + :depends-on ("mib" "asn.1")))) (:file "package") (:file "constants" :depends-on ("package")) (:file "typedefs" :depends-on ("constants"))

1 0

[cl-net-snmp-cvs] r43 - in trunk/asn.1: . test
by ctian＠common-lisp.net 17 Sep '07

17 Sep '07

Author: ctian Date: Mon Sep 17 04:26:03 2007 New Revision: 43 Modified: trunk/asn.1/asn.1.zb trunk/asn.1/mib.lisp trunk/asn.1/test/1.asn Log: Continue Fixing ASN.1 Syntax Modified: trunk/asn.1/asn.1.zb ============================================================================== --- trunk/asn.1/asn.1.zb (original) +++ trunk/asn.1/asn.1.zb Mon Sep 17 04:26:03 2007 @@ -1,4 +1,4 @@ -;;;; -*- Mode: Lisp -*- +;;;; -*- Mode: Text -*- (:name "ASN.1" :domain-file "asn.1-domain.lisp" @@ -11,18 +11,21 @@ :case-sensitive t :lex-cats ((Type-Reference "[A-Z][a-zA-Z0-9-]*") (Signed-Number "-?[0-9]+") - (Any-Thing "[^ ]+"))) + (Anything "[^ ]+"))) ;; Domain Definitions Module-Definition := kb-domain: [(identifier) (body)]; Module-Body := kb-domain: [(exports) (imports) (assignment-list kb-sequence)]; -KB-List := kb-domain: [(list kb-sequence)]; -KB-Item := kb-domain: [(item)]; +Exports := kb-domain: [(list kb-sequence) (all-exports)]; +Imports := kb-domain: [(list kb-sequence) (valid)]; Symbols-From-Module := kb-domain: [(symbols) (global-module-reference)]; Assignment := kb-domain: [(type) (value)]; -Obj-Id-Components-List := kb-domain: [(-list kb-sequence)]; -Value-Assignment := kb-domain: [(-value-reference) (-type) (-value)]; +Value-Assignment := kb-domain: [(name) (type) (value)]; +Object-Type-Assignment := + Value-Assignment: [(syntax) (max-access) (status) (description) (index)]; +Type := kb-domain: []; +Object-Identifier-Value := kb-domain: [(value)]; ;; Rule Definitions Module-Definition --> @@ -38,18 +41,20 @@ (exports Exports) (imports Imports)] } | ; -Exports --> "EXPORTS" Symbol* "," ";" { KB-List:[(list Symbol*)] } - | "EXPORTS" "ALL" ";" { KB-Item:[(item :all)] } +Exports --> "EXPORTS" Symbol* "," ";" { Exports:[(list Symbol*)] } + | "EXPORTS" "ALL" ";" { Exports:[(all-exports t)] } | ; Symbol --> Reference; -Imports --> "IMPORTS" Symbols-From-Module* " " ";" { KB-List:[(list Symbols-From-Module*)] } +Imports --> "IMPORTS" Symbols-From-Module* " " ";" + { Imports:[(valid t) (list Symbols-From-Module*)] } | ; Symbols-From-Module --> Symbol+ "," "FROM" Global-Module-Reference { Symbols-From-Module:[(symbols Symbol+) - (global-module-reference Global-Module-Reference)] }; + (global-module-reference + Global-Module-Reference)] }; Global-Module-Reference --> Module-Reference; Reference --> Type-Reference | Value-Reference; @@ -59,14 +64,15 @@ | Value-Assignment {Assignment:[(type :value) (value Value-Assignment)]}; Type-Assignment --> Type-Reference "::=" Type - | Type-Reference "MACRO" "::=" "BEGIN" Garbage+ " " "END"; + | Type-Reference "MACRO" "::=" "BEGIN" Garbage+ " " "END" + ; -Garbage --> Any-Thing; +Garbage --> Anything; Value-Assignment --> Value-Reference Type "::=" Value - { Value-Assignment:[(-value-reference Value-Reference) - (-type Type) - (-value Value)] } + { Value-Assignment:[(name Value-Reference) + (type Type) + (value Value)] } | Value-Reference "OBJECT-IDENTITY" "STATUS" Identifier @@ -83,11 +89,18 @@ | Value-Reference "OBJECT-TYPE" "SYNTAX" Type - "MAX-ACCESS" Identifier - "STATUS" Identifier + "MAX-ACCESS" Object-Type-Access + "STATUS" Object-Type-Status "DESCRIPTION" String Object-Type-Index "::=" Object-Identifier-Value + { Object-Type-Assignment:[(name Value-Reference) + (type :object-type) + (syntax Type) + (max-access Object-Type-Access) + (status Object-Type-Status) + (index Object-Type-Index) + (value Object-Identifier-Value)] } | Value-Reference "NOTIFICATION-TYPE" "STATUS" Identifier @@ -112,8 +125,11 @@ "STATUS" Identifier "DESCRIPTION" String "::=" Object-Identifier-Value + ; +Object-Type-Access --> Identifier; +Object-Type-Status --> Identifier; Module-Revision --> "REVISION" String "DESCRIPTION" String; Object-Type-Index --> "INDEX" Object-Identifier-Value |; Module-Compliance-Group --> "GROUP" Identifier "DESCRIPTION" String; @@ -126,20 +142,29 @@ | Integer-Type | Sequence-Of-Type | Sequence-Type + | Textual-Convention-Type | Tagged-Type; Named-Type --> Type-Reference; +Textual-Convention-Type --> "TEXTUAL-CONVENTION" + Textual-Convention-Display-Hint + "STATUS" Identifier + "DESCRIPTION" String + Textual-Convention-Reference + "SYNTAX" Type; + +Textual-Convention-Display-Hint --> "DISPLAY-HINT" String | ; +Textual-Convention-Reference --> "REFERENCE" String | ; + Object-Identifier-Type --> "OBJECT" "IDENTIFIER"; Value --> Builtin-Value; Builtin-Value --> Object-Identifier-Value; -Object-Identifier-Value --> "{" Obj-Id-Components-List "}"; - -Obj-Id-Components-List --> Obj-Id-Components+ " " - { Obj-Id-Components-List:[(-list Obj-Id-Components+)] }; +Object-Identifier-Value --> "{" Obj-Id-Components+ " " "}" + { Object-Identifier-Value:[(value Obj-Id-Components+)] }; Obj-Id-Components --> Name-And-Number-Form | Name-Form | Number-Form; Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Mon Sep 17 04:26:03 2007 @@ -65,8 +65,8 @@ :directory '(:relative "asn.1")) (asdf:component-pathname (asdf:find-system :net-snmp)))) -(defun parse-mib (file) +(defun parse-mib (file &key (verbose nil)) (let ((zb:*comment-start* "--") (zb:*comment-brackets* '(("/*" . "*/")))) - (zb:file-parser file :grammar (zb:find-grammar "ASN.1") :verbose t))) + (zb:file-parser file :grammar (zb:find-grammar "ASN.1") :verbose verbose))) Modified: trunk/asn.1/test/1.asn ============================================================================== --- trunk/asn.1/test/1.asn (original) +++ trunk/asn.1/test/1.asn Mon Sep 17 04:26:03 2007 @@ -1,48 +1,9 @@ RFC1155-SMI DEFINITIONS ::= BEGIN -EXPORTS -- EVERYTHING - internet, directory, mgmt, - experimental, private, enterprises, - OBJECT-TYPE, ObjectName, ObjectSyntax, SimpleSyntax, - ApplicationSyntax, NetworkAddress, IpAddress, - Counter, Gauge, TimeTicks, Opaque; - - -- the path to the root - - internet OBJECT IDENTIFIER ::= { iso org(3) dod(6) 1 } - - directory OBJECT IDENTIFIER ::= { internet 1 } - - mgmt OBJECT IDENTIFIER ::= { internet 2 } - - experimental OBJECT IDENTIFIER ::= { internet 3 } - - private OBJECT IDENTIFIER ::= { internet 4 } - enterprises OBJECT IDENTIFIER ::= { private 1 } - - -- definition of object types - - - -- names of objects in the MIB - - ObjectName ::= OBJECT IDENTIFIER - - OBJECT-TYPE MACRO ::= - BEGIN - TYPE NOTATION ::= "SYNTAX" type (TYPE ObjectSyntax) - "ACCESS" Access - "STATUS" Status - VALUE NOTATION ::= value (VALUE ObjectName) - - Access ::= "read-only" - | "read-write" - | "write-only" - | "not-accessible" - Status ::= "mandatory" - | "optional" - | "obsolete" - END +END - -- names of objects in the MIB +RFC1155-SMI DEFINITIONS ::= BEGIN END + + A-- CC

1 0

[cl-net-snmp-cvs] r42 - trunk/asn.1
by ctian＠common-lisp.net 16 Sep '07

16 Sep '07

Author: ctian Date: Sun Sep 16 14:13:20 2007 New Revision: 42 Modified: trunk/asn.1/ber.lisp trunk/asn.1/oid.lisp Log: Bugfix: (fixnum 0 ..) cannot use. Modified: trunk/asn.1/ber.lisp ============================================================================== --- trunk/asn.1/ber.lisp (original) +++ trunk/asn.1/ber.lisp Sun Sep 16 14:13:20 2007 @@ -35,9 +35,9 @@ (defun ber-encode-type (class p/c tags) "Encode BER Type Domain" - (declare (type (fixnum 0 3) class) - (type (fixnum 0 1) p/c) - (type (fixnum 0) tags)) + (declare (type (integer 0 3) class) + (type (integer 0 1) p/c) + (type (integer 0) tags)) (assert (and (<= 0 class 3) (<= 0 p/c 1) (<= 0 tags))) (labels ((iter (n p acc) (if (zerop n) acc @@ -84,7 +84,7 @@ (defun ber-encode-length (length) "Encode BER Length Domain" - (declare (type (fixnum 0) length)) + (declare (type (integer 0) length)) (assert (<= 0 length (1- (expt 2 1008)))) (labels ((iter (n acc l) (if (zerop n) (cons (mod (logior 128 l) 256) acc) Modified: trunk/asn.1/oid.lisp ============================================================================== --- trunk/asn.1/oid.lisp (original) +++ trunk/asn.1/oid.lisp Sun Sep 16 14:13:20 2007 @@ -46,7 +46,7 @@ ;;; the Lisp-SNMP Project: http://www.cliki.net/Lisp-SNMP (deftype oid-component () '(unsigned-byte 29)) -(deftype oid-component-length () '(fixnum 0 4)) +(deftype oid-component-length () '(integer 0 4)) (defun list-prefix-p (list1 list2) (if (endp list1)

1 0

[cl-net-snmp-cvs] r41 - in trunk/asn.1: . test
by ctian＠common-lisp.net 16 Sep '07

16 Sep '07

Author: ctian Date: Sun Sep 16 14:09:17 2007 New Revision: 41 Added: trunk/asn.1/test/5.asn trunk/asn.1/test/6.asn Modified: trunk/asn.1/asn.1.zb trunk/asn.1/ber.lisp trunk/asn.1/mib-parse.lisp trunk/asn.1/mib.lisp trunk/asn.1/oid.lisp trunk/asn.1/package.lisp trunk/asn.1/test/1.asn trunk/asn.1/test/3.asn trunk/asn.1/test/4.asn Log: SNMPv2-MIB passed Modified: trunk/asn.1/asn.1.zb ============================================================================== --- trunk/asn.1/asn.1.zb (original) +++ trunk/asn.1/asn.1.zb Sun Sep 16 14:09:17 2007 @@ -8,20 +8,19 @@ "abcdefghijklmnopqrstuvwxyz" :identifier-continue-chars "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" - :lex-cats (;;(BSTRING "'[01]+'B") - ;;(HSTRING "'([A-F0-9]+)'H") - (A-Number "-?[0-9]+") - (Value-Reference "[a-z][a-zA-Z0-9-]+") - (Type-Reference "[A-Z][a-zA-Z0-9-]*") - (Module-Reference "[A-Z][a-zA-Z0-9-]*") - (Any-Thing "[^ ]+"))) + :case-sensitive t + :lex-cats ((Type-Reference "[A-Z][a-zA-Z0-9-]*") + (Signed-Number "-?[0-9]+") + (Any-Thing "[^ ]+"))) ;; Domain Definitions -Module-Definition := kb-domain: [(-identifier) (-body)]; -Module-Body := kb-domain: [(-assignment-list)]; -Assignment-List := kb-domain: [(-list kb-sequence)]; -Assignment := kb-domain: [(-type) (-value)]; +Module-Definition := kb-domain: [(identifier) (body)]; +Module-Body := kb-domain: [(exports) (imports) (assignment-list kb-sequence)]; +KB-List := kb-domain: [(list kb-sequence)]; +KB-Item := kb-domain: [(item)]; +Symbols-From-Module := kb-domain: [(symbols) (global-module-reference)]; +Assignment := kb-domain: [(type) (value)]; Obj-Id-Components-List := kb-domain: [(-list kb-sequence)]; Value-Assignment := kb-domain: [(-value-reference) (-type) (-value)]; @@ -29,50 +28,108 @@ Module-Definition --> Module-Identifier "DEFINITIONS" "::=" "BEGIN" Module-Body "END" - { Module-Definition:[(-identifier Module-Identifier) (-body Module-Body)] }; + { Module-Definition:[(identifier Module-Identifier) (body Module-Body)] }; Module-Identifier --> Module-Reference; +Module-Reference --> Type-Reference; -Module-Body --> Exports Imports Assignment-List - { Module-Body:[(-assignment-list Assignment-List)] } +Module-Body --> Exports Imports Assignment* " " + { Module-Body:[(assignment-list Assignment*) + (exports Exports) (imports Imports)] } | ; -Exports --> "EXPORTS" Symbols-Exported ";" | "EXPORTS" "ALL" ";" |; - -Symbols-Exported --> Symbol+ "," | ; +Exports --> "EXPORTS" Symbol* "," ";" { KB-List:[(list Symbol*)] } + | "EXPORTS" "ALL" ";" { KB-Item:[(item :all)] } + | ; Symbol --> Reference; -Imports --> "IMPORTS" Type-Reference | ; +Imports --> "IMPORTS" Symbols-From-Module* " " ";" { KB-List:[(list Symbols-From-Module*)] } + | ; -Reference --> Type-Reference | Value-Reference; +Symbols-From-Module --> Symbol+ "," "FROM" Global-Module-Reference + { Symbols-From-Module:[(symbols Symbol+) + (global-module-reference Global-Module-Reference)] }; +Global-Module-Reference --> Module-Reference; -Assignment-List --> Assignment+ " " { Assignment-List:[(-list Assignment+)] }; +Reference --> Type-Reference | Value-Reference; +Value-Reference --> Identifier; -Assignment --> Type-Assignment {Assignment:[(-type :type) (-value Type-Assignment)]} - | Value-Assignment {Assignment:[(-type :value) (-value Value-Assignment)]} - |; - - ;;Macro-Assignment {Assignment:[(-type :macro) (-value Macro-Definition)]} - ;;| Special-Assignment {Assignment:[(-type :special) (-value Special-Assignment)]} - ;;| +Assignment --> Type-Assignment {Assignment:[(type :type) (value Type-Assignment)]} + | Value-Assignment {Assignment:[(type :value) (value Value-Assignment)]}; Type-Assignment --> Type-Reference "::=" Type | Type-Reference "MACRO" "::=" "BEGIN" Garbage+ " " "END"; +Garbage --> Any-Thing; + Value-Assignment --> Value-Reference Type "::=" Value { Value-Assignment:[(-value-reference Value-Reference) (-type Type) - (-value Value)] }; + (-value Value)] } + + | Value-Reference "OBJECT-IDENTITY" + "STATUS" Identifier + "DESCRIPTION" String + "::=" Object-Identifier-Value + + | Value-Reference "MODULE-IDENTITY" + "LAST-UPDATED" String + "ORGANIZATION" String + "CONTACT-INFO" String + "DESCRIPTION" String + Module-Revision* " " + "::=" Object-Identifier-Value + + | Value-Reference "OBJECT-TYPE" + "SYNTAX" Type + "MAX-ACCESS" Identifier + "STATUS" Identifier + "DESCRIPTION" String + Object-Type-Index + "::=" Object-Identifier-Value + + | Value-Reference "NOTIFICATION-TYPE" + "STATUS" Identifier + "DESCRIPTION" String + "::=" Object-Identifier-Value + + | Value-Reference "NOTIFICATION-GROUP" + "NOTIFICATIONS" "{" Identifier+ "," "}" + "STATUS" Identifier + "DESCRIPTION" String + "::=" Object-Identifier-Value + + | Value-Reference "MODULE-COMPLIANCE" + "STATUS" Identifier + "DESCRIPTION" String + "MODULE" "MANDATORY-GROUPS" "{" Identifier+ "," "}" + Module-Compliance-Group+ " " + "::=" Object-Identifier-Value + + | Value-Reference "OBJECT-GROUP" + "OBJECTS" "{" Identifier+ "," "}" + "STATUS" Identifier + "DESCRIPTION" String + "::=" Object-Identifier-Value + ; + +Module-Revision --> "REVISION" String "DESCRIPTION" String; +Object-Type-Index --> "INDEX" Object-Identifier-Value |; +Module-Compliance-Group --> "GROUP" Identifier "DESCRIPTION" String; -Type --> Builtin-Type; +Type --> Builtin-Type | Named-Type; Builtin-Type --> Object-Identifier-Type | Choice-Type - | Octet-String-Type + | String-Type | Integer-Type + | Sequence-Of-Type + | Sequence-Type | Tagged-Type; +Named-Type --> Type-Reference; + Object-Identifier-Type --> "OBJECT" "IDENTIFIER"; Value --> Builtin-Value; @@ -88,33 +145,28 @@ Name-And-Number-Form --> Identifier "(" Number-Form ")"; Name-Form --> Identifier; -Number-Form --> A-Number; +Number-Form --> Signed-Number; -Special-Assignment --> Macro-Name "MACRO" "::=" "BEGIN" Garbage+ " " "END"; +Choice-Type --> "CHOICE" "{" Garbage+ " " "}"; +String-Type --> "OCTET" "STRING" String-Options + | "DisplayString" String-Options; -Macro-Assignment --> "MACRO-DEFINITION" "::=" "{" "}"; +String-Options --> "(" "SIZE" "(" Numbers ")" ")" |; -;;"zeroDotZero" "OBJECT-IDENTITY" -;; "STATUS" "current" -;; "DESCRIPTION" "\"" Garbage+ "\"" -;; "::=" "{" Garbage+ "}" ; +Numbers --> Signed-Number "|" Signed-Number + | Signed-Number ".." Signed-Number + | Signed-Number; -Macro-Name --> "OBJECT-TYPE" - | "MODULE-IDENTITY" - | "OBJECT-IDENTITY" - | "NOTIFICATION-TYPE"; +Integer-Type --> "INTEGER" "(" Signed-Number ".." Signed-Number ")" + | "INTEGER" "{" Named-Number+ "," "}" ; +Named-Number --> Identifier "(" Signed-Number ")"; -Garbage --> Any-Thing; +Sequence-Type --> "SEQUENCE" "{" Garbage* " " "}"; -Choice-Type --> "CHOICE" "{" Garbage+ " " "}"; -Octet-String-Type --> "OCTET" "STRING" String-Options; -String-Options --> "(" "SIZE" "(" Numbers ")" ")" |; -Numbers --> A-Number "|" A-Number - | A-Number; +Sequence-Of-Type --> "SEQUENCE" "OF" Type; -Integer-Type --> "INTEGER" "(" A-Number ".." A-Number ")"; Tagged-Type --> Tag Type | Tag "IMPLICIT" Type | Tag "EXPLICIT" Type; Tag --> "[" Class Class-Number "]"; -Class-Number --> A-Number; +Class-Number --> Signed-Number; Class --> "UNIVERSAL" | "APPLICATION" | "PRIVATE" |; Modified: trunk/asn.1/ber.lisp ============================================================================== --- trunk/asn.1/ber.lisp (original) +++ trunk/asn.1/ber.lisp Sun Sep 16 14:09:17 2007 @@ -4,8 +4,7 @@ (in-package :asn.1) -(let ((dispatch-table - (make-hash-table :test #'equal))) +(let ((dispatch-table (make-hash-table :test #'equal))) (defun get-asn.1-type (class p/c tags) (gethash (list class p/c tags) dispatch-table :unknown)) (defun install-asn.1-type (type class p/c tags) @@ -36,9 +35,9 @@ (defun ber-encode-type (class p/c tags) "Encode BER Type Domain" - (declare (type (integer 0 3) class) - (type (integer 0 1) p/c) - (type (integer 0) tags)) + (declare (type (fixnum 0 3) class) + (type (fixnum 0 1) p/c) + (type (fixnum 0) tags)) (assert (and (<= 0 class 3) (<= 0 p/c 1) (<= 0 tags))) (labels ((iter (n p acc) (if (zerop n) acc @@ -85,7 +84,7 @@ (defun ber-encode-length (length) "Encode BER Length Domain" - (declare (type (integer 0) length)) + (declare (type (fixnum 0) length)) (assert (<= 0 length (1- (expt 2 1008)))) (labels ((iter (n acc l) (if (zerop n) (cons (mod (logior 128 l) 256) acc) @@ -122,7 +121,7 @@ (defmethod ber-decode-value ((stream stream) (type (eql :unknown)) length) (declare (type stream stream) - (type integer length) + (type fixnum length) (ignore type)) (dotimes (i length) (read-byte stream)) @@ -147,7 +146,7 @@ (defmethod ber-decode-value ((stream stream) (type (eql :integer)) length) (declare (type stream stream) - (type integer length) + (type fixnum length) (ignore type)) (labels ((iter (i acc) (if (= i length) acc @@ -163,7 +162,7 @@ (defmethod ber-decode-value ((stream stream) (type (eql :octet-string)) length) (declare (type stream stream) - (type integer length) + (type fixnum length) (ignore type)) (let ((str (make-string length))) (map-into str #'(lambda () (code-char (read-byte stream)))))) @@ -179,7 +178,7 @@ (defmethod ber-decode-value ((stream stream) (type (eql :sequence)) length) (declare (type stream stream) - (type integer length) + (type fixnum length) (ignore type)) (labels ((iter (length-left acc) (if (zerop length-left) @@ -203,7 +202,7 @@ (defmethod ber-decode-value ((stream stream) (type (eql :null)) length) (declare (type stream stream) - (type integer length) + (type fixnum length) (ignore type)) (assert (zerop length)) nil) Modified: trunk/asn.1/mib-parse.lisp ============================================================================== --- trunk/asn.1/mib-parse.lisp (original) +++ trunk/asn.1/mib-parse.lisp Sun Sep 16 14:09:17 2007 @@ -2,16 +2,15 @@ (defun parse-oid-def (syntax-tree) (let ((module (car syntax-tree))) - (let ((assignment-list (Assignment-List--list - (Module-Body--assignment-list - (Module-Definition--body module))))) + (let ((assignment-list (Module-Body-assignment-list + (Module-Definition-body module)))) (labels ((iter (kb-seq acc) (if (null (kb-sequence-rest kb-seq)) - (nreverse (cons (kb-sequence-first kb-seq) acc)) - (iter (kb-sequence-rest kb-seq) - (cons (kb-sequence-first kb-seq) acc))))) - (mapcar #'cdr - (delete-if-not #'(lambda (x) (eq (car x) :value)) - (mapcar #'(lambda (x) (cons (assignment--type x) - (assignment--value x))) - (iter assignment-list nil)))))))) + (nreverse (cons (kb-sequence-first kb-seq) acc)) + (iter (kb-sequence-rest kb-seq) + (cons (kb-sequence-first kb-seq) acc))))) + (mapcar #'cdr + (delete-if-not #'(lambda (x) (eq (car x) :value)) + (mapcar #'(lambda (x) (cons (assignment-type x) + (assignment-value x))) + (iter assignment-list nil)))))))) Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Sun Sep 16 14:09:17 2007 @@ -24,7 +24,7 @@ (iter (copy-list (tree-nodes node)))))) (defun make-node (id name &optional (object nil)) - (declare (type integer id) + (declare (type fixnum id) (type string name)) (list id (cons name object))) Modified: trunk/asn.1/oid.lisp ============================================================================== --- trunk/asn.1/oid.lisp (original) +++ trunk/asn.1/oid.lisp Sun Sep 16 14:09:17 2007 @@ -46,7 +46,7 @@ ;;; the Lisp-SNMP Project: http://www.cliki.net/Lisp-SNMP (deftype oid-component () '(unsigned-byte 29)) -(deftype oid-component-length () '(integer 0 4)) +(deftype oid-component-length () '(fixnum 0 4)) (defun list-prefix-p (list1 list2) (if (endp list1) @@ -112,7 +112,7 @@ (defmethod ber-decode-value ((stream stream) (type (eql :object-identifier)) length) (declare (type stream stream) - (type integer length) + (type fixnum length) (ignore type)) (if (zerop length) (make-instance 'objet-id) @@ -122,7 +122,7 @@ (if (< byte 128) (values val len) (get-number val (1+ len))))) (iter (left-length acc head-p) - (declare (type integer left-length) + (declare (type fixnum left-length) (type list acc)) (if (zerop left-length) (nreverse acc) (multiple-value-bind (n l) (get-number 0 1) Modified: trunk/asn.1/package.lisp ============================================================================== --- trunk/asn.1/package.lisp (original) +++ trunk/asn.1/package.lisp Sun Sep 16 14:09:17 2007 @@ -3,6 +3,8 @@ (defpackage :asn.1 (:use :common-lisp #+lispworks :stream + #+sbcl :sb-gray + #+clisp :gray :zebu)) (in-package :asn.1) Modified: trunk/asn.1/test/1.asn ============================================================================== --- trunk/asn.1/test/1.asn (original) +++ trunk/asn.1/test/1.asn Sun Sep 16 14:09:17 2007 @@ -27,4 +27,22 @@ ObjectName ::= OBJECT IDENTIFIER + OBJECT-TYPE MACRO ::= + BEGIN + TYPE NOTATION ::= "SYNTAX" type (TYPE ObjectSyntax) + "ACCESS" Access + "STATUS" Status + VALUE NOTATION ::= value (VALUE ObjectName) + + Access ::= "read-only" + | "read-write" + | "write-only" + | "not-accessible" + Status ::= "mandatory" + | "optional" + | "obsolete" + END + + -- names of objects in the MIB + END Modified: trunk/asn.1/test/3.asn ============================================================================== --- trunk/asn.1/test/3.asn (original) +++ trunk/asn.1/test/3.asn Sun Sep 16 14:09:17 2007 @@ -333,10 +333,9 @@ -- definitions of administrative identifiers -MACRO-DEFINITION ::= { } ---zeroDotZero OBJECT-IDENTITY --- STATUS current --- DESCRIPTION --- "A value used for null identifiers." - +zeroDotZero OBJECT-IDENTITY + STATUS current + DESCRIPTION + "A value used for null identifiers." + ::= { 0 0 } END Modified: trunk/asn.1/test/4.asn ============================================================================== --- trunk/asn.1/test/4.asn (original) +++ trunk/asn.1/test/4.asn Sun Sep 16 14:09:17 2007 @@ -335,10 +335,10 @@ -- definitions of administrative identifiers ---zeroDotZero OBJECT-IDENTITY --- STATUS current --- DESCRIPTION --- "A value used for null identifiers." --- ::= { 0 0 } +zeroDotZero OBJECT-IDENTITY + STATUS current + DESCRIPTION + "A value used for null identifiers." + ::= { 0 0 } END Added: trunk/asn.1/test/5.asn ============================================================================== --- (empty file) +++ trunk/asn.1/test/5.asn Sun Sep 16 14:09:17 2007 @@ -0,0 +1,853 @@ +SNMPv2-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, NOTIFICATION-TYPE, + TimeTicks, Counter32, snmpModules, mib-2 + FROM SNMPv2-SMI + DisplayString, TestAndIncr, TimeStamp + + FROM SNMPv2-TC + MODULE-COMPLIANCE, OBJECT-GROUP, NOTIFICATION-GROUP + FROM SNMPv2-CONF; + +snmpMIB MODULE-IDENTITY + LAST-UPDATED "200210160000Z" + ORGANIZATION "IETF SNMPv3 Working Group" + CONTACT-INFO + "WG-EMail: snmpv3(a)lists.tislabs.com + Subscribe: snmpv3-request(a)lists.tislabs.com + + Co-Chair: Russ Mundy + Network Associates Laboratories + postal: 15204 Omega Drive, Suite 300 + Rockville, MD 20850-4601 + USA + EMail: mundy(a)tislabs.com + phone: +1 301 947-7107 + + Co-Chair: David Harrington + Enterasys Networks + postal: 35 Industrial Way + P. O. Box 5005 + Rochester, NH 03866-5005 + USA + EMail: dbh(a)enterasys.com + phone: +1 603 337-2614 + + Editor: Randy Presuhn + BMC Software, Inc. + postal: 2141 North First Street + San Jose, CA 95131 + USA + EMail: randy_presuhn(a)bmc.com + phone: +1 408 546-1006" + DESCRIPTION + "The MIB module for SNMP entities. + + Copyright (C) The Internet Society (2002). This + version of this MIB module is part of RFC 3418; + see the RFC itself for full legal notices. + " + REVISION "200210160000Z" + DESCRIPTION + "This revision of this MIB module was published as + RFC 3418." + REVISION "199511090000Z" + DESCRIPTION + "This revision of this MIB module was published as + RFC 1907." + REVISION "199304010000Z" + DESCRIPTION + "The initial revision of this MIB module was published + as RFC 1450." + ::= { snmpModules 1 } + + snmpMIBObjects OBJECT IDENTIFIER ::= { snmpMIB 1 } + +-- ::= { snmpMIBObjects 1 } this OID is obsolete +-- ::= { snmpMIBObjects 2 } this OID is obsolete +-- ::= { snmpMIBObjects 3 } this OID is obsolete + +-- the System group +-- +-- a collection of objects common to all managed systems. + +system OBJECT IDENTIFIER ::= { mib-2 1 } + +sysDescr OBJECT-TYPE + SYNTAX DisplayString (SIZE (0..255)) + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "A textual description of the entity. This value should + include the full name and version identification of + the system's hardware type, software operating-system, + and networking software." + ::= { system 1 } + +sysObjectID OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The vendor's authoritative identification of the + network management subsystem contained in the entity. + This value is allocated within the SMI enterprises + subtree (1.3.6.1.4.1) and provides an easy and + unambiguous means for determining `what kind of box' is + being managed. For example, if vendor `Flintstones, + Inc.' was assigned the subtree 1.3.6.1.4.1.424242, + it could assign the identifier 1.3.6.1.4.1.424242.1.1 + to its `Fred Router'." + ::= { system 2 } + +sysUpTime OBJECT-TYPE + SYNTAX TimeTicks + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The time (in hundredths of a second) since the + network management portion of the system was last + re-initialized." + ::= { system 3 } + +sysContact OBJECT-TYPE + SYNTAX DisplayString (SIZE (0..255)) + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "The textual identification of the contact person for + this managed node, together with information on how + to contact this person. If no contact information is + known, the value is the zero-length string." + ::= { system 4 } + +sysName OBJECT-TYPE + SYNTAX DisplayString (SIZE (0..255)) + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "An administratively-assigned name for this managed + node. By convention, this is the node's fully-qualified + domain name. If the name is unknown, the value is + the zero-length string." + ::= { system 5 } + +sysLocation OBJECT-TYPE + SYNTAX DisplayString (SIZE (0..255)) + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "The physical location of this node (e.g., 'telephone + closet, 3rd floor'). If the location is unknown, the + value is the zero-length string." + ::= { system 6 } + +sysServices OBJECT-TYPE + SYNTAX INTEGER (0..127) + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "A value which indicates the set of services that this + entity may potentially offer. The value is a sum. + + This sum initially takes the value zero. Then, for + each layer, L, in the range 1 through 7, that this node + performs transactions for, 2 raised to (L - 1) is added + to the sum. For example, a node which performs only + routing functions would have a value of 4 (2^(3-1)). + In contrast, a node which is a host offering application + services would have a value of 72 (2^(4-1) + 2^(7-1)). + Note that in the context of the Internet suite of + protocols, values should be calculated accordingly: + + layer functionality + 1 physical (e.g., repeaters) + 2 datalink/subnetwork (e.g., bridges) + 3 internet (e.g., supports the IP) + 4 end-to-end (e.g., supports the TCP) + 7 applications (e.g., supports the SMTP) + + For systems including OSI protocols, layers 5 and 6 + may also be counted." + ::= { system 7 } + +-- object resource information +-- +-- a collection of objects which describe the SNMP entity's +-- (statically and dynamically configurable) support of +-- various MIB modules. + +sysORLastChange OBJECT-TYPE + SYNTAX TimeStamp + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value of sysUpTime at the time of the most recent + change in state or value of any instance of sysORID." + ::= { system 8 } + +sysORTable OBJECT-TYPE + SYNTAX SEQUENCE OF SysOREntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "The (conceptual) table listing the capabilities of + the local SNMP application acting as a command + responder with respect to various MIB modules. + SNMP entities having dynamically-configurable support + of MIB modules will have a dynamically-varying number + of conceptual rows." + ::= { system 9 } + +sysOREntry OBJECT-TYPE + SYNTAX SysOREntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "An entry (conceptual row) in the sysORTable." + INDEX { sysORIndex } + ::= { sysORTable 1 } + +SysOREntry ::= SEQUENCE { + sysORIndex INTEGER, + sysORID OBJECT IDENTIFIER, + sysORDescr DisplayString, + sysORUpTime TimeStamp +} +sysORIndex OBJECT-TYPE + SYNTAX INTEGER (1..2147483647) + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "The auxiliary variable used for identifying instances + of the columnar objects in the sysORTable." + ::= { sysOREntry 1 } + +sysORID OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "An authoritative identification of a capabilities + statement with respect to various MIB modules supported + by the local SNMP application acting as a command + responder." + ::= { sysOREntry 2 } + +sysORDescr OBJECT-TYPE + SYNTAX DisplayString + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "A textual description of the capabilities identified + by the corresponding instance of sysORID." + ::= { sysOREntry 3 } + +sysORUpTime OBJECT-TYPE + SYNTAX TimeStamp + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value of sysUpTime at the time this conceptual + row was last instantiated." + ::= { sysOREntry 4 } + +-- the SNMP group +-- +-- a collection of objects providing basic instrumentation and +-- control of an SNMP entity. + +snmp OBJECT IDENTIFIER ::= { mib-2 11 } + +snmpInPkts OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of messages delivered to the SNMP + entity from the transport service." + ::= { snmp 1 } + +snmpInBadVersions OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of SNMP messages which were delivered + to the SNMP entity and were for an unsupported SNMP + version." + ::= { snmp 3 } + +snmpInBadCommunityNames OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of community-based SNMP messages (for + example, SNMPv1) delivered to the SNMP entity which + used an SNMP community name not known to said entity. + Also, implementations which authenticate community-based + SNMP messages using check(s) in addition to matching + the community name (for example, by also checking + whether the message originated from a transport address + allowed to use a specified community name) MAY include + in this value the number of messages which failed the + additional check(s). It is strongly RECOMMENDED that + + the documentation for any security model which is used + to authenticate community-based SNMP messages specify + the precise conditions that contribute to this value." + ::= { snmp 4 } + +snmpInBadCommunityUses OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of community-based SNMP messages (for + example, SNMPv1) delivered to the SNMP entity which + represented an SNMP operation that was not allowed for + the SNMP community named in the message. The precise + conditions under which this counter is incremented + (if at all) depend on how the SNMP entity implements + its access control mechanism and how its applications + interact with that access control mechanism. It is + strongly RECOMMENDED that the documentation for any + access control mechanism which is used to control access + to and visibility of MIB instrumentation specify the + precise conditions that contribute to this value." + ::= { snmp 5 } + +snmpInASNParseErrs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of ASN.1 or BER errors encountered by + the SNMP entity when decoding received SNMP messages." + ::= { snmp 6 } + +snmpEnableAuthenTraps OBJECT-TYPE + SYNTAX INTEGER { enabled(1), disabled(2) } + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "Indicates whether the SNMP entity is permitted to + generate authenticationFailure traps. The value of this + object overrides any configuration information; as such, + it provides a means whereby all authenticationFailure + traps may be disabled. + + Note that it is strongly recommended that this object + be stored in non-volatile memory so that it remains + constant across re-initializations of the network + management system." + ::= { snmp 30 } + +snmpSilentDrops OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of Confirmed Class PDUs (such as + GetRequest-PDUs, GetNextRequest-PDUs, + GetBulkRequest-PDUs, SetRequest-PDUs, and + InformRequest-PDUs) delivered to the SNMP entity which + were silently dropped because the size of a reply + containing an alternate Response Class PDU (such as a + Response-PDU) with an empty variable-bindings field + was greater than either a local constraint or the + maximum message size associated with the originator of + the request." + ::= { snmp 31 } + +snmpProxyDrops OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of Confirmed Class PDUs + (such as GetRequest-PDUs, GetNextRequest-PDUs, + GetBulkRequest-PDUs, SetRequest-PDUs, and + InformRequest-PDUs) delivered to the SNMP entity which + were silently dropped because the transmission of + the (possibly translated) message to a proxy target + failed in a manner (other than a time-out) such that + no Response Class PDU (such as a Response-PDU) could + be returned." + ::= { snmp 32 } + +-- information for notifications +-- +-- a collection of objects which allow the SNMP entity, when +-- supporting a notification originator application, +-- to be configured to generate SNMPv2-Trap-PDUs. + +snmpTrap OBJECT IDENTIFIER ::= { snmpMIBObjects 4 } + +snmpTrapOID OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS accessible-for-notify + STATUS current + DESCRIPTION + "The authoritative identification of the notification + currently being sent. This variable occurs as + the second varbind in every SNMPv2-Trap-PDU and + InformRequest-PDU." + ::= { snmpTrap 1 } + +-- ::= { snmpTrap 2 } this OID is obsolete + +snmpTrapEnterprise OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS accessible-for-notify + STATUS current + DESCRIPTION + "The authoritative identification of the enterprise + associated with the trap currently being sent. When an + SNMP proxy agent is mapping an RFC1157 Trap-PDU + into a SNMPv2-Trap-PDU, this variable occurs as the + last varbind." + ::= { snmpTrap 3 } + +-- ::= { snmpTrap 4 } this OID is obsolete + +-- well-known traps + +snmpTraps OBJECT IDENTIFIER ::= { snmpMIBObjects 5 } + +coldStart NOTIFICATION-TYPE + STATUS current + DESCRIPTION + "A coldStart trap signifies that the SNMP entity, + supporting a notification originator application, is + reinitializing itself and that its configuration may + have been altered." + ::= { snmpTraps 1 } + +warmStart NOTIFICATION-TYPE + STATUS current + DESCRIPTION + "A warmStart trap signifies that the SNMP entity, + supporting a notification originator application, + is reinitializing itself such that its configuration + is unaltered." + ::= { snmpTraps 2 } + +-- Note the linkDown NOTIFICATION-TYPE ::= { snmpTraps 3 } +-- and the linkUp NOTIFICATION-TYPE ::= { snmpTraps 4 } +-- are defined in RFC 2863 [RFC2863] + +authenticationFailure NOTIFICATION-TYPE + STATUS current + DESCRIPTION + "An authenticationFailure trap signifies that the SNMP + entity has received a protocol message that is not + properly authenticated. While all implementations + of SNMP entities MAY be capable of generating this + trap, the snmpEnableAuthenTraps object indicates + whether this trap will be generated." + ::= { snmpTraps 5 } + +-- Note the egpNeighborLoss notification is defined +-- as { snmpTraps 6 } in RFC 1213 + +-- the set group +-- +-- a collection of objects which allow several cooperating +-- command generator applications to coordinate their use of the +-- set operation. + +snmpSet OBJECT IDENTIFIER ::= { snmpMIBObjects 6 } + +snmpSetSerialNo OBJECT-TYPE + SYNTAX TestAndIncr + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "An advisory lock used to allow several cooperating + command generator applications to coordinate their + use of the SNMP set operation. + + This object is used for coarse-grain coordination. + To achieve fine-grain coordination, one or more similar + objects might be defined within each MIB group, as + appropriate." + ::= { snmpSet 1 } + +-- conformance information + +snmpMIBConformance + OBJECT IDENTIFIER ::= { snmpMIB 2 } + +snmpMIBCompliances + OBJECT IDENTIFIER ::= { snmpMIBConformance 1 } +snmpMIBGroups OBJECT IDENTIFIER ::= { snmpMIBConformance 2 } + +-- compliance statements +-- ::= { snmpMIBCompliances 1 } this OID is obsolete +snmpBasicCompliance MODULE-COMPLIANCE + STATUS deprecated + DESCRIPTION + "The compliance statement for SNMPv2 entities which + implement the SNMPv2 MIB. + + This compliance statement is replaced by + snmpBasicComplianceRev2." + MODULE -- this module + MANDATORY-GROUPS { snmpGroup, snmpSetGroup, systemGroup, + snmpBasicNotificationsGroup } + + GROUP snmpCommunityGroup + DESCRIPTION + "This group is mandatory for SNMPv2 entities which + support community-based authentication." + ::= { snmpMIBCompliances 2 } + + snmpBasicComplianceRev2 MODULE-COMPLIANCE + STATUS current + DESCRIPTION + "The compliance statement for SNMP entities which + implement this MIB module." + MODULE -- this module + MANDATORY-GROUPS { snmpGroup, snmpSetGroup, systemGroup, + snmpBasicNotificationsGroup } + + GROUP snmpCommunityGroup + DESCRIPTION + "This group is mandatory for SNMP entities which + support community-based authentication." + + GROUP snmpWarmStartNotificationGroup + DESCRIPTION + "This group is mandatory for an SNMP entity which + supports command responder applications, and is + able to reinitialize itself such that its + configuration is unaltered." + ::= { snmpMIBCompliances 3 } + +-- units of conformance + +-- ::= { snmpMIBGroups 1 } this OID is obsolete +-- ::= { snmpMIBGroups 2 } this OID is obsolete +-- ::= { snmpMIBGroups 3 } this OID is obsolete + +-- ::= { snmpMIBGroups 4 } this OID is obsolete + +snmpGroup OBJECT-GROUP + OBJECTS { snmpInPkts, + snmpInBadVersions, + snmpInASNParseErrs, + snmpSilentDrops, + snmpProxyDrops, + snmpEnableAuthenTraps } + STATUS current + DESCRIPTION + "A collection of objects providing basic instrumentation + and control of an SNMP entity." + ::= { snmpMIBGroups 8 } + +snmpCommunityGroup OBJECT-GROUP + OBJECTS { snmpInBadCommunityNames, + snmpInBadCommunityUses } + STATUS current + DESCRIPTION + "A collection of objects providing basic instrumentation + of a SNMP entity which supports community-based + authentication." + ::= { snmpMIBGroups 9 } + +snmpSetGroup OBJECT-GROUP + OBJECTS { snmpSetSerialNo } + STATUS current + DESCRIPTION + "A collection of objects which allow several cooperating + command generator applications to coordinate their + use of the set operation." + ::= { snmpMIBGroups 5 } + +systemGroup OBJECT-GROUP + OBJECTS { sysDescr, sysObjectID, sysUpTime, + sysContact, sysName, sysLocation, + sysServices, + sysORLastChange, sysORID, + sysORUpTime, sysORDescr } + STATUS current + DESCRIPTION + "The system group defines objects which are common to all + managed systems." + ::= { snmpMIBGroups 6 } + +snmpBasicNotificationsGroup NOTIFICATION-GROUP + NOTIFICATIONS { coldStart, authenticationFailure } + STATUS current + DESCRIPTION + "The basic notifications implemented by an SNMP entity + supporting command responder applications." + ::= { snmpMIBGroups 7 } + +snmpWarmStartNotificationGroup NOTIFICATION-GROUP + NOTIFICATIONS { warmStart } + STATUS current + DESCRIPTION + "An additional notification for an SNMP entity supporting + command responder applications, if it is able to reinitialize + itself such that its configuration is unaltered." + ::= { snmpMIBGroups 11 } + +snmpNotificationGroup OBJECT-GROUP + OBJECTS { snmpTrapOID, snmpTrapEnterprise } + STATUS current + DESCRIPTION + "These objects are required for entities + which support notification originator applications." + ::= { snmpMIBGroups 12 } + +-- definitions in RFC 1213 made obsolete by the inclusion of a +-- subset of the snmp group in this MIB + +snmpOutPkts OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Messages which were + passed from the SNMP protocol entity to the + transport service." + ::= { snmp 2 } + +-- { snmp 7 } is not used + +snmpInTooBigs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were + delivered to the SNMP protocol entity and for + which the value of the error-status field was + `tooBig'." + ::= { snmp 8 } + +snmpInNoSuchNames OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were + delivered to the SNMP protocol entity and for + which the value of the error-status field was + `noSuchName'." + ::= { snmp 9 } + +snmpInBadValues OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were + delivered to the SNMP protocol entity and for + which the value of the error-status field was + `badValue'." + ::= { snmp 10 } + +snmpInReadOnlys OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number valid SNMP PDUs which were delivered + to the SNMP protocol entity and for which the value + of the error-status field was `readOnly'. It should + be noted that it is a protocol error to generate an + SNMP PDU which contains the value `readOnly' in the + error-status field, as such this object is provided + as a means of detecting incorrect implementations of + the SNMP." + ::= { snmp 11 } + +snmpInGenErrs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were delivered + to the SNMP protocol entity and for which the value + of the error-status field was `genErr'." + ::= { snmp 12 } + +snmpInTotalReqVars OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of MIB objects which have been + retrieved successfully by the SNMP protocol entity + as the result of receiving valid SNMP Get-Request + and Get-Next PDUs." + ::= { snmp 13 } + +snmpInTotalSetVars OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of MIB objects which have been + altered successfully by the SNMP protocol entity as + the result of receiving valid SNMP Set-Request PDUs." + ::= { snmp 14 } + +snmpInGetRequests OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Request PDUs which + have been accepted and processed by the SNMP + protocol entity." + ::= { snmp 15 } + +snmpInGetNexts OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Next PDUs which have been + accepted and processed by the SNMP protocol entity." + ::= { snmp 16 } + +snmpInSetRequests OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Set-Request PDUs which + have been accepted and processed by the SNMP protocol + entity." + ::= { snmp 17 } + +snmpInGetResponses OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Response PDUs which + have been accepted and processed by the SNMP protocol + entity." + ::= { snmp 18 } + +snmpInTraps OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Trap PDUs which have been + accepted and processed by the SNMP protocol entity." + ::= { snmp 19 } + +snmpOutTooBigs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were generated + by the SNMP protocol entity and for which the value + of the error-status field was `tooBig.'" + ::= { snmp 20 } + +snmpOutNoSuchNames OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were generated + by the SNMP protocol entity and for which the value + of the error-status was `noSuchName'." + ::= { snmp 21 } + +snmpOutBadValues OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were generated + by the SNMP protocol entity and for which the value + of the error-status field was `badValue'." + ::= { snmp 22 } + +-- { snmp 23 } is not used + +snmpOutGenErrs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were generated + by the SNMP protocol entity and for which the value + of the error-status field was `genErr'." + ::= { snmp 24 } + +snmpOutGetRequests OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Request PDUs which + have been generated by the SNMP protocol entity." + ::= { snmp 25 } + +snmpOutGetNexts OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Next PDUs which have + been generated by the SNMP protocol entity." + ::= { snmp 26 } + +snmpOutSetRequests OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Set-Request PDUs which + have been generated by the SNMP protocol entity." + ::= { snmp 27 } + +snmpOutGetResponses OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Response PDUs which + have been generated by the SNMP protocol entity." + ::= { snmp 28 } + +snmpOutTraps OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Trap PDUs which have + been generated by the SNMP protocol entity." + ::= { snmp 29 } + +snmpObsoleteGroup OBJECT-GROUP + OBJECTS { snmpOutPkts, snmpInTooBigs, snmpInNoSuchNames, + snmpInBadValues, snmpInReadOnlys, snmpInGenErrs, + snmpInTotalReqVars, snmpInTotalSetVars, + snmpInGetRequests, snmpInGetNexts, snmpInSetRequests, + snmpInGetResponses, snmpInTraps, snmpOutTooBigs, + snmpOutNoSuchNames, snmpOutBadValues, + snmpOutGenErrs, snmpOutGetRequests, snmpOutGetNexts, + snmpOutSetRequests, snmpOutGetResponses, snmpOutTraps + } + STATUS obsolete + DESCRIPTION + "A collection of objects from RFC 1213 made obsolete + by this MIB module." + ::= { snmpMIBGroups 10 } + + +END Added: trunk/asn.1/test/6.asn ============================================================================== --- (empty file) +++ trunk/asn.1/test/6.asn Sun Sep 16 14:09:17 2007 @@ -0,0 +1,854 @@ +SNMPv2-MIB DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, NOTIFICATION-TYPE, + TimeTicks, Counter32, snmpModules, mib-2 + FROM SNMPv2-SMI + DisplayString, TestAndIncr, TimeStamp + + FROM SNMPv2-TC + MODULE-COMPLIANCE, OBJECT-GROUP, NOTIFICATION-GROUP + FROM SNMPv2-CONF; + +snmpMIB MODULE-IDENTITY + LAST-UPDATED "200210160000Z" + ORGANIZATION "IETF SNMPv3 Working Group" + CONTACT-INFO + "WG-EMail: snmpv3(a)lists.tislabs.com + Subscribe: snmpv3-request(a)lists.tislabs.com + + Co-Chair: Russ Mundy + Network Associates Laboratories + postal: 15204 Omega Drive, Suite 300 + Rockville, MD 20850-4601 + USA + EMail: mundy(a)tislabs.com + phone: +1 301 947-7107 + + Co-Chair: David Harrington + Enterasys Networks + postal: 35 Industrial Way + P. O. Box 5005 + Rochester, NH 03866-5005 + USA + EMail: dbh(a)enterasys.com + phone: +1 603 337-2614 + + Editor: Randy Presuhn + BMC Software, Inc. + postal: 2141 North First Street + San Jose, CA 95131 + USA + EMail: randy_presuhn(a)bmc.com + phone: +1 408 546-1006" + DESCRIPTION + "The MIB module for SNMP entities. + + Copyright (C) The Internet Society (2002). This + version of this MIB module is part of RFC 3418; + see the RFC itself for full legal notices. + " + REVISION "200210160000Z" + DESCRIPTION + "This revision of this MIB module was published as + RFC 3418." + REVISION "199511090000Z" + DESCRIPTION + "This revision of this MIB module was published as + RFC 1907." + REVISION "199304010000Z" + DESCRIPTION + "The initial revision of this MIB module was published + as RFC 1450." + ::= { snmpModules 1 } + +snmpMIBObjects OBJECT IDENTIFIER ::= { snmpMIB 1 } + +-- ::= { snmpMIBObjects 1 } this OID is obsolete +-- ::= { snmpMIBObjects 2 } this OID is obsolete +-- ::= { snmpMIBObjects 3 } this OID is obsolete + +-- the System group +-- +-- a collection of objects common to all managed systems. + +system OBJECT IDENTIFIER ::= { mib-2 1 } + +sysDescr OBJECT-TYPE + SYNTAX DisplayString (SIZE (0..255)) + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "A textual description of the entity. This value should + include the full name and version identification of + the system's hardware type, software operating-system, + and networking software." + ::= { system 1 } + +sysObjectID OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The vendor's authoritative identification of the + network management subsystem contained in the entity. + This value is allocated within the SMI enterprises + subtree (1.3.6.1.4.1) and provides an easy and + unambiguous means for determining `what kind of box' is + being managed. For example, if vendor `Flintstones, + Inc.' was assigned the subtree 1.3.6.1.4.1.424242, + it could assign the identifier 1.3.6.1.4.1.424242.1.1 + to its `Fred Router'." + ::= { system 2 } + +sysUpTime OBJECT-TYPE + SYNTAX TimeTicks + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The time (in hundredths of a second) since the + network management portion of the system was last + re-initialized." + ::= { system 3 } + +sysContact OBJECT-TYPE + SYNTAX DisplayString (SIZE (0..255)) + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "The textual identification of the contact person for + this managed node, together with information on how + to contact this person. If no contact information is + known, the value is the zero-length string." + ::= { system 4 } + +sysName OBJECT-TYPE + SYNTAX DisplayString (SIZE (0..255)) + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "An administratively-assigned name for this managed + node. By convention, this is the node's fully-qualified + domain name. If the name is unknown, the value is + the zero-length string." + ::= { system 5 } + +sysLocation OBJECT-TYPE + SYNTAX DisplayString (SIZE (0..255)) + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "The physical location of this node (e.g., 'telephone + closet, 3rd floor'). If the location is unknown, the + value is the zero-length string." + ::= { system 6 } + +sysServices OBJECT-TYPE + SYNTAX INTEGER (0..127) + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "A value which indicates the set of services that this + entity may potentially offer. The value is a sum. + + This sum initially takes the value zero. Then, for + each layer, L, in the range 1 through 7, that this node + performs transactions for, 2 raised to (L - 1) is added + to the sum. For example, a node which performs only + routing functions would have a value of 4 (2^(3-1)). + In contrast, a node which is a host offering application + services would have a value of 72 (2^(4-1) + 2^(7-1)). + Note that in the context of the Internet suite of + protocols, values should be calculated accordingly: + + layer functionality + 1 physical (e.g., repeaters) + 2 datalink/subnetwork (e.g., bridges) + 3 internet (e.g., supports the IP) + 4 end-to-end (e.g., supports the TCP) + 7 applications (e.g., supports the SMTP) + + For systems including OSI protocols, layers 5 and 6 + may also be counted." + ::= { system 7 } + +-- object resource information +-- +-- a collection of objects which describe the SNMP entity's +-- (statically and dynamically configurable) support of +-- various MIB modules. + +sysORLastChange OBJECT-TYPE + SYNTAX TimeStamp + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value of sysUpTime at the time of the most recent + change in state or value of any instance of sysORID." + ::= { system 8 } + +sysORTable OBJECT-TYPE + SYNTAX SEQUENCE OF SysOREntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "The (conceptual) table listing the capabilities of + the local SNMP application acting as a command + responder with respect to various MIB modules. + SNMP entities having dynamically-configurable support + of MIB modules will have a dynamically-varying number + of conceptual rows." + ::= { system 9 } + +sysOREntry OBJECT-TYPE + SYNTAX SysOREntry + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "An entry (conceptual row) in the sysORTable." + INDEX { sysORIndex } + ::= { sysORTable 1 } + +SysOREntry ::= SEQUENCE { + sysORIndex INTEGER, + sysORID OBJECT IDENTIFIER, + sysORDescr DisplayString, + sysORUpTime TimeStamp +} + +sysORIndex OBJECT-TYPE + SYNTAX INTEGER (1..2147483647) + MAX-ACCESS not-accessible + STATUS current + DESCRIPTION + "The auxiliary variable used for identifying instances + of the columnar objects in the sysORTable." + ::= { sysOREntry 1 } + +sysORID OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "An authoritative identification of a capabilities + statement with respect to various MIB modules supported + by the local SNMP application acting as a command + responder." + ::= { sysOREntry 2 } + +sysORDescr OBJECT-TYPE + SYNTAX DisplayString + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "A textual description of the capabilities identified + by the corresponding instance of sysORID." + ::= { sysOREntry 3 } + +sysORUpTime OBJECT-TYPE + SYNTAX TimeStamp + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The value of sysUpTime at the time this conceptual + row was last instantiated." + ::= { sysOREntry 4 } + +-- the SNMP group +-- +-- a collection of objects providing basic instrumentation and +-- control of an SNMP entity. + +snmp OBJECT IDENTIFIER ::= { mib-2 11 } + +snmpInPkts OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of messages delivered to the SNMP + entity from the transport service." + ::= { snmp 1 } + +snmpInBadVersions OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of SNMP messages which were delivered + to the SNMP entity and were for an unsupported SNMP + version." + ::= { snmp 3 } + +snmpInBadCommunityNames OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of community-based SNMP messages (for + example, SNMPv1) delivered to the SNMP entity which + used an SNMP community name not known to said entity. + Also, implementations which authenticate community-based + SNMP messages using check(s) in addition to matching + the community name (for example, by also checking + whether the message originated from a transport address + allowed to use a specified community name) MAY include + in this value the number of messages which failed the + additional check(s). It is strongly RECOMMENDED that + + the documentation for any security model which is used + to authenticate community-based SNMP messages specify + the precise conditions that contribute to this value." + ::= { snmp 4 } + +snmpInBadCommunityUses OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of community-based SNMP messages (for + example, SNMPv1) delivered to the SNMP entity which + represented an SNMP operation that was not allowed for + the SNMP community named in the message. The precise + conditions under which this counter is incremented + (if at all) depend on how the SNMP entity implements + its access control mechanism and how its applications + interact with that access control mechanism. It is + strongly RECOMMENDED that the documentation for any + access control mechanism which is used to control access + to and visibility of MIB instrumentation specify the + precise conditions that contribute to this value." + ::= { snmp 5 } + +snmpInASNParseErrs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of ASN.1 or BER errors encountered by + the SNMP entity when decoding received SNMP messages." + ::= { snmp 6 } + +snmpEnableAuthenTraps OBJECT-TYPE + SYNTAX INTEGER { enabled(1), disabled(2) } + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "Indicates whether the SNMP entity is permitted to + generate authenticationFailure traps. The value of this + object overrides any configuration information; as such, + it provides a means whereby all authenticationFailure + traps may be disabled. + + Note that it is strongly recommended that this object + be stored in non-volatile memory so that it remains + constant across re-initializations of the network + management system." + ::= { snmp 30 } + +snmpSilentDrops OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of Confirmed Class PDUs (such as + GetRequest-PDUs, GetNextRequest-PDUs, + GetBulkRequest-PDUs, SetRequest-PDUs, and + InformRequest-PDUs) delivered to the SNMP entity which + were silently dropped because the size of a reply + containing an alternate Response Class PDU (such as a + Response-PDU) with an empty variable-bindings field + was greater than either a local constraint or the + maximum message size associated with the originator of + the request." + ::= { snmp 31 } + +snmpProxyDrops OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS current + DESCRIPTION + "The total number of Confirmed Class PDUs + (such as GetRequest-PDUs, GetNextRequest-PDUs, + GetBulkRequest-PDUs, SetRequest-PDUs, and + InformRequest-PDUs) delivered to the SNMP entity which + were silently dropped because the transmission of + the (possibly translated) message to a proxy target + failed in a manner (other than a time-out) such that + no Response Class PDU (such as a Response-PDU) could + be returned." + ::= { snmp 32 } + +-- information for notifications +-- +-- a collection of objects which allow the SNMP entity, when +-- supporting a notification originator application, +-- to be configured to generate SNMPv2-Trap-PDUs. + +snmpTrap OBJECT IDENTIFIER ::= { snmpMIBObjects 4 } + +snmpTrapOID OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS accessible-for-notify + STATUS current + DESCRIPTION + "The authoritative identification of the notification + currently being sent. This variable occurs as + the second varbind in every SNMPv2-Trap-PDU and + InformRequest-PDU." + ::= { snmpTrap 1 } + +-- ::= { snmpTrap 2 } this OID is obsolete + +snmpTrapEnterprise OBJECT-TYPE + SYNTAX OBJECT IDENTIFIER + MAX-ACCESS accessible-for-notify + STATUS current + DESCRIPTION + "The authoritative identification of the enterprise + associated with the trap currently being sent. When an + SNMP proxy agent is mapping an RFC1157 Trap-PDU + into a SNMPv2-Trap-PDU, this variable occurs as the + last varbind." + ::= { snmpTrap 3 } + +-- ::= { snmpTrap 4 } this OID is obsolete + +-- well-known traps + +snmpTraps OBJECT IDENTIFIER ::= { snmpMIBObjects 5 } + +coldStart NOTIFICATION-TYPE + STATUS current + DESCRIPTION + "A coldStart trap signifies that the SNMP entity, + supporting a notification originator application, is + reinitializing itself and that its configuration may + have been altered." + ::= { snmpTraps 1 } + +warmStart NOTIFICATION-TYPE + STATUS current + DESCRIPTION + "A warmStart trap signifies that the SNMP entity, + supporting a notification originator application, + is reinitializing itself such that its configuration + is unaltered." + ::= { snmpTraps 2 } + +-- Note the linkDown NOTIFICATION-TYPE ::= { snmpTraps 3 } +-- and the linkUp NOTIFICATION-TYPE ::= { snmpTraps 4 } +-- are defined in RFC 2863 [RFC2863] + +authenticationFailure NOTIFICATION-TYPE + STATUS current + DESCRIPTION + "An authenticationFailure trap signifies that the SNMP + entity has received a protocol message that is not + properly authenticated. While all implementations + of SNMP entities MAY be capable of generating this + trap, the snmpEnableAuthenTraps object indicates + whether this trap will be generated." + ::= { snmpTraps 5 } + +-- Note the egpNeighborLoss notification is defined +-- as { snmpTraps 6 } in RFC 1213 + +-- the set group +-- +-- a collection of objects which allow several cooperating +-- command generator applications to coordinate their use of the +-- set operation. + +snmpSet OBJECT IDENTIFIER ::= { snmpMIBObjects 6 } + +snmpSetSerialNo OBJECT-TYPE + SYNTAX TestAndIncr + MAX-ACCESS read-write + STATUS current + DESCRIPTION + "An advisory lock used to allow several cooperating + command generator applications to coordinate their + use of the SNMP set operation. + + This object is used for coarse-grain coordination. + To achieve fine-grain coordination, one or more similar + objects might be defined within each MIB group, as + appropriate." + ::= { snmpSet 1 } + +-- conformance information + +snmpMIBConformance + OBJECT IDENTIFIER ::= { snmpMIB 2 } + +snmpMIBCompliances + OBJECT IDENTIFIER ::= { snmpMIBConformance 1 } +snmpMIBGroups OBJECT IDENTIFIER ::= { snmpMIBConformance 2 } + +-- compliance statements + +-- ::= { snmpMIBCompliances 1 } this OID is obsolete +snmpBasicCompliance MODULE-COMPLIANCE + STATUS deprecated + DESCRIPTION + "The compliance statement for SNMPv2 entities which + implement the SNMPv2 MIB. + + This compliance statement is replaced by + snmpBasicComplianceRev2." + MODULE -- this module + MANDATORY-GROUPS { snmpGroup, snmpSetGroup, systemGroup, + snmpBasicNotificationsGroup } + + GROUP snmpCommunityGroup + DESCRIPTION + "This group is mandatory for SNMPv2 entities which + support community-based authentication." + ::= { snmpMIBCompliances 2 } + +snmpBasicComplianceRev2 MODULE-COMPLIANCE + STATUS current + DESCRIPTION + "The compliance statement for SNMP entities which + implement this MIB module." + MODULE -- this module + MANDATORY-GROUPS { snmpGroup, snmpSetGroup, systemGroup, + snmpBasicNotificationsGroup } + + GROUP snmpCommunityGroup + DESCRIPTION + "This group is mandatory for SNMP entities which + support community-based authentication." + + GROUP snmpWarmStartNotificationGroup + DESCRIPTION + "This group is mandatory for an SNMP entity which + supports command responder applications, and is + able to reinitialize itself such that its + configuration is unaltered." + ::= { snmpMIBCompliances 3 } + +-- units of conformance + +-- ::= { snmpMIBGroups 1 } this OID is obsolete +-- ::= { snmpMIBGroups 2 } this OID is obsolete +-- ::= { snmpMIBGroups 3 } this OID is obsolete + +-- ::= { snmpMIBGroups 4 } this OID is obsolete + +snmpGroup OBJECT-GROUP + OBJECTS { snmpInPkts, + snmpInBadVersions, + snmpInASNParseErrs, + snmpSilentDrops, + snmpProxyDrops, + snmpEnableAuthenTraps } + STATUS current + DESCRIPTION + "A collection of objects providing basic instrumentation + and control of an SNMP entity." + ::= { snmpMIBGroups 8 } + +snmpCommunityGroup OBJECT-GROUP + OBJECTS { snmpInBadCommunityNames, + snmpInBadCommunityUses } + STATUS current + DESCRIPTION + "A collection of objects providing basic instrumentation + of a SNMP entity which supports community-based + authentication." + ::= { snmpMIBGroups 9 } + +snmpSetGroup OBJECT-GROUP + OBJECTS { snmpSetSerialNo } + STATUS current + DESCRIPTION + "A collection of objects which allow several cooperating + command generator applications to coordinate their + use of the set operation." + ::= { snmpMIBGroups 5 } + +systemGroup OBJECT-GROUP + OBJECTS { sysDescr, sysObjectID, sysUpTime, + sysContact, sysName, sysLocation, + sysServices, + sysORLastChange, sysORID, + sysORUpTime, sysORDescr } + STATUS current + DESCRIPTION + "The system group defines objects which are common to all + managed systems." + ::= { snmpMIBGroups 6 } + +snmpBasicNotificationsGroup NOTIFICATION-GROUP + NOTIFICATIONS { coldStart, authenticationFailure } + STATUS current + DESCRIPTION + "The basic notifications implemented by an SNMP entity + supporting command responder applications." + ::= { snmpMIBGroups 7 } + +snmpWarmStartNotificationGroup NOTIFICATION-GROUP + NOTIFICATIONS { warmStart } + STATUS current + DESCRIPTION + "An additional notification for an SNMP entity supporting + command responder applications, if it is able to reinitialize + itself such that its configuration is unaltered." + ::= { snmpMIBGroups 11 } + +snmpNotificationGroup OBJECT-GROUP + OBJECTS { snmpTrapOID, snmpTrapEnterprise } + STATUS current + DESCRIPTION + "These objects are required for entities + which support notification originator applications." + ::= { snmpMIBGroups 12 } + +-- definitions in RFC 1213 made obsolete by the inclusion of a +-- subset of the snmp group in this MIB + +snmpOutPkts OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Messages which were + passed from the SNMP protocol entity to the + transport service." + ::= { snmp 2 } + +-- { snmp 7 } is not used + +snmpInTooBigs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were + delivered to the SNMP protocol entity and for + which the value of the error-status field was + `tooBig'." + ::= { snmp 8 } + +snmpInNoSuchNames OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were + delivered to the SNMP protocol entity and for + which the value of the error-status field was + `noSuchName'." + ::= { snmp 9 } + +snmpInBadValues OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were + delivered to the SNMP protocol entity and for + which the value of the error-status field was + `badValue'." + ::= { snmp 10 } + +snmpInReadOnlys OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number valid SNMP PDUs which were delivered + to the SNMP protocol entity and for which the value + of the error-status field was `readOnly'. It should + be noted that it is a protocol error to generate an + SNMP PDU which contains the value `readOnly' in the + error-status field, as such this object is provided + as a means of detecting incorrect implementations of + the SNMP." + ::= { snmp 11 } + +snmpInGenErrs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were delivered + to the SNMP protocol entity and for which the value + of the error-status field was `genErr'." + ::= { snmp 12 } + +snmpInTotalReqVars OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of MIB objects which have been + retrieved successfully by the SNMP protocol entity + as the result of receiving valid SNMP Get-Request + and Get-Next PDUs." + ::= { snmp 13 } + +snmpInTotalSetVars OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of MIB objects which have been + altered successfully by the SNMP protocol entity as + the result of receiving valid SNMP Set-Request PDUs." + ::= { snmp 14 } + +snmpInGetRequests OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Request PDUs which + have been accepted and processed by the SNMP + protocol entity." + ::= { snmp 15 } + +snmpInGetNexts OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Next PDUs which have been + accepted and processed by the SNMP protocol entity." + ::= { snmp 16 } + +snmpInSetRequests OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Set-Request PDUs which + have been accepted and processed by the SNMP protocol + entity." + ::= { snmp 17 } + +snmpInGetResponses OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Response PDUs which + have been accepted and processed by the SNMP protocol + entity." + ::= { snmp 18 } + +snmpInTraps OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Trap PDUs which have been + accepted and processed by the SNMP protocol entity." + ::= { snmp 19 } + +snmpOutTooBigs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were generated + by the SNMP protocol entity and for which the value + of the error-status field was `tooBig.'" + ::= { snmp 20 } + +snmpOutNoSuchNames OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were generated + by the SNMP protocol entity and for which the value + of the error-status was `noSuchName'." + ::= { snmp 21 } + +snmpOutBadValues OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were generated + by the SNMP protocol entity and for which the value + of the error-status field was `badValue'." + ::= { snmp 22 } + +-- { snmp 23 } is not used + +snmpOutGenErrs OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP PDUs which were generated + by the SNMP protocol entity and for which the value + of the error-status field was `genErr'." + ::= { snmp 24 } + +snmpOutGetRequests OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Request PDUs which + have been generated by the SNMP protocol entity." + ::= { snmp 25 } + +snmpOutGetNexts OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Next PDUs which have + been generated by the SNMP protocol entity." + ::= { snmp 26 } + +snmpOutSetRequests OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Set-Request PDUs which + have been generated by the SNMP protocol entity." + ::= { snmp 27 } + +snmpOutGetResponses OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Get-Response PDUs which + have been generated by the SNMP protocol entity." + ::= { snmp 28 } + +snmpOutTraps OBJECT-TYPE + SYNTAX Counter32 + MAX-ACCESS read-only + STATUS obsolete + DESCRIPTION + "The total number of SNMP Trap PDUs which have + been generated by the SNMP protocol entity." + ::= { snmp 29 } + +snmpObsoleteGroup OBJECT-GROUP + OBJECTS { snmpOutPkts, snmpInTooBigs, snmpInNoSuchNames, + snmpInBadValues, snmpInReadOnlys, snmpInGenErrs, + snmpInTotalReqVars, snmpInTotalSetVars, + snmpInGetRequests, snmpInGetNexts, snmpInSetRequests, + snmpInGetResponses, snmpInTraps, snmpOutTooBigs, + snmpOutNoSuchNames, snmpOutBadValues, + snmpOutGenErrs, snmpOutGetRequests, snmpOutGetNexts, + snmpOutSetRequests, snmpOutGetResponses, snmpOutTraps + } + STATUS obsolete + DESCRIPTION + "A collection of objects from RFC 1213 made obsolete + by this MIB module." + ::= { snmpMIBGroups 10 } + +END

1 0

[cl-net-snmp-cvs] r40 - trunk
by ctian＠common-lisp.net 16 Sep '07

16 Sep '07

Author: ctian Date: Sun Sep 16 09:38:09 2007 New Revision: 40 Added: trunk/prettyhell.lisp Modified: trunk/net-snmp.asd Log: Add zebu and prettyhell Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Sun Sep 16 09:38:09 2007 @@ -12,7 +12,8 @@ :depends-on (:cffi :ironclad :net-telent-date - :zebu) + :iolib + :zebu) :components ((:module asn.1 :components ((:file "package") (:file "ber" :depends-on ("package")) (:file "oid" :depends-on ("ber")) @@ -35,7 +36,8 @@ :hunchentoot :clsql-postgresql) :components ((:file "sabrina") - (:file "zilong" :depends-on ("sabrina")))) + (:file "zilong" :depends-on ("sabrina")) + (:file "prettyhell" :depends-on ("sabrina")))) ;; (fli:start-collecting-template-info) ;;(defun make-fli-templates () Added: trunk/prettyhell.lisp ============================================================================== --- (empty file) +++ trunk/prettyhell.lisp Sun Sep 16 09:38:09 2007 @@ -0,0 +1,2 @@ +(in-package :org.net-snmp.sabrina) +

1 0

[cl-net-snmp-cvs] r39 - in trunk/asn.1: . test
by ctian＠common-lisp.net 16 Sep '07

16 Sep '07

Author: ctian Date: Sun Sep 16 09:36:33 2007 New Revision: 39 Added: trunk/asn.1/test/3.asn trunk/asn.1/test/4.asn Removed: trunk/asn.1/asn.1-domain.lisp trunk/asn.1/asn.1.tab Modified: trunk/asn.1/asn.1.zb trunk/asn.1/mib-parse.lisp trunk/asn.1/mib.lisp trunk/asn.1/test/1.asn Log: commit changes Modified: trunk/asn.1/asn.1.zb ============================================================================== --- trunk/asn.1/asn.1.zb (original) +++ trunk/asn.1/asn.1.zb Sun Sep 16 09:36:33 2007 @@ -10,7 +10,7 @@ "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" :lex-cats (;;(BSTRING "'[01]+'B") ;;(HSTRING "'([A-F0-9]+)'H") - (A-Number "[0-9]+") + (A-Number "-?[0-9]+") (Value-Reference "[a-z][a-zA-Z0-9-]+") (Type-Reference "[A-Z][a-zA-Z0-9-]*") (Module-Reference "[A-Z][a-zA-Z0-9-]*") @@ -23,7 +23,7 @@ Assignment-List := kb-domain: [(-list kb-sequence)]; Assignment := kb-domain: [(-type) (-value)]; Obj-Id-Components-List := kb-domain: [(-list kb-sequence)]; -Value-Assignment := kb-domain: []; +Value-Assignment := kb-domain: [(-value-reference) (-type) (-value)]; ;; Rule Definitions Module-Definition --> @@ -43,18 +43,27 @@ Symbol --> Reference; -Imports --> Type-Reference | ; +Imports --> "IMPORTS" Type-Reference | ; Reference --> Type-Reference | Value-Reference; Assignment-List --> Assignment+ " " { Assignment-List:[(-list Assignment+)] }; -Assignment --> Special-Assignment { Assignment:[(-type :special) (-value Special-Assignment)] } - | Type-Assignment { Assignment:[(-type :type) (-value Type-Assignment)] } - | Value-Assignment { Assignment:[(-type :value) (-value Value-Assignment)] }; - -Type-Assignment --> Type-Reference "::=" Type; -Value-Assignment --> Value-Reference Type "::=" Value; +Assignment --> Type-Assignment {Assignment:[(-type :type) (-value Type-Assignment)]} + | Value-Assignment {Assignment:[(-type :value) (-value Value-Assignment)]} + |; + + ;;Macro-Assignment {Assignment:[(-type :macro) (-value Macro-Definition)]} + ;;| Special-Assignment {Assignment:[(-type :special) (-value Special-Assignment)]} + ;;| + +Type-Assignment --> Type-Reference "::=" Type + | Type-Reference "MACRO" "::=" "BEGIN" Garbage+ " " "END"; + +Value-Assignment --> Value-Reference Type "::=" Value + { Value-Assignment:[(-value-reference Value-Reference) + (-type Type) + (-value Value)] }; Type --> Builtin-Type; @@ -81,15 +90,31 @@ Name-Form --> Identifier; Number-Form --> A-Number; -Special-Assignment --> "OBJECT-TYPE" "MACRO" "::=" "BEGIN" Garbage+ " " "END"; +Special-Assignment --> Macro-Name "MACRO" "::=" "BEGIN" Garbage+ " " "END"; + +Macro-Assignment --> "MACRO-DEFINITION" "::=" "{" "}"; + +;;"zeroDotZero" "OBJECT-IDENTITY" +;; "STATUS" "current" +;; "DESCRIPTION" "\"" Garbage+ "\"" +;; "::=" "{" Garbage+ "}" ; + +Macro-Name --> "OBJECT-TYPE" + | "MODULE-IDENTITY" + | "OBJECT-IDENTITY" + | "NOTIFICATION-TYPE"; + Garbage --> Any-Thing; Choice-Type --> "CHOICE" "{" Garbage+ " " "}"; Octet-String-Type --> "OCTET" "STRING" String-Options; -String-Options --> "(" "SIZE" "(" A-Number ")" ")" |; +String-Options --> "(" "SIZE" "(" Numbers ")" ")" |; +Numbers --> A-Number "|" A-Number + | A-Number; Integer-Type --> "INTEGER" "(" A-Number ".." A-Number ")"; Tagged-Type --> Tag Type | Tag "IMPLICIT" Type | Tag "EXPLICIT" Type; Tag --> "[" Class Class-Number "]"; Class-Number --> A-Number; Class --> "UNIVERSAL" | "APPLICATION" | "PRIVATE" |; + Modified: trunk/asn.1/mib-parse.lisp ============================================================================== --- trunk/asn.1/mib-parse.lisp (original) +++ trunk/asn.1/mib-parse.lisp Sun Sep 16 09:36:33 2007 @@ -8,9 +8,10 @@ (labels ((iter (kb-seq acc) (if (null (kb-sequence-rest kb-seq)) (nreverse (cons (kb-sequence-first kb-seq) acc)) - (iter (kb-sequence-rest kb-seq) - (cons (kb-sequence-first kb-seq) acc))))) - (delete-if-not #'(lambda (x) (eq (car x) :value)) - (mapcar #'(lambda (x) (cons (assignment--type x) - (assignment--value x))) - (iter assignment-list nil))))))) + (iter (kb-sequence-rest kb-seq) + (cons (kb-sequence-first kb-seq) acc))))) + (mapcar #'cdr + (delete-if-not #'(lambda (x) (eq (car x) :value)) + (mapcar #'(lambda (x) (cons (assignment--type x) + (assignment--value x))) + (iter assignment-list nil)))))))) Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Sun Sep 16 09:36:33 2007 @@ -52,7 +52,8 @@ base)) (defparameter *mibs-list* - '("RFC1155-SMI")) + '("RFC1155-SMI" + "SNMPv2-SMI")) (defvar *asn.1-def* (merge-pathnames (make-pathname :name "asn.1" :type "zb" @@ -67,5 +68,5 @@ (defun parse-mib (file) (let ((zb:*comment-start* "--") (zb:*comment-brackets* '(("/*" . "*/")))) - (zb:file-parser file :grammar (zb:find-grammar "ASN.1") :verbose nil))) + (zb:file-parser file :grammar (zb:find-grammar "ASN.1") :verbose t))) Modified: trunk/asn.1/test/1.asn ============================================================================== --- trunk/asn.1/test/1.asn (original) +++ trunk/asn.1/test/1.asn Sun Sep 16 09:36:33 2007 @@ -27,75 +27,4 @@ ObjectName ::= OBJECT IDENTIFIER - OBJECT-TYPE MACRO ::= - BEGIN - TYPE NOTATION ::= "SYNTAX" type (TYPE ObjectSyntax) - "ACCESS" Access - "STATUS" Status - VALUE NOTATION ::= value (VALUE ObjectName) - - Access ::= "read-only" - | "read-write" - | "write-only" - | "not-accessible" - Status ::= "mandatory" - | "optional" - | "obsolete" - END - - ObjectSyntax ::= - CHOICE { - simple - SimpleSyntax, - -- note that simple SEQUENCEs are not directly - -- mentioned here to keep things simple (i.e., - -- prevent mis-use). However, application-wide - -- types which are IMPLICITly encoded simple - -- SEQUENCEs may appear in the following CHOICE - - application-wide - ApplicationSyntax - } - - SimpleSyntax ::= - CHOICE { - number - INTEGER, - string - OCTET STRING, - object - OBJECT IDENTIFIER, - empty - NULL - } - - ApplicationSyntax ::= - CHOICE { - address - NetworkAddress, - counter - Counter, - gauge - Gauge, - ticks - TimeTicks, - arbitrary - Opaque - - -- other application-wide types, as they are - -- defined, will be added here - } - - -- application-wide types - - NetworkAddress ::= - CHOICE { - internet - IpAddress - } - - IpAddress ::= - [APPLICATION 0] -- in network-byte order - IMPLICIT OCTET STRING (SIZE (4)) - END Added: trunk/asn.1/test/3.asn ============================================================================== --- (empty file) +++ trunk/asn.1/test/3.asn Sun Sep 16 09:36:33 2007 @@ -0,0 +1,342 @@ +SNMPv2-SMI DEFINITIONS ::= BEGIN + +-- the path to the root + +org OBJECT IDENTIFIER ::= { iso 3 } -- "iso" = 1 +dod OBJECT IDENTIFIER ::= { org 6 } +internet OBJECT IDENTIFIER ::= { dod 1 } + +directory OBJECT IDENTIFIER ::= { internet 1 } + +mgmt OBJECT IDENTIFIER ::= { internet 2 } +mib-2 OBJECT IDENTIFIER ::= { mgmt 1 } +transmission OBJECT IDENTIFIER ::= { mib-2 10 } + +experimental OBJECT IDENTIFIER ::= { internet 3 } + +private OBJECT IDENTIFIER ::= { internet 4 } +enterprises OBJECT IDENTIFIER ::= { private 1 } + +security OBJECT IDENTIFIER ::= { internet 5 } + +snmpV2 OBJECT IDENTIFIER ::= { internet 6 } + +-- transport domains +snmpDomains OBJECT IDENTIFIER ::= { snmpV2 1 } + +-- transport proxies +snmpProxys OBJECT IDENTIFIER ::= { snmpV2 2 } + +-- module identities +snmpModules OBJECT IDENTIFIER ::= { snmpV2 3 } + +-- Extended UTCTime, to allow dates with four-digit years +-- (Note that this definition of ExtUTCTime is not to be IMPORTed +-- by MIB modules.) +ExtUTCTime ::= OCTET STRING(SIZE(11 | 13)) + -- format is YYMMDDHHMMZ or YYYYMMDDHHMMZ + + -- where: YY - last two digits of year (only years + -- between 1900-1999) + -- YYYY - last four digits of the year (any year) + -- MM - month (01 through 12) + -- DD - day of month (01 through 31) + -- HH - hours (00 through 23) + -- MM - minutes (00 through 59) + -- Z - denotes GMT (the ASCII character Z) + -- + -- For example, "9502192015Z" and "199502192015Z" represent + -- 8:15pm GMT on 19 February 1995. Years after 1999 must use + -- the four digit year format. Years 1900-1999 may use the + -- two or four digit format. + +-- definitions for information modules +MODULE-IDENTITY MACRO ::= +BEGIN + TYPE NOTATION ::= + "LAST-UPDATED" value(Update ExtUTCTime) + "ORGANIZATION" Text + "CONTACT-INFO" Text + "DESCRIPTION" Text + RevisionPart + + VALUE NOTATION ::= + value(VALUE OBJECT IDENTIFIER) + + RevisionPart ::= + Revisions + | empty + Revisions ::= + Revision + | Revisions Revision + Revision ::= + "REVISION" value(Update ExtUTCTime) + "DESCRIPTION" Text + + -- a character string as defined in section 3.1.1 + Text ::= value(IA5String) +END + +OBJECT-IDENTITY MACRO ::= +BEGIN + TYPE NOTATION ::= + "STATUS" Status + "DESCRIPTION" Text + + ReferPart + + VALUE NOTATION ::= + value(VALUE OBJECT IDENTIFIER) + + Status ::= + "current" + | "deprecated" + | "obsolete" + + ReferPart ::= + "REFERENCE" Text + | empty + + -- a character string as defined in section 3.1.1 + Text ::= value(IA5String) +END + +-- names of objects +-- (Note that these definitions of ObjectName and NotificationName +-- are not to be IMPORTed by MIB modules.) +ObjectName ::= + OBJECT IDENTIFIER + +NotificationName ::= + OBJECT IDENTIFIER + +-- syntax of objects + +-- the "base types" defined here are: +-- 3 built-in ASN.1 types: INTEGER, OCTET STRING, OBJECT IDENTIFIER +-- 8 application-defined types: Integer32, IpAddress, Counter32, +-- Gauge32, Unsigned32, TimeTicks, Opaque, and Counter64 + +ObjectSyntax ::= + CHOICE { + simple + SimpleSyntax, + -- note that SEQUENCEs for conceptual tables and + -- rows are not mentioned here... + + application-wide + ApplicationSyntax + } + +-- built-in ASN.1 types + +SimpleSyntax ::= + CHOICE { + -- INTEGERs with a more restrictive range + -- may also be used + integer-value -- includes Integer32 + INTEGER (-2147483648..2147483647), + -- OCTET STRINGs with a more restrictive size + -- may also be used + string-value + OCTET STRING (SIZE (0..65535)), + objectID-value + OBJECT IDENTIFIER + } + +-- indistinguishable from INTEGER, but never needs more than +-- 32-bits for a two's complement representation +Integer32 ::= + INTEGER (-2147483648..2147483647) + +-- application-wide types + +ApplicationSyntax ::= + CHOICE { + ipAddress-value + IpAddress, + counter-value + Counter32, + timeticks-value + TimeTicks, + arbitrary-value + Opaque, + big-counter-value + Counter64, + unsigned-integer-value -- includes Gauge32 + Unsigned32 + } + +-- in network-byte order + +-- (this is a tagged type for historical reasons) +-- (this is a tagged type for historical reasons) +IpAddress ::= + [APPLICATION 0] + IMPLICIT OCTET STRING (SIZE (4)) + +-- this wraps +Counter32 ::= + [APPLICATION 1] + IMPLICIT INTEGER (0..4294967295) + +-- this doesn't wrap +Gauge32 ::= + [APPLICATION 2] + IMPLICIT INTEGER (0..4294967295) + +-- an unsigned 32-bit quantity +-- indistinguishable from Gauge32 +Unsigned32 ::= + [APPLICATION 2] + IMPLICIT INTEGER (0..4294967295) + +-- hundredths of seconds since an epoch +TimeTicks ::= + [APPLICATION 3] + IMPLICIT INTEGER (0..4294967295) + +-- for backward-compatibility only +Opaque ::= + [APPLICATION 4] + IMPLICIT OCTET STRING + +-- for counters that wrap in less than one hour with only 32 bits +Counter64 ::= + [APPLICATION 6] + IMPLICIT INTEGER (0..18446744073709551615) + +-- definition for objects +OBJECT-TYPE MACRO ::= +BEGIN + TYPE NOTATION ::= + "SYNTAX" Syntax + UnitsPart + "MAX-ACCESS" Access + "STATUS" Status + "DESCRIPTION" Text + ReferPart + + IndexPart + DefValPart + + VALUE NOTATION ::= + value(VALUE ObjectName) + + Syntax ::= -- Must be one of the following: + -- a base type (or its refinement), + -- a textual convention (or its refinement), or + -- a BITS pseudo-type + type + | "BITS" "{" NamedBits "}" + + NamedBits ::= NamedBit + | NamedBits "," NamedBit + + NamedBit ::= identifier "(" number ")" -- number is nonnegative + + UnitsPart ::= + "UNITS" Text + | empty + + Access ::= + "not-accessible" + | "accessible-for-notify" + | "read-only" + | "read-write" + | "read-create" + + Status ::= + "current" + | "deprecated" + | "obsolete" + + ReferPart ::= + "REFERENCE" Text + | empty + + IndexPart ::= + "INDEX" "{" IndexTypes "}" + | "AUGMENTS" "{" Entry "}" + | empty + IndexTypes ::= + IndexType + | IndexTypes "," IndexType + IndexType ::= + "IMPLIED" Index + | Index + + Index ::= + -- use the SYNTAX value of the + -- correspondent OBJECT-TYPE invocation + value(ObjectName) + Entry ::= + -- use the INDEX value of the + -- correspondent OBJECT-TYPE invocation + value(ObjectName) + + DefValPart ::= "DEFVAL" "{" Defvalue "}" + | empty + + Defvalue ::= -- must be valid for the type specified in + -- SYNTAX clause of same OBJECT-TYPE macro + value(ObjectSyntax) + | "{" BitsValue "}" + + BitsValue ::= BitNames + | empty + + BitNames ::= BitName + | BitNames "," BitName + + BitName ::= identifier + + -- a character string as defined in section 3.1.1 + Text ::= value(IA5String) +END + +-- definitions for notifications + +NOTIFICATION-TYPE MACRO ::= +BEGIN + TYPE NOTATION ::= + ObjectsPart + "STATUS" Status + "DESCRIPTION" Text + ReferPart + + VALUE NOTATION ::= + value(VALUE NotificationName) + + ObjectsPart ::= + "OBJECTS" "{" Objects "}" + | empty + Objects ::= + Object + + | Objects "," Object + Object ::= + value(ObjectName) + + Status ::= + "current" + | "deprecated" + | "obsolete" + + ReferPart ::= + "REFERENCE" Text + | empty + + -- a character string as defined in section 3.1.1 + Text ::= value(IA5String) +END + +-- definitions of administrative identifiers + +MACRO-DEFINITION ::= { } +--zeroDotZero OBJECT-IDENTITY +-- STATUS current +-- DESCRIPTION +-- "A value used for null identifiers." + +END Added: trunk/asn.1/test/4.asn ============================================================================== --- (empty file) +++ trunk/asn.1/test/4.asn Sun Sep 16 09:36:33 2007 @@ -0,0 +1,344 @@ +SNMPv2-SMI DEFINITIONS ::= BEGIN + +-- the path to the root + +org OBJECT IDENTIFIER ::= { iso 3 } -- "iso" = 1 +dod OBJECT IDENTIFIER ::= { org 6 } +internet OBJECT IDENTIFIER ::= { dod 1 } + +directory OBJECT IDENTIFIER ::= { internet 1 } + +mgmt OBJECT IDENTIFIER ::= { internet 2 } +mib-2 OBJECT IDENTIFIER ::= { mgmt 1 } +transmission OBJECT IDENTIFIER ::= { mib-2 10 } + +experimental OBJECT IDENTIFIER ::= { internet 3 } + +private OBJECT IDENTIFIER ::= { internet 4 } +enterprises OBJECT IDENTIFIER ::= { private 1 } + +security OBJECT IDENTIFIER ::= { internet 5 } + +snmpV2 OBJECT IDENTIFIER ::= { internet 6 } + +-- transport domains +snmpDomains OBJECT IDENTIFIER ::= { snmpV2 1 } + +-- transport proxies +snmpProxys OBJECT IDENTIFIER ::= { snmpV2 2 } + +-- module identities +snmpModules OBJECT IDENTIFIER ::= { snmpV2 3 } + +-- Extended UTCTime, to allow dates with four-digit years +-- (Note that this definition of ExtUTCTime is not to be IMPORTed +-- by MIB modules.) +ExtUTCTime ::= OCTET STRING(SIZE(11 | 13)) + -- format is YYMMDDHHMMZ or YYYYMMDDHHMMZ + + -- where: YY - last two digits of year (only years + -- between 1900-1999) + -- YYYY - last four digits of the year (any year) + -- MM - month (01 through 12) + -- DD - day of month (01 through 31) + -- HH - hours (00 through 23) + -- MM - minutes (00 through 59) + -- Z - denotes GMT (the ASCII character Z) + -- + -- For example, "9502192015Z" and "199502192015Z" represent + -- 8:15pm GMT on 19 February 1995. Years after 1999 must use + -- the four digit year format. Years 1900-1999 may use the + -- two or four digit format. + +-- definitions for information modules + +MODULE-IDENTITY MACRO ::= +BEGIN + TYPE NOTATION ::= + "LAST-UPDATED" value(Update ExtUTCTime) + "ORGANIZATION" Text + "CONTACT-INFO" Text + "DESCRIPTION" Text + RevisionPart + + VALUE NOTATION ::= + value(VALUE OBJECT IDENTIFIER) + + RevisionPart ::= + Revisions + | empty + Revisions ::= + Revision + | Revisions Revision + Revision ::= + "REVISION" value(Update ExtUTCTime) + "DESCRIPTION" Text + + -- a character string as defined in section 3.1.1 + Text ::= value(IA5String) +END + +OBJECT-IDENTITY MACRO ::= +BEGIN + TYPE NOTATION ::= + "STATUS" Status + "DESCRIPTION" Text + + ReferPart + + VALUE NOTATION ::= + value(VALUE OBJECT IDENTIFIER) + + Status ::= + "current" + | "deprecated" + | "obsolete" + + ReferPart ::= + "REFERENCE" Text + | empty + + -- a character string as defined in section 3.1.1 + Text ::= value(IA5String) +END + +-- names of objects +-- (Note that these definitions of ObjectName and NotificationName +-- are not to be IMPORTed by MIB modules.) + +ObjectName ::= + OBJECT IDENTIFIER + +NotificationName ::= + OBJECT IDENTIFIER + +-- syntax of objects + +-- the "base types" defined here are: +-- 3 built-in ASN.1 types: INTEGER, OCTET STRING, OBJECT IDENTIFIER +-- 8 application-defined types: Integer32, IpAddress, Counter32, +-- Gauge32, Unsigned32, TimeTicks, Opaque, and Counter64 + +ObjectSyntax ::= + CHOICE { + simple + SimpleSyntax, + -- note that SEQUENCEs for conceptual tables and + -- rows are not mentioned here... + + application-wide + ApplicationSyntax + } + +-- built-in ASN.1 types + +SimpleSyntax ::= + CHOICE { + -- INTEGERs with a more restrictive range + -- may also be used + integer-value -- includes Integer32 + INTEGER (-2147483648..2147483647), + -- OCTET STRINGs with a more restrictive size + -- may also be used + string-value + OCTET STRING (SIZE (0..65535)), + objectID-value + OBJECT IDENTIFIER + } + +-- indistinguishable from INTEGER, but never needs more than +-- 32-bits for a two's complement representation +Integer32 ::= + INTEGER (-2147483648..2147483647) + +-- application-wide types + +ApplicationSyntax ::= + CHOICE { + ipAddress-value + IpAddress, + counter-value + Counter32, + timeticks-value + TimeTicks, + arbitrary-value + Opaque, + big-counter-value + Counter64, + unsigned-integer-value -- includes Gauge32 + Unsigned32 + } + +-- in network-byte order + +-- (this is a tagged type for historical reasons) +IpAddress ::= + [APPLICATION 0] + IMPLICIT OCTET STRING (SIZE (4)) + +-- this wraps +Counter32 ::= + [APPLICATION 1] + IMPLICIT INTEGER (0..4294967295) + +-- this doesn't wrap +Gauge32 ::= + [APPLICATION 2] + IMPLICIT INTEGER (0..4294967295) + +-- an unsigned 32-bit quantity +-- indistinguishable from Gauge32 +Unsigned32 ::= + [APPLICATION 2] + IMPLICIT INTEGER (0..4294967295) + +-- hundredths of seconds since an epoch +TimeTicks ::= + [APPLICATION 3] + IMPLICIT INTEGER (0..4294967295) + +-- for backward-compatibility only +Opaque ::= + [APPLICATION 4] + IMPLICIT OCTET STRING + +-- for counters that wrap in less than one hour with only 32 bits +Counter64 ::= + [APPLICATION 6] + IMPLICIT INTEGER (0..18446744073709551615) + +-- definition for objects + +OBJECT-TYPE MACRO ::= +BEGIN + TYPE NOTATION ::= + "SYNTAX" Syntax + UnitsPart + "MAX-ACCESS" Access + "STATUS" Status + "DESCRIPTION" Text + ReferPart + + IndexPart + DefValPart + + VALUE NOTATION ::= + value(VALUE ObjectName) + + Syntax ::= -- Must be one of the following: + -- a base type (or its refinement), + -- a textual convention (or its refinement), or + -- a BITS pseudo-type + type + | "BITS" "{" NamedBits "}" + + NamedBits ::= NamedBit + | NamedBits "," NamedBit + + NamedBit ::= identifier "(" number ")" -- number is nonnegative + + UnitsPart ::= + "UNITS" Text + | empty + + Access ::= + "not-accessible" + | "accessible-for-notify" + | "read-only" + | "read-write" + | "read-create" + + Status ::= + "current" + | "deprecated" + | "obsolete" + + ReferPart ::= + "REFERENCE" Text + | empty + + IndexPart ::= + "INDEX" "{" IndexTypes "}" + | "AUGMENTS" "{" Entry "}" + | empty + IndexTypes ::= + IndexType + | IndexTypes "," IndexType + IndexType ::= + "IMPLIED" Index + | Index + + Index ::= + -- use the SYNTAX value of the + -- correspondent OBJECT-TYPE invocation + value(ObjectName) + Entry ::= + -- use the INDEX value of the + -- correspondent OBJECT-TYPE invocation + value(ObjectName) + + DefValPart ::= "DEFVAL" "{" Defvalue "}" + | empty + + Defvalue ::= -- must be valid for the type specified in + -- SYNTAX clause of same OBJECT-TYPE macro + value(ObjectSyntax) + | "{" BitsValue "}" + + BitsValue ::= BitNames + | empty + + BitNames ::= BitName + | BitNames "," BitName + + BitName ::= identifier + + -- a character string as defined in section 3.1.1 + Text ::= value(IA5String) +END + +-- definitions for notifications + +NOTIFICATION-TYPE MACRO ::= +BEGIN + TYPE NOTATION ::= + ObjectsPart + "STATUS" Status + "DESCRIPTION" Text + ReferPart + + VALUE NOTATION ::= + value(VALUE NotificationName) + + ObjectsPart ::= + "OBJECTS" "{" Objects "}" + | empty + Objects ::= + Object + + | Objects "," Object + Object ::= + value(ObjectName) + + Status ::= + "current" + | "deprecated" + | "obsolete" + + ReferPart ::= + "REFERENCE" Text + | empty + + -- a character string as defined in section 3.1.1 + Text ::= value(IA5String) +END + +-- definitions of administrative identifiers + +--zeroDotZero OBJECT-IDENTITY +-- STATUS current +-- DESCRIPTION +-- "A value used for null identifiers." +-- ::= { 0 0 } + +END

1 0

[cl-net-snmp-cvs] r38 - in trunk: . asn.1
by ctian＠common-lisp.net 16 Sep '07

16 Sep '07

Author: ctian Date: Sun Sep 16 04:11:39 2007 New Revision: 38 Added: trunk/asn.1/mib-parse.lisp Modified: trunk/asn.1/asn.1-domain.lisp trunk/asn.1/asn.1.tab trunk/asn.1/asn.1.zb trunk/asn.1/mib.lisp trunk/asn.1/stream-test.lisp trunk/net-snmp.asd Log: Comment Local Changes Modified: trunk/asn.1/asn.1-domain.lisp ============================================================================== --- trunk/asn.1/asn.1-domain.lisp (original) +++ trunk/asn.1/asn.1-domain.lisp Sun Sep 16 04:11:39 2007 @@ -4,351 +4,304 @@ (REQUIRE "zebu-package") (USE-PACKAGE "ZEBU") -(DEFSTRUCT (OBJ-ID-COMPONENTS-LIST - (:INCLUDE KB-DOMAIN) - (:PRINT-FUNCTION - (LAMBDA - (ITEM STREAM LEVEL &AUX - (%R (OBJ-ID-COMPONENTS-LIST--LIST ITEM))) - (DECLARE (IGNORE LEVEL)) - (FORMAT STREAM - "~a" - (LET ((OBJ-ID-COMPONENTS+ %R)) - (IF (NULL OBJ-ID-COMPONENTS+) - "" - (ZEBU::KB-SEQUENCE-PRINT OBJ-ID-COMPONENTS+ - NIL - NIL))))))) +(DEFSTRUCT + (OBJ-ID-COMPONENTS-LIST (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA (ITEM STREAM LEVEL &AUX (%R (OBJ-ID-COMPONENTS-LIST--LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM "~a" + (LET ((OBJ-ID-COMPONENTS+ %R)) + (IF (NULL OBJ-ID-COMPONENTS+) "" + (ZEBU::KB-SEQUENCE-PRINT OBJ-ID-COMPONENTS+ NIL + NIL))))))) (-LIST NIL :TYPE (OR NULL KB-SEQUENCE))) -(DEFSTRUCT (ASSIGNMENT-LIST - (:INCLUDE KB-DOMAIN) - (:PRINT-FUNCTION - (LAMBDA - (ITEM STREAM LEVEL &AUX - (%R (ASSIGNMENT-LIST--LIST ITEM))) - (DECLARE (IGNORE LEVEL)) - (FORMAT STREAM - "~a" - (LET ((ASSIGNMENT+ %R)) - (IF (NULL ASSIGNMENT+) - "" - (ZEBU::KB-SEQUENCE-PRINT ASSIGNMENT+ - NIL - NIL))))))) - (-LIST NIL :TYPE (OR NULL KB-SEQUENCE))) - -(DEFSTRUCT (ASSIGNMENT - (:INCLUDE KB-DOMAIN) - (:PRINT-FUNCTION - (LAMBDA - (ITEM STREAM LEVEL &AUX (%R (ASSIGNMENT--VALUE ITEM))) - (DECLARE (IGNORE LEVEL)) - (FORMAT STREAM - "~a" - (LET ((SPECIAL-ASSIGNMENT %R)) - (ZEBU::KB-SEQUENCE-PRINT SPECIAL-ASSIGNMENT - NIL - NIL)))))) +(DEFSTRUCT + (ASSIGNMENT (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA (ITEM STREAM LEVEL &AUX (%R (ASSIGNMENT--VALUE ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM "~a" + (LET ((SPECIAL-ASSIGNMENT %R)) + (ZEBU::KB-SEQUENCE-PRINT SPECIAL-ASSIGNMENT NIL NIL)))))) -TYPE -VALUE) -(DEFSTRUCT (MODULE-BODY - (:INCLUDE KB-DOMAIN) - (:PRINT-FUNCTION - (LAMBDA - (ITEM STREAM LEVEL &AUX (%R ITEM) - (%S (MODULE-BODY--ASSIGNMENT-LIST ITEM))) - (DECLARE (IGNORE LEVEL)) - (FORMAT STREAM - "~a ~a ~a" - (LET ((EXPORTS NIL)) - (ZEBU::KB-SEQUENCE-PRINT EXPORTS NIL NIL)) - NIL - %S)))) +(DEFSTRUCT + (ASSIGNMENT-LIST (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA (ITEM STREAM LEVEL &AUX (%R (ASSIGNMENT-LIST--LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM "~a" + (LET ((ASSIGNMENT+ %R)) + (IF (NULL ASSIGNMENT+) "" + (ZEBU::KB-SEQUENCE-PRINT ASSIGNMENT+ NIL NIL))))))) + (-LIST NIL :TYPE (OR NULL KB-SEQUENCE))) + +(DEFSTRUCT + (MODULE-BODY (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL + &AUX (%R ITEM) (%S (MODULE-BODY--ASSIGNMENT-LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM "~a ~a ~a" + (LET ((EXPORTS NIL)) + (ZEBU::KB-SEQUENCE-PRINT EXPORTS NIL NIL)) + NIL %S)))) -ASSIGNMENT-LIST) -(DEFSTRUCT (MODULE-DEFINITION - (:INCLUDE KB-DOMAIN) - (:PRINT-FUNCTION - (LAMBDA - (ITEM STREAM LEVEL &AUX - (%R (MODULE-DEFINITION--IDENTIFIER ITEM)) - (%S (MODULE-DEFINITION--BODY ITEM))) - (DECLARE (IGNORE LEVEL)) - (FORMAT STREAM "~a DEFINITIONS::=BEGIN ~a END" %R %S)))) +(DEFSTRUCT + (MODULE-DEFINITION (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL + &AUX (%R (MODULE-DEFINITION--IDENTIFIER ITEM)) + (%S (MODULE-DEFINITION--BODY ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM "~a DEFINITIONS::=BEGIN ~a END" %R %S)))) -IDENTIFIER -BODY) -(DEFUN SYMBOL+\,1$234 (SYMBOL) (MAKE-KB-SEQUENCE :FIRST SYMBOL)) +(DEFUN |SYMBOL+,1$18| (SYMBOL) (MAKE-KB-SEQUENCE :FIRST SYMBOL)) -(DEFUN SYMBOL+\,1$235 (SYMBOL DUMMY SYMBOL+\,1$) +(DEFUN |SYMBOL+,1$19| (SYMBOL DUMMY |SYMBOL+,1$|) (DECLARE (IGNORE DUMMY)) - (MAKE-KB-SEQUENCE :FIRST SYMBOL :REST SYMBOL+\,1$)) + (MAKE-KB-SEQUENCE :FIRST SYMBOL :REST |SYMBOL+,1$|)) -(DEFUN ASSIGNMENT+236 (ASSIGNMENT) (MAKE-KB-SEQUENCE :FIRST ASSIGNMENT)) +(DEFUN ASSIGNMENT+20 (ASSIGNMENT) (MAKE-KB-SEQUENCE :FIRST ASSIGNMENT)) -(DEFUN ASSIGNMENT+237 (ASSIGNMENT ASSIGNMENT+) +(DEFUN ASSIGNMENT+21 (ASSIGNMENT ASSIGNMENT+) (MAKE-KB-SEQUENCE :FIRST ASSIGNMENT :REST ASSIGNMENT+)) -(DEFUN OBJ-ID-COMPONENTS+238 (OBJ-ID-COMPONENTS) +(DEFUN OBJ-ID-COMPONENTS+22 (OBJ-ID-COMPONENTS) (MAKE-KB-SEQUENCE :FIRST OBJ-ID-COMPONENTS)) -(DEFUN OBJ-ID-COMPONENTS+239 (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) +(DEFUN OBJ-ID-COMPONENTS+23 (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) (MAKE-KB-SEQUENCE :FIRST OBJ-ID-COMPONENTS :REST OBJ-ID-COMPONENTS+)) -(DEFUN GARBAGE+240 (GARBAGE) (MAKE-KB-SEQUENCE :FIRST GARBAGE)) +(DEFUN GARBAGE+24 (GARBAGE) (MAKE-KB-SEQUENCE :FIRST GARBAGE)) -(DEFUN GARBAGE+241 (GARBAGE GARBAGE+) +(DEFUN GARBAGE+25 (GARBAGE GARBAGE+) (MAKE-KB-SEQUENCE :FIRST GARBAGE :REST GARBAGE+)) -(DEFUN OBJ-ID-COMPONENTS-LIST242 (OBJ-ID-COMPONENTS+) +(DEFUN OBJ-ID-COMPONENTS-LIST26 (OBJ-ID-COMPONENTS+) (MAKE-OBJ-ID-COMPONENTS-LIST :-LIST OBJ-ID-COMPONENTS+)) -(DEFUN ASSIGNMENT243 (SPECIAL-ASSIGNMENT) +(DEFUN ASSIGNMENT27 (SPECIAL-ASSIGNMENT) (MAKE-ASSIGNMENT :-TYPE :SPECIAL :-VALUE SPECIAL-ASSIGNMENT)) -(DEFUN ASSIGNMENT244 (TYPE-ASSIGNMENT) +(DEFUN ASSIGNMENT28 (TYPE-ASSIGNMENT) (MAKE-ASSIGNMENT :-TYPE :TYPE :-VALUE TYPE-ASSIGNMENT)) -(DEFUN ASSIGNMENT245 (VALUE-ASSIGNMENT) +(DEFUN ASSIGNMENT29 (VALUE-ASSIGNMENT) (MAKE-ASSIGNMENT :-TYPE :VALUE :-VALUE VALUE-ASSIGNMENT)) -(DEFUN ASSIGNMENT-LIST246 (ASSIGNMENT+) +(DEFUN ASSIGNMENT-LIST30 (ASSIGNMENT+) (MAKE-ASSIGNMENT-LIST :-LIST ASSIGNMENT+)) -(DEFUN MODULE-BODY247 (EXPORTS IMPORTS ASSIGNMENT-LIST) +(DEFUN MODULE-BODY31 (EXPORTS IMPORTS ASSIGNMENT-LIST) (MAKE-MODULE-BODY :-ASSIGNMENT-LIST ASSIGNMENT-LIST)) -(DEFUN MODULE-DEFINITION248 +(DEFUN MODULE-DEFINITION32 (MODULE-IDENTIFIER DUMMY DUMMY1 DUMMY2 MODULE-BODY DUMMY3) (DECLARE (IGNORE DUMMY3 DUMMY2 DUMMY1 DUMMY)) - (MAKE-MODULE-DEFINITION :-IDENTIFIER - MODULE-IDENTIFIER - :-BODY - MODULE-BODY)) + (MAKE-MODULE-DEFINITION :-IDENTIFIER MODULE-IDENTIFIER :-BODY MODULE-BODY)) (EVAL-WHEN (COMPILE) (UNLESS (MEMBER "zebu-regex" *MODULES* :TEST #'EQUAL) (WARN "Load the Zebu Compiler!"))) (DECLAIM (SPECIAL ZEBU::*REGEX-GROUPS* ZEBU::*REGEX-GROUPINGS*)) -(DEFUN A-NUMBER - (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) - (WHEN (PROGN - (SETF ZEBU::*REGEX-GROUPINGS* 1) - (BLOCK ZEBU::FINAL-RETURN - (BLOCK ZEBU::COMPARE - (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) - (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) - (LIST ZEBU::INDEX NIL)) - (LET ((ZEBU::OINDEX ZEBU::INDEX)) - (BLOCK ZEBU::COMPARE - (DO () - (NIL) - (LET ((ZEBU::RANGE - #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 - (SBIT - ZEBU::RANGE - (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))))) - (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) - ((< ZEBU::START ZEBU::OINDEX) NIL) - (LET ((ZEBU::INDEX ZEBU::START)) - (BLOCK ZEBU::COMPARE - (LET ((ZEBU::RANGE - #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 - (SBIT - ZEBU::RANGE - (CHAR-CODE - (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))) - (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) - ZEBU::INDEX) - (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) +(DEFUN A-NUMBER (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN + (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) (DEFUN VALUE-REFERENCE (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) - (WHEN (PROGN - (SETF ZEBU::*REGEX-GROUPINGS* 1) - (BLOCK ZEBU::FINAL-RETURN - (BLOCK ZEBU::COMPARE - (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) - (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) - (LIST ZEBU::INDEX NIL)) - (LET ((ZEBU::RANGE - #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 + (WHEN + (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 (SBIT ZEBU::RANGE (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 (SBIT ZEBU::RANGE (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))) - (LET ((ZEBU::OINDEX ZEBU::INDEX)) - (BLOCK ZEBU::COMPARE - (DO () - (NIL) - (LET ((ZEBU::RANGE - #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 - (SBIT - ZEBU::RANGE - (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))))) - (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) - ((< ZEBU::START ZEBU::OINDEX) NIL) - (LET ((ZEBU::INDEX ZEBU::START)) - (BLOCK ZEBU::COMPARE - (LET ((ZEBU::RANGE - #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 - (SBIT - ZEBU::RANGE - (CHAR-CODE - (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))) - (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) - ZEBU::INDEX) - (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) (DEFUN TYPE-REFERENCE (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) - (WHEN (PROGN - (SETF ZEBU::*REGEX-GROUPINGS* 1) - (BLOCK ZEBU::FINAL-RETURN - (BLOCK ZEBU::COMPARE - (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) - (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) - (LIST ZEBU::INDEX NIL)) - (LET ((ZEBU::RANGE - #*0000000000000000000000000000000000000000000000000000000000000000011111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 + (WHEN + (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000011111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 (SBIT ZEBU::RANGE (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 (SBIT ZEBU::RANGE (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))) - (LET ((ZEBU::OINDEX ZEBU::INDEX)) - (BLOCK ZEBU::COMPARE - (DO () - (NIL) - (LET ((ZEBU::RANGE - #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 - (SBIT - ZEBU::RANGE - (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))))) - (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) - ((< ZEBU::START ZEBU::OINDEX) NIL) - (LET ((ZEBU::INDEX ZEBU::START)) - (BLOCK ZEBU::COMPARE - (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) - ZEBU::INDEX) - (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) (DEFUN MODULE-REFERENCE (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) - (WHEN (PROGN - (SETF ZEBU::*REGEX-GROUPINGS* 1) - (BLOCK ZEBU::FINAL-RETURN - (BLOCK ZEBU::COMPARE - (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) - (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) - (LIST ZEBU::INDEX NIL)) - (LET ((ZEBU::RANGE - #*0000000000000000000000000000000000000000000000000000000000000000011111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 + (WHEN + (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000011111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 (SBIT ZEBU::RANGE (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 (SBIT ZEBU::RANGE (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))) - (LET ((ZEBU::OINDEX ZEBU::INDEX)) - (BLOCK ZEBU::COMPARE - (DO () - (NIL) - (LET ((ZEBU::RANGE - #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 - (SBIT - ZEBU::RANGE - (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))))) - (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) - ((< ZEBU::START ZEBU::OINDEX) NIL) - (LET ((ZEBU::INDEX ZEBU::START)) - (BLOCK ZEBU::COMPARE - (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) - ZEBU::INDEX) - (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) -(DEFUN ANY-THING - (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) - (WHEN (PROGN - (SETF ZEBU::*REGEX-GROUPINGS* 1) - (BLOCK ZEBU::FINAL-RETURN - (BLOCK ZEBU::COMPARE - (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) - (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) - (LIST ZEBU::INDEX NIL)) - (LET ((ZEBU::OINDEX ZEBU::INDEX)) - (BLOCK ZEBU::COMPARE - (DO () - (NIL) - (LET ((ZEBU::RANGE - #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 - (SBIT - ZEBU::RANGE - (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))))) - (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) - ((< ZEBU::START ZEBU::OINDEX) NIL) - (LET ((ZEBU::INDEX ZEBU::START)) - (BLOCK ZEBU::COMPARE - (LET ((ZEBU::RANGE - #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) - (IF (>= ZEBU::INDEX LENGTH) - (RETURN-FROM ZEBU::COMPARE NIL)) - (IF (= 1 - (SBIT - ZEBU::RANGE - (CHAR-CODE - (CHAR STRING ZEBU::INDEX)))) - (INCF ZEBU::INDEX) - (RETURN-FROM ZEBU::COMPARE NIL))) - (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) - ZEBU::INDEX) - (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) +(DEFUN ANY-THING (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN + (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF + (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) Modified: trunk/asn.1/asn.1.tab ============================================================================== --- trunk/asn.1/asn.1.tab (original) +++ trunk/asn.1/asn.1.tab Sun Sep 16 04:11:39 2007 @@ -1,6 +1,6 @@ -(:FILE "/home/binghe/cl-net-snmp/asn.1/asn.1.zb" :NAME "ASN.1" :DOMAIN-FILE "asn.1-domain.lisp" :PACKAGE "ASN.1" :GRAMMAR "zebu-mg" :IDENTIFIER-START-CHARS "abcdefghijklmnopqrstuvwxyz" :IDENTIFIER-CONTINUE-CHARS "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" :LEX-CATS ((A-NUMBER "[0-9]+") (VALUE-REFERENCE "[a-z][a-zA-Z0-9-]+") (TYPE-REFERENCE "[A-Z][a-zA-Z0-9-]*") (MODULE-REFERENCE "[A-Z][a-zA-Z0-9-]*") (ANY-THING "[^ ]+")) :DOMAIN (KB-DOMAIN :SUBTYPE (OBJ-ID-COMPONENTS-LIST :SLOTS ((-LIST KB-SEQUENCE))) :SUBTYPE (ASSIGNMENT-LIST :SLOTS ((-LIST KB-SEQUENCE))) :SUBTYPE (ASSIGNMENT :SLOTS (-TYPE -VALUE)) :SUBTYPE (MODULE-BODY :SLOTS (-ASSIGNMENT-LIST)) :SUBTYPE (MODULE-DEFINITION :SLOTS (-IDENTIFIER -BODY))) :DOMAIN-FILE "/home/binghe/cl-net-snmp/asn.1/asn.1-domain.lisp") -#75(ZEBU::THE-EMPTY-STRING ZEBU::AUGMENTED-START ZEBU::THE-END-G-SYMBOL MODULE-DEFINITION MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END" MODULE-REFERENCE EXPORTS IMPORTS ASSIGNMENT-LIST "EXPORTS" SYMBOLS-EXPORTED ";" "ALL" SYMBOL+\,1$ SYMBOL REFERENCE TYPE-REFERENCE VALUE-REFERENCE ASSIGNMENT+ ASSIGNMENT SPECIAL-ASSIGNMENT TYPE-ASSIGNMENT VALUE-ASSIGNMENT TYPE VALUE BUILTIN-TYPE OBJECT-IDENTIFIER-TYPE CHOICE-TYPE OCTET-STRING-TYPE INTEGER-TYPE TAGGED-TYPE "OBJECT" "IDENTIFIER" BUILTIN-VALUE OBJECT-IDENTIFIER-VALUE "{" OBJ-ID-COMPONENTS-LIST "}" OBJ-ID-COMPONENTS+ OBJ-ID-COMPONENTS NAME-AND-NUMBER-FORM NAME-FORM NUMBER-FORM IDENTIFIER "(" ")" A-NUMBER "OBJECT-TYPE" "MACRO" GARBAGE+ GARBAGE ANY-THING "CHOICE" "OCTET" "STRING" STRING-OPTIONS "SIZE" "INTEGER" ".." TAG "IMPLICIT" "EXPLICIT" "[" CLASS CLASS-NUMBER "]" "UNIVERSAL" "APPLICATION" "PRIVATE" "," ) +(:FILE "/home/binghe/lisp/cl-net-snmp/trunk/asn.1/asn.1.zb" :NAME "ASN.1" :DOMAIN-FILE "asn.1-domain.lisp" :PACKAGE "ASN.1" :GRAMMAR "zebu-mg" :IDENTIFIER-START-CHARS "abcdefghijklmnopqrstuvwxyz" :IDENTIFIER-CONTINUE-CHARS "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" :LEX-CATS ((A-NUMBER "[0-9]+") (VALUE-REFERENCE "[a-z][a-zA-Z0-9-]+") (TYPE-REFERENCE "[A-Z][a-zA-Z0-9-]*") (MODULE-REFERENCE "[A-Z][a-zA-Z0-9-]*") (ANY-THING "[^ ]+")) :DOMAIN (KB-DOMAIN :SUBTYPE (OBJ-ID-COMPONENTS-LIST :SLOTS ((-LIST KB-SEQUENCE))) :SUBTYPE (ASSIGNMENT :SLOTS (-TYPE -VALUE)) :SUBTYPE (ASSIGNMENT-LIST :SLOTS ((-LIST KB-SEQUENCE))) :SUBTYPE (MODULE-BODY :SLOTS (-ASSIGNMENT-LIST)) :SUBTYPE (MODULE-DEFINITION :SLOTS (-IDENTIFIER -BODY))) :DOMAIN-FILE "/home/binghe/lisp/cl-net-snmp/trunk/asn.1/asn.1-domain.lisp") +#75(ZEBU::THE-EMPTY-STRING ZEBU::AUGMENTED-START ZEBU::THE-END-G-SYMBOL MODULE-DEFINITION MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END" MODULE-REFERENCE EXPORTS IMPORTS ASSIGNMENT-LIST "EXPORTS" SYMBOLS-EXPORTED ";" "ALL" |SYMBOL+,1$| SYMBOL REFERENCE TYPE-REFERENCE VALUE-REFERENCE ASSIGNMENT+ ASSIGNMENT SPECIAL-ASSIGNMENT TYPE-ASSIGNMENT VALUE-ASSIGNMENT TYPE VALUE BUILTIN-TYPE OBJECT-IDENTIFIER-TYPE CHOICE-TYPE OCTET-STRING-TYPE INTEGER-TYPE TAGGED-TYPE "OBJECT" "IDENTIFIER" BUILTIN-VALUE OBJECT-IDENTIFIER-VALUE "{" OBJ-ID-COMPONENTS-LIST "}" OBJ-ID-COMPONENTS+ OBJ-ID-COMPONENTS NAME-AND-NUMBER-FORM NAME-FORM NUMBER-FORM IDENTIFIER "(" ")" A-NUMBER "OBJECT-TYPE" "MACRO" GARBAGE+ GARBAGE ANY-THING "CHOICE" "OCTET" "STRING" STRING-OPTIONS "SIZE" "INTEGER" ".." TAG "IMPLICIT" "EXPLICIT" "[" CLASS CLASS-NUMBER "]" "UNIVERSAL" "APPLICATION" "PRIVATE" "," ) #35(5 6 7 9 10 14 16 17 21 22 36 37 40 42 48 49 50 51 52 53 56 57 58 59 61 62 63 65 66 67 70 71 72 73 74 ) @@ -222,16 +222,16 @@ 2 -#37((MODULE-DEFINITION . #S(ZEBU::ZB-RULE :-NAME MODULE-DEFINITION :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END") :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-DEFINITION :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -IDENTIFIER :-VALUE MODULE-IDENTIFIER) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -BODY :-VALUE MODULE-BODY))) :-BUILD-FN MODULE-DEFINITION248)))) +#37((MODULE-DEFINITION . #S(ZEBU::ZB-RULE :-NAME MODULE-DEFINITION :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END") :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-DEFINITION :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -IDENTIFIER :-VALUE MODULE-IDENTIFIER) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -BODY :-VALUE MODULE-BODY))) :-BUILD-FN MODULE-DEFINITION32)))) (MODULE-IDENTIFIER . #S(ZEBU::ZB-RULE :-NAME MODULE-IDENTIFIER :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) -(MODULE-BODY . #S(ZEBU::ZB-RULE :-NAME MODULE-BODY :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (EXPORTS IMPORTS ASSIGNMENT-LIST) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-BODY :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -ASSIGNMENT-LIST :-VALUE ASSIGNMENT-LIST))) :-BUILD-FN MODULE-BODY247) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(MODULE-BODY . #S(ZEBU::ZB-RULE :-NAME MODULE-BODY :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (EXPORTS IMPORTS ASSIGNMENT-LIST) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-BODY :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -ASSIGNMENT-LIST :-VALUE ASSIGNMENT-LIST))) :-BUILD-FN MODULE-BODY31) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) (EXPORTS . #S(ZEBU::ZB-RULE :-NAME EXPORTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("EXPORTS" SYMBOLS-EXPORTED ";") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("EXPORTS" "ALL" ";") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) -(SYMBOLS-EXPORTED . #S(ZEBU::ZB-RULE :-NAME SYMBOLS-EXPORTED :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL+\,1$) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(SYMBOLS-EXPORTED . #S(ZEBU::ZB-RULE :-NAME SYMBOLS-EXPORTED :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (|SYMBOL+,1$|) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) (SYMBOL . #S(ZEBU::ZB-RULE :-NAME SYMBOL :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) (IMPORTS . #S(ZEBU::ZB-RULE :-NAME IMPORTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) (REFERENCE . #S(ZEBU::ZB-RULE :-NAME REFERENCE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) -(ASSIGNMENT-LIST . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT-LIST :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT-LIST :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -LIST :-VALUE ASSIGNMENT+))) :-BUILD-FN ASSIGNMENT-LIST246)))) -(ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SPECIAL-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :SPECIAL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE SPECIAL-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT243) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :TYPE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE TYPE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT244) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :VALUE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE VALUE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT245)))) +(ASSIGNMENT-LIST . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT-LIST :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT-LIST :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -LIST :-VALUE ASSIGNMENT+))) :-BUILD-FN ASSIGNMENT-LIST30)))) +(ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SPECIAL-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :SPECIAL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE SPECIAL-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT27) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :TYPE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE TYPE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT28) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :VALUE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE VALUE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT29)))) (TYPE-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME TYPE-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE "::=" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) (VALUE-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME VALUE-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE TYPE "::=" VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) (TYPE . #S(ZEBU::ZB-RULE :-NAME TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (BUILTIN-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) @@ -240,7 +240,7 @@ (VALUE . #S(ZEBU::ZB-RULE :-NAME VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (BUILTIN-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) (BUILTIN-VALUE . #S(ZEBU::ZB-RULE :-NAME BUILTIN-VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) (OBJECT-IDENTIFIER-VALUE . #S(ZEBU::ZB-RULE :-NAME OBJECT-IDENTIFIER-VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("{" OBJ-ID-COMPONENTS-LIST "}") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) -(OBJ-ID-COMPONENTS-LIST . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS-LIST :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE OBJ-ID-COMPONENTS-LIST :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -LIST :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJ-ID-COMPONENTS-LIST242)))) +(OBJ-ID-COMPONENTS-LIST . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS-LIST :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE OBJ-ID-COMPONENTS-LIST :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -LIST :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJ-ID-COMPONENTS-LIST26)))) (OBJ-ID-COMPONENTS . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAME-AND-NUMBER-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAME-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NUMBER-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) (NAME-AND-NUMBER-FORM . #S(ZEBU::ZB-RULE :-NAME NAME-AND-NUMBER-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER "(" NUMBER-FORM ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) (NAME-FORM . #S(ZEBU::ZB-RULE :-NAME NAME-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) @@ -255,8 +255,8 @@ (TAG . #S(ZEBU::ZB-RULE :-NAME TAG :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("[" CLASS CLASS-NUMBER "]") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) (CLASS-NUMBER . #S(ZEBU::ZB-RULE :-NAME CLASS-NUMBER :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (A-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) (CLASS . #S(ZEBU::ZB-RULE :-NAME CLASS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("UNIVERSAL") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("APPLICATION") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("PRIVATE") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) -(GARBAGE+ . #S(ZEBU::ZB-RULE :-NAME GARBAGE+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE))) :-BUILD-FN GARBAGE+240) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE GARBAGE+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE GARBAGE+))) :-BUILD-FN GARBAGE+241)))) -(OBJ-ID-COMPONENTS+ . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS))) :-BUILD-FN OBJ-ID-COMPONENTS+238) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJ-ID-COMPONENTS+239)))) -(ASSIGNMENT+ . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE ASSIGNMENT))) :-BUILD-FN ASSIGNMENT+236) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT ASSIGNMENT+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE ASSIGNMENT) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE ASSIGNMENT+))) :-BUILD-FN ASSIGNMENT+237)))) -(SYMBOL+\,1$ . #S(ZEBU::ZB-RULE :-NAME SYMBOL+\,1$ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL))) :-BUILD-FN SYMBOL+\,1$234) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL "," SYMBOL+\,1$) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE SYMBOL+\,1$))) :-BUILD-FN SYMBOL+\,1$235)))) +(GARBAGE+ . #S(ZEBU::ZB-RULE :-NAME GARBAGE+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE))) :-BUILD-FN GARBAGE+24) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE GARBAGE+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE GARBAGE+))) :-BUILD-FN GARBAGE+25)))) +(OBJ-ID-COMPONENTS+ . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS))) :-BUILD-FN OBJ-ID-COMPONENTS+22) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJ-ID-COMPONENTS+23)))) +(ASSIGNMENT+ . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE ASSIGNMENT))) :-BUILD-FN ASSIGNMENT+20) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT ASSIGNMENT+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE ASSIGNMENT) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE ASSIGNMENT+))) :-BUILD-FN ASSIGNMENT+21)))) +(|SYMBOL+,1$| . #S(ZEBU::ZB-RULE :-NAME |SYMBOL+,1$| :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL))) :-BUILD-FN |SYMBOL+,1$18|) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL "," |SYMBOL+,1$|) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE |SYMBOL+,1$|))) :-BUILD-FN |SYMBOL+,1$19|)))) ) \ No newline at end of file Modified: trunk/asn.1/asn.1.zb ============================================================================== --- trunk/asn.1/asn.1.zb (original) +++ trunk/asn.1/asn.1.zb Sun Sep 16 04:11:39 2007 @@ -23,6 +23,7 @@ Assignment-List := kb-domain: [(-list kb-sequence)]; Assignment := kb-domain: [(-type) (-value)]; Obj-Id-Components-List := kb-domain: [(-list kb-sequence)]; +Value-Assignment := kb-domain: []; ;; Rule Definitions Module-Definition --> Added: trunk/asn.1/mib-parse.lisp ============================================================================== --- (empty file) +++ trunk/asn.1/mib-parse.lisp Sun Sep 16 04:11:39 2007 @@ -0,0 +1,16 @@ +(in-package :asn.1) + +(defun parse-oid-def (syntax-tree) + (let ((module (car syntax-tree))) + (let ((assignment-list (Assignment-List--list + (Module-Body--assignment-list + (Module-Definition--body module))))) + (labels ((iter (kb-seq acc) + (if (null (kb-sequence-rest kb-seq)) + (nreverse (cons (kb-sequence-first kb-seq) acc)) + (iter (kb-sequence-rest kb-seq) + (cons (kb-sequence-first kb-seq) acc))))) + (delete-if-not #'(lambda (x) (eq (car x) :value)) + (mapcar #'(lambda (x) (cons (assignment--type x) + (assignment--value x))) + (iter assignment-list nil))))))) Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Sun Sep 16 04:11:39 2007 @@ -69,9 +69,3 @@ (zb:*comment-brackets* '(("/*" . "*/")))) (zb:file-parser file :grammar (zb:find-grammar "ASN.1") :verbose nil))) -(defun parse-oid-def (syntax-tree) - (let ((module (car syntax-tree))) - (let ((assignment-list (Assignment-List--list - (Module-Body--assignment-list - (Module-Definition--body module))))) - assignment-list))) Modified: trunk/asn.1/stream-test.lisp ============================================================================== --- trunk/asn.1/stream-test.lisp (original) +++ trunk/asn.1/stream-test.lisp Sun Sep 16 04:11:39 2007 @@ -42,3 +42,6 @@ (make-pathname :name name :type "asn" :directory '(:relative "asn.1" "test")) (asdf:component-pathname (asdf:find-system :net-snmp))))) + +(defun test-parse (name) + (parse-oid-def (parse-mib (mib-pathname name)))) Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Sun Sep 16 04:11:39 2007 @@ -11,11 +11,13 @@ :author "Chun Tian (binghe) <binghe.lisp(a)gmail.com>" :depends-on (:cffi :ironclad - :net-telent-date) + :net-telent-date + :zebu) :components ((:module asn.1 :components ((:file "package") (:file "ber" :depends-on ("package")) (:file "oid" :depends-on ("ber")) - (:file "mib" :depends-on ("oid")))) + (:file "mib" :depends-on ("oid")) + (:file "mib-parse" :depends-on ("mib")))) (:file "package") (:file "constants" :depends-on ("package")) (:file "typedefs" :depends-on ("constants"))

1 0

[cl-net-snmp-cvs] r37 - in trunk/asn.1: . test
by ctian＠common-lisp.net 15 Sep '07

15 Sep '07

Author: ctian Date: Sat Sep 15 17:13:11 2007 New Revision: 37 Added: trunk/asn.1/asn.1-domain.lisp trunk/asn.1/asn.1.tab trunk/asn.1/test/2.asn Modified: trunk/asn.1/asn.1.zb trunk/asn.1/ber.lisp trunk/asn.1/mib.lisp trunk/asn.1/oid.lisp trunk/asn.1/package.lisp trunk/asn.1/stream-test.lisp trunk/asn.1/test/1.asn Log: First release which can parse RFC1155 Added: trunk/asn.1/asn.1-domain.lisp ============================================================================== --- (empty file) +++ trunk/asn.1/asn.1-domain.lisp Sat Sep 15 17:13:11 2007 @@ -0,0 +1,354 @@ +;;; This file was generated by Zebu (Version 3.5.5) + +(IN-PACKAGE "ASN.1") +(REQUIRE "zebu-package") +(USE-PACKAGE "ZEBU") + +(DEFSTRUCT (OBJ-ID-COMPONENTS-LIST + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (OBJ-ID-COMPONENTS-LIST--LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a" + (LET ((OBJ-ID-COMPONENTS+ %R)) + (IF (NULL OBJ-ID-COMPONENTS+) + "" + (ZEBU::KB-SEQUENCE-PRINT OBJ-ID-COMPONENTS+ + NIL + NIL))))))) + (-LIST NIL :TYPE (OR NULL KB-SEQUENCE))) + +(DEFSTRUCT (ASSIGNMENT-LIST + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (ASSIGNMENT-LIST--LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a" + (LET ((ASSIGNMENT+ %R)) + (IF (NULL ASSIGNMENT+) + "" + (ZEBU::KB-SEQUENCE-PRINT ASSIGNMENT+ + NIL + NIL))))))) + (-LIST NIL :TYPE (OR NULL KB-SEQUENCE))) + +(DEFSTRUCT (ASSIGNMENT + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX (%R (ASSIGNMENT--VALUE ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a" + (LET ((SPECIAL-ASSIGNMENT %R)) + (ZEBU::KB-SEQUENCE-PRINT SPECIAL-ASSIGNMENT + NIL + NIL)))))) + -TYPE + -VALUE) + +(DEFSTRUCT (MODULE-BODY + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX (%R ITEM) + (%S (MODULE-BODY--ASSIGNMENT-LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a ~a ~a" + (LET ((EXPORTS NIL)) + (ZEBU::KB-SEQUENCE-PRINT EXPORTS NIL NIL)) + NIL + %S)))) + -ASSIGNMENT-LIST) + +(DEFSTRUCT (MODULE-DEFINITION + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (MODULE-DEFINITION--IDENTIFIER ITEM)) + (%S (MODULE-DEFINITION--BODY ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM "~a DEFINITIONS::=BEGIN ~a END" %R %S)))) + -IDENTIFIER + -BODY) + +(DEFUN SYMBOL+\,1$234 (SYMBOL) (MAKE-KB-SEQUENCE :FIRST SYMBOL)) + +(DEFUN SYMBOL+\,1$235 (SYMBOL DUMMY SYMBOL+\,1$) + (DECLARE (IGNORE DUMMY)) + (MAKE-KB-SEQUENCE :FIRST SYMBOL :REST SYMBOL+\,1$)) + +(DEFUN ASSIGNMENT+236 (ASSIGNMENT) (MAKE-KB-SEQUENCE :FIRST ASSIGNMENT)) + +(DEFUN ASSIGNMENT+237 (ASSIGNMENT ASSIGNMENT+) + (MAKE-KB-SEQUENCE :FIRST ASSIGNMENT :REST ASSIGNMENT+)) + +(DEFUN OBJ-ID-COMPONENTS+238 (OBJ-ID-COMPONENTS) + (MAKE-KB-SEQUENCE :FIRST OBJ-ID-COMPONENTS)) + +(DEFUN OBJ-ID-COMPONENTS+239 (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) + (MAKE-KB-SEQUENCE :FIRST OBJ-ID-COMPONENTS :REST OBJ-ID-COMPONENTS+)) + +(DEFUN GARBAGE+240 (GARBAGE) (MAKE-KB-SEQUENCE :FIRST GARBAGE)) + +(DEFUN GARBAGE+241 (GARBAGE GARBAGE+) + (MAKE-KB-SEQUENCE :FIRST GARBAGE :REST GARBAGE+)) + +(DEFUN OBJ-ID-COMPONENTS-LIST242 (OBJ-ID-COMPONENTS+) + (MAKE-OBJ-ID-COMPONENTS-LIST :-LIST OBJ-ID-COMPONENTS+)) + +(DEFUN ASSIGNMENT243 (SPECIAL-ASSIGNMENT) + (MAKE-ASSIGNMENT :-TYPE :SPECIAL :-VALUE SPECIAL-ASSIGNMENT)) + +(DEFUN ASSIGNMENT244 (TYPE-ASSIGNMENT) + (MAKE-ASSIGNMENT :-TYPE :TYPE :-VALUE TYPE-ASSIGNMENT)) + +(DEFUN ASSIGNMENT245 (VALUE-ASSIGNMENT) + (MAKE-ASSIGNMENT :-TYPE :VALUE :-VALUE VALUE-ASSIGNMENT)) + +(DEFUN ASSIGNMENT-LIST246 (ASSIGNMENT+) + (MAKE-ASSIGNMENT-LIST :-LIST ASSIGNMENT+)) + +(DEFUN MODULE-BODY247 (EXPORTS IMPORTS ASSIGNMENT-LIST) + (MAKE-MODULE-BODY :-ASSIGNMENT-LIST ASSIGNMENT-LIST)) + +(DEFUN MODULE-DEFINITION248 + (MODULE-IDENTIFIER DUMMY DUMMY1 DUMMY2 MODULE-BODY DUMMY3) + (DECLARE (IGNORE DUMMY3 DUMMY2 DUMMY1 DUMMY)) + (MAKE-MODULE-DEFINITION :-IDENTIFIER + MODULE-IDENTIFIER + :-BODY + MODULE-BODY)) + + +(EVAL-WHEN (COMPILE) + (UNLESS (MEMBER "zebu-regex" *MODULES* :TEST #'EQUAL) + (WARN "Load the Zebu Compiler!"))) +(DECLAIM (SPECIAL ZEBU::*REGEX-GROUPS* ZEBU::*REGEX-GROUPINGS*)) +(DEFUN A-NUMBER + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE + (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN VALUE-REFERENCE + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE + (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN TYPE-REFERENCE + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000011111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN MODULE-REFERENCE + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000011111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN ANY-THING + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE + (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) Added: trunk/asn.1/asn.1.tab ============================================================================== --- (empty file) +++ trunk/asn.1/asn.1.tab Sat Sep 15 17:13:11 2007 @@ -0,0 +1,262 @@ + +(:FILE "/home/binghe/cl-net-snmp/asn.1/asn.1.zb" :NAME "ASN.1" :DOMAIN-FILE "asn.1-domain.lisp" :PACKAGE "ASN.1" :GRAMMAR "zebu-mg" :IDENTIFIER-START-CHARS "abcdefghijklmnopqrstuvwxyz" :IDENTIFIER-CONTINUE-CHARS "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" :LEX-CATS ((A-NUMBER "[0-9]+") (VALUE-REFERENCE "[a-z][a-zA-Z0-9-]+") (TYPE-REFERENCE "[A-Z][a-zA-Z0-9-]*") (MODULE-REFERENCE "[A-Z][a-zA-Z0-9-]*") (ANY-THING "[^ ]+")) :DOMAIN (KB-DOMAIN :SUBTYPE (OBJ-ID-COMPONENTS-LIST :SLOTS ((-LIST KB-SEQUENCE))) :SUBTYPE (ASSIGNMENT-LIST :SLOTS ((-LIST KB-SEQUENCE))) :SUBTYPE (ASSIGNMENT :SLOTS (-TYPE -VALUE)) :SUBTYPE (MODULE-BODY :SLOTS (-ASSIGNMENT-LIST)) :SUBTYPE (MODULE-DEFINITION :SLOTS (-IDENTIFIER -BODY))) :DOMAIN-FILE "/home/binghe/cl-net-snmp/asn.1/asn.1-domain.lisp") +#75(ZEBU::THE-EMPTY-STRING ZEBU::AUGMENTED-START ZEBU::THE-END-G-SYMBOL MODULE-DEFINITION MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END" MODULE-REFERENCE EXPORTS IMPORTS ASSIGNMENT-LIST "EXPORTS" SYMBOLS-EXPORTED ";" "ALL" SYMBOL+\,1$ SYMBOL REFERENCE TYPE-REFERENCE VALUE-REFERENCE ASSIGNMENT+ ASSIGNMENT SPECIAL-ASSIGNMENT TYPE-ASSIGNMENT VALUE-ASSIGNMENT TYPE VALUE BUILTIN-TYPE OBJECT-IDENTIFIER-TYPE CHOICE-TYPE OCTET-STRING-TYPE INTEGER-TYPE TAGGED-TYPE "OBJECT" "IDENTIFIER" BUILTIN-VALUE OBJECT-IDENTIFIER-VALUE "{" OBJ-ID-COMPONENTS-LIST "}" OBJ-ID-COMPONENTS+ OBJ-ID-COMPONENTS NAME-AND-NUMBER-FORM NAME-FORM NUMBER-FORM IDENTIFIER "(" ")" A-NUMBER "OBJECT-TYPE" "MACRO" GARBAGE+ GARBAGE ANY-THING "CHOICE" "OCTET" "STRING" STRING-OPTIONS "SIZE" "INTEGER" ".." TAG "IMPLICIT" "EXPLICIT" "[" CLASS CLASS-NUMBER "]" "UNIVERSAL" "APPLICATION" "PRIVATE" "," ) + + +#35(5 6 7 9 10 14 16 17 21 22 36 37 40 42 48 49 50 51 52 53 56 57 58 59 61 62 63 65 66 67 70 71 72 73 74 ) + +#62((1 . 1)(3 . 6)(4 . 1)(8 . 3)(8 . 0)(11 . 3)(11 . 3)(11 . 0)(15 . 1)(15 . 0)(19 . 1)(12 . 1)(12 . 0)(20 . 1)(20 . 1)(13 . 1)(24 . 1)(24 . 1)(24 . 1)(26 . 3)(27 . 4)(28 . 1)(30 . 1)(30 . 1)(30 . 1)(30 . 1)(30 . 1)(31 . 2)(29 . 1)(38 . 1)(39 . 3)(41 . 1)(44 . 1)(44 . 1)(44 . 1)(45 . 4)(46 . 1)(47 . 1)(25 . 6)(55 . 1)(32 . 4)(33 . 3)(60 . 6)(60 . 0)(34 . 6)(35 . 2)(35 . 3)(35 . 3)(64 . 4)(69 . 1)(68 . 1)(68 . 1)(68 . 1)(68 . 0)(54 . 1)(54 . 2)(43 . 1)(43 . 2)(23 . 1)(23 . 2)(18 . 1)(18 . 3)) + +#104( +((10 :S 8)) +((2 :A 0)) +((5 :S 3)) +((6 :S 4)) +((7 :S 5)) +((9 :R 4) (14 :S 97) (21 :R 7) (22 :R 7) (52 :R 7)) +((9 :S 7)) +((2 :R 1)) +((5 :R 2)) +((21 :S 18) (22 :R 12) (52 :R 12)) +((21 :S 25) (22 :S 28) (52 :S 53)) +((9 :R 3)) +((16 :S 13)) +((21 :R 5) (22 :R 5) (52 :R 5)) +((16 :S 15)) +((21 :R 6) (22 :R 6) (52 :R 6)) +((16 :R 8)) +((16 :R 10) (74 :R 10)) +((21 :R 11) (22 :R 11) (52 :R 11)) +((16 :R 13) (74 :R 13)) +((16 :R 14) (74 :R 14)) +((9 :R 15)) +((9 :R 16) (21 :R 16) (22 :R 16) (52 :R 16)) +((9 :R 17) (21 :R 17) (22 :R 17) (52 :R 17)) +((9 :R 18) (21 :R 18) (22 :R 18) (52 :R 18)) +((6 :S 26)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (67 :S 84)) +((9 :R 19) (21 :R 19) (22 :R 19) (52 :R 19)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (67 :S 84)) +((6 :S 30)) +((40 :S 42)) +((9 :R 20) (21 :R 20) (22 :R 20) (52 :R 20)) +((6 :R 21) (9 :R 21) (21 :R 21) (22 :R 21) (52 :R 21)) +((6 :R 22) (9 :R 22) (21 :R 22) (22 :R 22) (52 :R 22)) +((6 :R 23) (9 :R 23) (21 :R 23) (22 :R 23) (52 :R 23)) +((6 :R 24) (9 :R 24) (21 :R 24) (22 :R 24) (52 :R 24)) +((6 :R 25) (9 :R 25) (21 :R 25) (22 :R 25) (52 :R 25)) +((6 :R 26) (9 :R 26) (21 :R 26) (22 :R 26) (52 :R 26)) +((37 :S 39)) +((6 :R 27) (9 :R 27) (21 :R 27) (22 :R 27) (52 :R 27)) +((9 :R 28) (21 :R 28) (22 :R 28) (52 :R 28)) +((9 :R 29) (21 :R 29) (22 :R 29) (52 :R 29)) +((48 :S 98) (51 :S 52)) +((42 :S 44)) +((9 :R 30) (21 :R 30) (22 :R 30) (52 :R 30)) +((42 :R 31)) +((42 :R 32) (48 :R 32) (51 :R 32)) +((42 :R 33) (48 :R 33) (51 :R 33)) +((42 :R 34) (48 :R 34) (51 :R 34)) +((51 :S 52)) +((50 :S 51)) +((42 :R 35) (48 :R 35) (51 :R 35)) +((42 :R 37) (48 :R 37) (50 :R 37) (51 :R 37)) +((53 :S 54)) +((6 :S 55)) +((7 :S 56)) +((56 :S 59)) +((9 :S 58)) +((9 :R 38) (21 :R 38) (22 :R 38) (52 :R 38)) +((9 :R 39) (42 :R 39) (56 :R 39)) +((40 :S 61)) +((56 :S 59)) +((42 :S 63)) +((6 :R 40) (9 :R 40) (21 :R 40) (22 :R 40) (52 :R 40)) +((59 :S 65)) +((6 :R 43) (9 :R 43) (21 :R 43) (22 :R 43) (49 :S 67) (52 :R 43)) +((6 :R 41) (9 :R 41) (21 :R 41) (22 :R 41) (52 :R 41)) +((61 :S 68)) +((49 :S 69)) +((51 :S 70)) +((50 :S 71)) +((50 :S 72)) +((6 :R 42) (9 :R 42) (21 :R 42) (22 :R 42) (52 :R 42)) +((49 :S 74)) +((51 :S 75)) +((63 :S 76)) +((51 :S 77)) +((50 :S 78)) +((6 :R 44) (9 :R 44) (21 :R 44) (22 :R 44) (52 :R 44)) +((6 :R 45) (9 :R 45) (21 :R 45) (22 :R 45) (52 :R 45)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (67 :S 84)) +((6 :R 46) (9 :R 46) (21 :R 46) (22 :R 46) (52 :R 46)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (67 :S 84)) +((6 :R 47) (9 :R 47) (21 :R 47) (22 :R 47) (52 :R 47)) +((51 :R 53) (71 :S 89) (72 :S 90) (73 :S 91)) +((51 :S 88)) +((70 :S 87)) +((36 :R 48) (57 :R 48) (58 :R 48) (62 :R 48) (65 :R 48) (66 :R 48) (67 :R 48)) +((70 :R 49)) +((51 :R 50)) +((51 :R 51)) +((51 :R 52)) +((9 :R 55) (42 :R 55)) +((42 :R 57)) +((9 :R 59)) +((21 :S 19) (22 :S 20)) +((16 :R 61)) +((16 :R 9) (17 :S 14) (21 :S 19) (22 :S 20)) +((42 :R 36) (48 :R 36) (49 :S 49) (51 :R 36)) +((9 :R 54) (42 :R 54) (56 :S 59)) +((42 :R 56) (48 :S 98) (51 :S 52)) +((9 :R 58) (21 :S 25) (22 :S 28) (52 :S 53)) +((16 :R 60) (74 :S 95)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (65 :S 80) (66 :S 82) (67 :S 84))) + +#104( +((3 . 1)(4 . 2)) +() +() +() +() +((8 . 6)(11 . 9)) +() +() +() +((12 . 10)) +((13 . 11)(23 . 21)(24 . 101)(25 . 22)(26 . 23)(27 . 24)) +() +() +() +() +() +() +() +() +() +() +() +() +() +() +() +((28 . 27)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103)) +() +((28 . 29)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103)) +() +((29 . 31)(38 . 40)(39 . 41)) +() +() +() +() +() +() +() +() +() +() +() +((41 . 43)(43 . 45)(44 . 100)(45 . 46)(46 . 47)(47 . 48)) +() +() +() +() +() +() +((47 . 50)) +() +() +() +() +() +() +((54 . 57)(55 . 99)) +() +() +() +() +((54 . 62)(55 . 99)) +() +() +() +((60 . 66)) +() +() +() +() +() +() +() +() +() +() +() +() +() +() +((28 . 81)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103)) +() +((28 . 83)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103)) +() +((68 . 85)) +((69 . 86)) +() +() +() +() +() +() +() +() +() +((18 . 96)(19 . 102)(20 . 17)) +() +((15 . 12)(18 . 16)(19 . 102)(20 . 17)) +() +((54 . 92)(55 . 99)) +((43 . 93)(44 . 100)(45 . 46)(46 . 47)(47 . 48)) +((23 . 94)(24 . 101)(25 . 22)(26 . 23)(27 . 24)) +() +((28 . 79)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103))) +0 + +2 + +#37((MODULE-DEFINITION . #S(ZEBU::ZB-RULE :-NAME MODULE-DEFINITION :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END") :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-DEFINITION :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -IDENTIFIER :-VALUE MODULE-IDENTIFIER) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -BODY :-VALUE MODULE-BODY))) :-BUILD-FN MODULE-DEFINITION248)))) +(MODULE-IDENTIFIER . #S(ZEBU::ZB-RULE :-NAME MODULE-IDENTIFIER :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(MODULE-BODY . #S(ZEBU::ZB-RULE :-NAME MODULE-BODY :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (EXPORTS IMPORTS ASSIGNMENT-LIST) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-BODY :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -ASSIGNMENT-LIST :-VALUE ASSIGNMENT-LIST))) :-BUILD-FN MODULE-BODY247) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(EXPORTS . #S(ZEBU::ZB-RULE :-NAME EXPORTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("EXPORTS" SYMBOLS-EXPORTED ";") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("EXPORTS" "ALL" ";") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(SYMBOLS-EXPORTED . #S(ZEBU::ZB-RULE :-NAME SYMBOLS-EXPORTED :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL+\,1$) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(SYMBOL . #S(ZEBU::ZB-RULE :-NAME SYMBOL :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(IMPORTS . #S(ZEBU::ZB-RULE :-NAME IMPORTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(REFERENCE . #S(ZEBU::ZB-RULE :-NAME REFERENCE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(ASSIGNMENT-LIST . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT-LIST :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT-LIST :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -LIST :-VALUE ASSIGNMENT+))) :-BUILD-FN ASSIGNMENT-LIST246)))) +(ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SPECIAL-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :SPECIAL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE SPECIAL-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT243) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :TYPE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE TYPE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT244) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :VALUE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE VALUE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT245)))) +(TYPE-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME TYPE-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE "::=" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(VALUE-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME VALUE-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE TYPE "::=" VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TYPE . #S(ZEBU::ZB-RULE :-NAME TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (BUILTIN-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(BUILTIN-TYPE . #S(ZEBU::ZB-RULE :-NAME BUILTIN-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJECT-IDENTIFIER-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (CHOICE-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (OCTET-STRING-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (INTEGER-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAGGED-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(OBJECT-IDENTIFIER-TYPE . #S(ZEBU::ZB-RULE :-NAME OBJECT-IDENTIFIER-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("OBJECT" "IDENTIFIER") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(VALUE . #S(ZEBU::ZB-RULE :-NAME VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (BUILTIN-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(BUILTIN-VALUE . #S(ZEBU::ZB-RULE :-NAME BUILTIN-VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(OBJECT-IDENTIFIER-VALUE . #S(ZEBU::ZB-RULE :-NAME OBJECT-IDENTIFIER-VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("{" OBJ-ID-COMPONENTS-LIST "}") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(OBJ-ID-COMPONENTS-LIST . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS-LIST :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE OBJ-ID-COMPONENTS-LIST :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -LIST :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJ-ID-COMPONENTS-LIST242)))) +(OBJ-ID-COMPONENTS . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAME-AND-NUMBER-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAME-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NUMBER-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(NAME-AND-NUMBER-FORM . #S(ZEBU::ZB-RULE :-NAME NAME-AND-NUMBER-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER "(" NUMBER-FORM ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(NAME-FORM . #S(ZEBU::ZB-RULE :-NAME NAME-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(NUMBER-FORM . #S(ZEBU::ZB-RULE :-NAME NUMBER-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (A-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(SPECIAL-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME SPECIAL-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("OBJECT-TYPE" "MACRO" "::=" "BEGIN" GARBAGE+ "END") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(GARBAGE . #S(ZEBU::ZB-RULE :-NAME GARBAGE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ANY-THING) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(CHOICE-TYPE . #S(ZEBU::ZB-RULE :-NAME CHOICE-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("CHOICE" "{" GARBAGE+ "}") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(OCTET-STRING-TYPE . #S(ZEBU::ZB-RULE :-NAME OCTET-STRING-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("OCTET" "STRING" STRING-OPTIONS) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(STRING-OPTIONS . #S(ZEBU::ZB-RULE :-NAME STRING-OPTIONS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("(" "SIZE" "(" A-NUMBER ")" ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(INTEGER-TYPE . #S(ZEBU::ZB-RULE :-NAME INTEGER-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("INTEGER" "(" A-NUMBER ".." A-NUMBER ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TAGGED-TYPE . #S(ZEBU::ZB-RULE :-NAME TAGGED-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAG TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAG "IMPLICIT" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAG "EXPLICIT" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TAG . #S(ZEBU::ZB-RULE :-NAME TAG :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("[" CLASS CLASS-NUMBER "]") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(CLASS-NUMBER . #S(ZEBU::ZB-RULE :-NAME CLASS-NUMBER :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (A-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(CLASS . #S(ZEBU::ZB-RULE :-NAME CLASS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("UNIVERSAL") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("APPLICATION") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("PRIVATE") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(GARBAGE+ . #S(ZEBU::ZB-RULE :-NAME GARBAGE+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE))) :-BUILD-FN GARBAGE+240) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE GARBAGE+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE GARBAGE+))) :-BUILD-FN GARBAGE+241)))) +(OBJ-ID-COMPONENTS+ . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS))) :-BUILD-FN OBJ-ID-COMPONENTS+238) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJ-ID-COMPONENTS+239)))) +(ASSIGNMENT+ . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE ASSIGNMENT))) :-BUILD-FN ASSIGNMENT+236) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT ASSIGNMENT+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE ASSIGNMENT) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE ASSIGNMENT+))) :-BUILD-FN ASSIGNMENT+237)))) +(SYMBOL+\,1$ . #S(ZEBU::ZB-RULE :-NAME SYMBOL+\,1$ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL))) :-BUILD-FN SYMBOL+\,1$234) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL "," SYMBOL+\,1$) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE SYMBOL+\,1$))) :-BUILD-FN SYMBOL+\,1$235)))) +) \ No newline at end of file Modified: trunk/asn.1/asn.1.zb ============================================================================== --- trunk/asn.1/asn.1.zb (original) +++ trunk/asn.1/asn.1.zb Sat Sep 15 17:13:11 2007 @@ -1,29 +1,94 @@ ;;;; -*- Mode: Lisp -*- -(:name "asn.1" - :domain-file "asn.1-domain" +(:name "ASN.1" + :domain-file "asn.1-domain.lisp" :package "ASN.1" :grammar "zebu-mg" :identifier-start-chars "abcdefghijklmnopqrstuvwxyz" :identifier-continue-chars "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" - :lex-cats ((BSTRING "'[01]+'B") - (HSTRING "'([A-F0-9]+)'H")) - ) - -;; Domain definition - -Module-Definition := kb-domain: [(-identifier Module-Identifier) - (-body Module-Body)] ; - -;; Productions + :lex-cats (;;(BSTRING "'[01]+'B") + ;;(HSTRING "'([A-F0-9]+)'H") + (A-Number "[0-9]+") + (Value-Reference "[a-z][a-zA-Z0-9-]+") + (Type-Reference "[A-Z][a-zA-Z0-9-]*") + (Module-Reference "[A-Z][a-zA-Z0-9-]*") + (Any-Thing "[^ ]+"))) + +;; Domain Definitions + +Module-Definition := kb-domain: [(-identifier) (-body)]; +Module-Body := kb-domain: [(-assignment-list)]; +Assignment-List := kb-domain: [(-list kb-sequence)]; +Assignment := kb-domain: [(-type) (-value)]; +Obj-Id-Components-List := kb-domain: [(-list kb-sequence)]; +;; Rule Definitions Module-Definition --> Module-Identifier "DEFINITIONS" "::=" "BEGIN" Module-Body "END" { Module-Definition:[(-identifier Module-Identifier) (-body Module-Body)] }; -Module-Identifier --> Identifier; +Module-Identifier --> Module-Reference; + +Module-Body --> Exports Imports Assignment-List + { Module-Body:[(-assignment-list Assignment-List)] } + | ; + +Exports --> "EXPORTS" Symbols-Exported ";" | "EXPORTS" "ALL" ";" |; + +Symbols-Exported --> Symbol+ "," | ; + +Symbol --> Reference; + +Imports --> Type-Reference | ; + +Reference --> Type-Reference | Value-Reference; + +Assignment-List --> Assignment+ " " { Assignment-List:[(-list Assignment+)] }; + +Assignment --> Special-Assignment { Assignment:[(-type :special) (-value Special-Assignment)] } + | Type-Assignment { Assignment:[(-type :type) (-value Type-Assignment)] } + | Value-Assignment { Assignment:[(-type :value) (-value Value-Assignment)] }; + +Type-Assignment --> Type-Reference "::=" Type; +Value-Assignment --> Value-Reference Type "::=" Value; + +Type --> Builtin-Type; + +Builtin-Type --> Object-Identifier-Type + | Choice-Type + | Octet-String-Type + | Integer-Type + | Tagged-Type; + +Object-Identifier-Type --> "OBJECT" "IDENTIFIER"; + +Value --> Builtin-Value; + +Builtin-Value --> Object-Identifier-Value; + +Object-Identifier-Value --> "{" Obj-Id-Components-List "}"; + +Obj-Id-Components-List --> Obj-Id-Components+ " " + { Obj-Id-Components-List:[(-list Obj-Id-Components+)] }; + +Obj-Id-Components --> Name-And-Number-Form | Name-Form | Number-Form; + +Name-And-Number-Form --> Identifier "(" Number-Form ")"; +Name-Form --> Identifier; +Number-Form --> A-Number; + +Special-Assignment --> "OBJECT-TYPE" "MACRO" "::=" "BEGIN" Garbage+ " " "END"; +Garbage --> Any-Thing; + +Choice-Type --> "CHOICE" "{" Garbage+ " " "}"; +Octet-String-Type --> "OCTET" "STRING" String-Options; +String-Options --> "(" "SIZE" "(" A-Number ")" ")" |; -Module-Body --> Identifier; +Integer-Type --> "INTEGER" "(" A-Number ".." A-Number ")"; +Tagged-Type --> Tag Type | Tag "IMPLICIT" Type | Tag "EXPLICIT" Type; +Tag --> "[" Class Class-Number "]"; +Class-Number --> A-Number; +Class --> "UNIVERSAL" | "APPLICATION" | "PRIVATE" |; Modified: trunk/asn.1/ber.lisp ============================================================================== --- trunk/asn.1/ber.lisp (original) +++ trunk/asn.1/ber.lisp Sat Sep 15 17:13:11 2007 @@ -41,7 +41,7 @@ (type (integer 0) tags)) (assert (and (<= 0 class 3) (<= 0 p/c 1) (<= 0 tags))) (labels ((iter (n p acc) - (if (= n 0) acc + (if (zerop n) acc (multiple-value-bind (q r) (floor n 128) (iter q 1 (cons (logior (ash p 7) r) acc)))))) (if (< tags 31) @@ -52,14 +52,14 @@ (defun ber-decode-type (stream) "Decode BER Type Domain" (declare (type stream stream)) - (let ((byte (stream-read-byte stream)) + (let ((byte (read-byte stream)) (type-length 1)) (let ((class (ldb (byte 2 6) byte)) (p/c (ldb (byte 1 5) byte)) (tags (ldb (byte 5 0) byte))) (when (= tags 31) (setf tags (labels ((iter (acc) - (setf byte (stream-read-byte stream)) + (setf byte (read-byte stream)) (incf type-length) (let ((temp (logior (ash acc 7) (ldb (byte 7 0) byte)))) (if (= (ldb (byte 1 7) byte) 1) (iter temp) temp)))) @@ -88,7 +88,7 @@ (declare (type (integer 0) length)) (assert (<= 0 length (1- (expt 2 1008)))) (labels ((iter (n acc l) - (if (= n 0) (cons (mod (logior 128 l) 256) acc) + (if (zerop n) (cons (mod (logior 128 l) 256) acc) (multiple-value-bind (q r) (floor n 256) (iter q (cons r acc) (1+ l)))))) (if (< length 128) (list length) @@ -97,15 +97,15 @@ (defun ber-decode-length (stream) "Decode BER Length Domain" (declare (type stream stream)) - (let ((byte (stream-read-byte stream)) + (let ((byte (read-byte stream)) (length-length 1)) (let ((flag (ldb (byte 1 7) byte)) (l-or-n (ldb (byte 7 0) byte))) - (let ((res (if (= flag 0) l-or-n + (let ((res (if (zerop flag) l-or-n (let ((acc 0)) (dotimes (i l-or-n) (setf acc (logior (ash acc 8) - (stream-read-byte stream))) + (read-byte stream))) (incf length-length) acc))))) (values res length-length))))) @@ -125,7 +125,7 @@ (type integer length) (ignore type)) (dotimes (i length) - (stream-read-byte stream)) + (read-byte stream)) nil) ;;;;;;;;;;;;;;;;;;;;;;; @@ -137,7 +137,7 @@ (defmethod ber-encode ((value integer)) (assert (<= 0 value)) (labels ((iter (n acc l) - (if (= n 0) (values acc l) + (if (zerop n) (values acc l) (multiple-value-bind (q r) (floor n 256) (iter q (cons r acc) (1+ l)))))) (multiple-value-bind (v l) (iter value nil 0) @@ -151,7 +151,7 @@ (ignore type)) (labels ((iter (i acc) (if (= i length) acc - (iter (1+ i) (logior (ash acc 8) (stream-read-byte stream)))))) + (iter (1+ i) (logior (ash acc 8) (read-byte stream)))))) (iter 0 0))) ;;; OCTET STRING (:octet-string) @@ -166,7 +166,7 @@ (type integer length) (ignore type)) (let ((str (make-string length))) - (map-into str #'(lambda () (code-char (stream-read-byte stream)))))) + (map-into str #'(lambda () (code-char (read-byte stream)))))) ;;; SEQUENCE (:sequence) @@ -182,7 +182,7 @@ (type integer length) (ignore type)) (labels ((iter (length-left acc) - (if (= length-left 0) + (if (zerop length-left) (nreverse acc) (multiple-value-bind (sub-type sub-type-length) (ber-decode-type stream) @@ -205,7 +205,7 @@ (declare (type stream stream) (type integer length) (ignore type)) - (assert (= length 0)) + (assert (zerop length)) nil) (eval-when (:load-toplevel :execute) Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Sat Sep 15 17:13:11 2007 @@ -4,10 +4,6 @@ (in-package :asn.1) -(defparameter *mib-tree* '(nil nil (1 ("iso") - (3 ("org") - (6 ("dod")))))) - (proclaim '(inline tree-id tree-name tree-object tree-nodes)) (defun tree-id (node) (car node)) (defun tree-name (node) (caadr node)) @@ -45,3 +41,37 @@ (defmethod print-object ((obj object-id) stream) (format stream "[~{.~A~}]" (oid-subids obj))) +(defparameter *mib-tree* '(nil nil (1 ("iso") + (3 ("org") + (6 ("dod")))))) + +(defvar *mib-pathname-base* #p"/usr/share/snmp/mibs/") + +(defun mib-pathname (name &optional (base *mib-pathname-base*)) + (merge-pathnames (make-pathname :name name :type "txt") + base)) + +(defparameter *mibs-list* + '("RFC1155-SMI")) + +(defvar *asn.1-def* (merge-pathnames + (make-pathname :name "asn.1" :type "zb" + :directory '(:relative "asn.1")) + (asdf:component-pathname (asdf:find-system :net-snmp)))) + +(defparameter *asn.1-syntax* (merge-pathnames + (make-pathname :name "asn.1" :type "tab" + :directory '(:relative "asn.1")) + (asdf:component-pathname (asdf:find-system :net-snmp)))) + +(defun parse-mib (file) + (let ((zb:*comment-start* "--") + (zb:*comment-brackets* '(("/*" . "*/")))) + (zb:file-parser file :grammar (zb:find-grammar "ASN.1") :verbose nil))) + +(defun parse-oid-def (syntax-tree) + (let ((module (car syntax-tree))) + (let ((assignment-list (Assignment-List--list + (Module-Body--assignment-list + (Module-Definition--body module))))) + assignment-list))) Modified: trunk/asn.1/oid.lisp ============================================================================== --- trunk/asn.1/oid.lisp (original) +++ trunk/asn.1/oid.lisp Sat Sep 15 17:13:11 2007 @@ -24,22 +24,22 @@ ;;; Note: defdelim and ddfn are copyed from ;;; Page 228 (Figure 17.4), Paul Graham's /On Lisp/. -(eval-when (:compile-toplevel :load-toplevel :execute) - (defmacro defdelim (left right parms &body body) - `(ddfn ,left ,right #'(lambda ,parms ,@body))) - - (let ((rpar (get-macro-character #\)))) - (defun ddfn (left right fn) - (set-macro-character right rpar) - (set-dispatch-macro-character #\# left - #'(lambda (stream char-1 char-2) - (declare (ignore char-1 char-2)) - (apply fn - (read-delimited-list right stream t)))))) - - ;;; Object ID Reader Macro #{...} - (defdelim #\{ #\} (&rest args) - `(parse-oid (list ,@args)))) +;;;; (eval-when (:compile-toplevel :load-toplevel :execute) +;;;; (defmacro defdelim (left right parms &body body) +;;;; `(ddfn ,left ,right #'(lambda ,parms ,@body))) + +;;;; (let ((rpar (get-macro-character #\)))) +;;;; (defun ddfn (left right fn) +;;;; (set-macro-character right rpar) +;;;; (set-dispatch-macro-character #\# left +;;;; #'(lambda (stream char-1 char-2) +;;;; (declare (ignore char-1 char-2)) +;;;; (apply fn +;;;; (read-delimited-list right stream t)))))) + +;;;; ;;; Object ID Reader Macro #{...} +;;;; (defdelim #\{ #\} (&rest args) +;;;; `(parse-oid (list ,@args)))) ;;; Note: oid-component, oid-component-length, list-prefix-p, oid-list->=, ;;; oid-list-< and oid-prefix-p are copyed from @@ -83,10 +83,10 @@ (defmethod ber-encode ((value object-id)) (labels ((number-get (n) - (if (= n 0) (values (list 0) 1) + (if (zerop n) (values (list 0) 1) (number-split n 0 nil 0))) (number-split (n p acc l) - (if (= n 0) (values acc l) + (if (zerop n) (values acc l) (multiple-value-bind (q r) (floor n 128) (number-split q 1 (cons (logior (ash p 7) r) acc) (1+ l))))) (iter (oids acc len) @@ -114,16 +114,17 @@ (declare (type stream stream) (type integer length) (ignore type)) - (if (= length 0) #{} + (if (zerop length) + (make-instance 'objet-id) (labels ((get-number (acc len) - (let* ((byte (stream-read-byte stream)) + (let* ((byte (read-byte stream)) (val (logior (ash acc 7) (logand byte 127)))) (if (< byte 128) (values val len) (get-number val (1+ len))))) (iter (left-length acc head-p) (declare (type integer left-length) (type list acc)) - (if (= left-length 0) (nreverse acc) + (if (zerop left-length) (nreverse acc) (multiple-value-bind (n l) (get-number 0 1) (if head-p (multiple-value-bind (q r) (floor n 40) Modified: trunk/asn.1/package.lisp ============================================================================== --- trunk/asn.1/package.lisp (original) +++ trunk/asn.1/package.lisp Sat Sep 15 17:13:11 2007 @@ -2,6 +2,7 @@ (defpackage :asn.1 (:use :common-lisp - #+lispworks :stream)) + #+lispworks :stream + :zebu)) (in-package :asn.1) Modified: trunk/asn.1/stream-test.lisp ============================================================================== --- trunk/asn.1/stream-test.lisp (original) +++ trunk/asn.1/stream-test.lisp Sat Sep 15 17:13:11 2007 @@ -1,5 +1,8 @@ (in-package :asn.1) +(eval-when (:compile-toplevel :load-toplevel) + (clc:clc-require :zebu-compiler)) + (defclass ber-stream (fundamental-input-stream) ((sequence :type sequence :initarg :seq :reader ber-sequence) (length :type integer :accessor ber-length) @@ -22,3 +25,20 @@ x (ber-decode (make-instance 'ber-stream :seq code)) code code) x)) + +(defun mib-display (name &optional (lines 10)) + (let ((file (mib-pathname name))) + (with-open-file (s file :direction :input :element-type 'base-char) + (dotimes (i lines file) + (princ (read-line s)) + (fresh-line))))) + +(defun load-syntax (&optional (def *asn.1-def*) (syntax *asn.1-syntax*)) + (zb:zebu-compile-file def :output-file syntax) + (zb:zebu-load-file syntax)) + +(defun test-syntax (name) + (parse-mib (merge-pathnames + (make-pathname :name name :type "asn" + :directory '(:relative "asn.1" "test")) + (asdf:component-pathname (asdf:find-system :net-snmp))))) Modified: trunk/asn.1/test/1.asn ============================================================================== --- trunk/asn.1/test/1.asn (original) +++ trunk/asn.1/test/1.asn Sat Sep 15 17:13:11 2007 @@ -1,4 +1,101 @@ -aAAA DEFINITIONS ::= -BEGIN - bBBB +RFC1155-SMI DEFINITIONS ::= BEGIN + +EXPORTS -- EVERYTHING + internet, directory, mgmt, + experimental, private, enterprises, + OBJECT-TYPE, ObjectName, ObjectSyntax, SimpleSyntax, + ApplicationSyntax, NetworkAddress, IpAddress, + Counter, Gauge, TimeTicks, Opaque; + + -- the path to the root + + internet OBJECT IDENTIFIER ::= { iso org(3) dod(6) 1 } + + directory OBJECT IDENTIFIER ::= { internet 1 } + + mgmt OBJECT IDENTIFIER ::= { internet 2 } + + experimental OBJECT IDENTIFIER ::= { internet 3 } + + private OBJECT IDENTIFIER ::= { internet 4 } + enterprises OBJECT IDENTIFIER ::= { private 1 } + + -- definition of object types + + + -- names of objects in the MIB + + ObjectName ::= OBJECT IDENTIFIER + + OBJECT-TYPE MACRO ::= + BEGIN + TYPE NOTATION ::= "SYNTAX" type (TYPE ObjectSyntax) + "ACCESS" Access + "STATUS" Status + VALUE NOTATION ::= value (VALUE ObjectName) + + Access ::= "read-only" + | "read-write" + | "write-only" + | "not-accessible" + Status ::= "mandatory" + | "optional" + | "obsolete" + END + + ObjectSyntax ::= + CHOICE { + simple + SimpleSyntax, + -- note that simple SEQUENCEs are not directly + -- mentioned here to keep things simple (i.e., + -- prevent mis-use). However, application-wide + -- types which are IMPLICITly encoded simple + -- SEQUENCEs may appear in the following CHOICE + + application-wide + ApplicationSyntax + } + + SimpleSyntax ::= + CHOICE { + number + INTEGER, + string + OCTET STRING, + object + OBJECT IDENTIFIER, + empty + NULL + } + + ApplicationSyntax ::= + CHOICE { + address + NetworkAddress, + counter + Counter, + gauge + Gauge, + ticks + TimeTicks, + arbitrary + Opaque + + -- other application-wide types, as they are + -- defined, will be added here + } + + -- application-wide types + + NetworkAddress ::= + CHOICE { + internet + IpAddress + } + + IpAddress ::= + [APPLICATION 0] -- in network-byte order + IMPLICIT OCTET STRING (SIZE (4)) + END Added: trunk/asn.1/test/2.asn ============================================================================== --- (empty file) +++ trunk/asn.1/test/2.asn Sat Sep 15 17:13:11 2007 @@ -0,0 +1,119 @@ +RFC1155-SMI DEFINITIONS ::= BEGIN + +EXPORTS -- EVERYTHING + internet, directory, mgmt, + experimental, private, enterprises, + OBJECT-TYPE, ObjectName, ObjectSyntax, SimpleSyntax, + ApplicationSyntax, NetworkAddress, IpAddress, + Counter, Gauge, TimeTicks, Opaque; + + -- the path to the root + + internet OBJECT IDENTIFIER ::= { iso org(3) dod(6) 1 } + + directory OBJECT IDENTIFIER ::= { internet 1 } + + mgmt OBJECT IDENTIFIER ::= { internet 2 } + + experimental OBJECT IDENTIFIER ::= { internet 3 } + + private OBJECT IDENTIFIER ::= { internet 4 } + enterprises OBJECT IDENTIFIER ::= { private 1 } + + -- definition of object types + + OBJECT-TYPE MACRO ::= + BEGIN + TYPE NOTATION ::= "SYNTAX" type (TYPE ObjectSyntax) + "ACCESS" Access + "STATUS" Status + VALUE NOTATION ::= value (VALUE ObjectName) + + Access ::= "read-only" + | "read-write" + | "write-only" + | "not-accessible" + Status ::= "mandatory" + | "optional" + | "obsolete" + END + + -- names of objects in the MIB + + ObjectName ::= + OBJECT IDENTIFIER + + -- syntax of objects in the MIB + + ObjectSyntax ::= + CHOICE { + simple + SimpleSyntax, + -- note that simple SEQUENCEs are not directly + -- mentioned here to keep things simple (i.e., + -- prevent mis-use). However, application-wide + -- types which are IMPLICITly encoded simple + -- SEQUENCEs may appear in the following CHOICE + + application-wide + ApplicationSyntax + } + + SimpleSyntax ::= + CHOICE { + number + INTEGER, + string + OCTET STRING, + object + OBJECT IDENTIFIER, + empty + NULL + } + + ApplicationSyntax ::= + CHOICE { + address + NetworkAddress, + counter + Counter, + gauge + Gauge, + ticks + TimeTicks, + arbitrary + Opaque + + -- other application-wide types, as they are + -- defined, will be added here + } + + -- application-wide types + + NetworkAddress ::= + CHOICE { + internet + IpAddress + } + + IpAddress ::= + [APPLICATION 0] -- in network-byte order + IMPLICIT OCTET STRING (SIZE (4)) + + Counter ::= + [APPLICATION 1] + IMPLICIT INTEGER (0..4294967295) + + Gauge ::= + [APPLICATION 2] + IMPLICIT INTEGER (0..4294967295) + + TimeTicks ::= + [APPLICATION 3] + IMPLICIT INTEGER (0..4294967295) + + Opaque ::= + [APPLICATION 4] -- arbitrary ASN.1 value, + IMPLICIT OCTET STRING -- "double-wrapped" + + END

1 0