- cl-net-snmp-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[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

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

14 Sep '07

Author: ctian Date: Fri Sep 14 12:54:23 2007 New Revision: 36 Modified: trunk/asn.1/mib.lisp trunk/net-snmp.asd Log: Add oid, mib into asdf Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Fri Sep 14 12:54:23 2007 @@ -35,8 +35,8 @@ (defun insert-node (node parent-name) (let ((parent-node (find-node parent-name))) (if parent-node - (if (find-if #'(lambda (x) (= (tree-id node) - (tree-id x))) + (if (find-if #'(lambda (x) + (= (tree-id node) (tree-id x))) (tree-nodes parent-node)) (error "id conflict") (nconc parent-node (list node))) @@ -44,3 +44,4 @@ (defmethod print-object ((obj object-id) stream) (format stream "[~{.~A~}]" (oid-subids obj))) + Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Fri Sep 14 12:54:23 2007 @@ -13,7 +13,9 @@ :ironclad :net-telent-date) :components ((:module asn.1 :components ((:file "package") - (:file "ber" :depends-on ("package")))) + (:file "ber" :depends-on ("package")) + (:file "oid" :depends-on ("ber")) + (:file "mib" :depends-on ("oid")))) (:file "package") (:file "constants" :depends-on ("package")) (:file "typedefs" :depends-on ("constants"))

1 0

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

14 Sep '07

Author: ctian Date: Fri Sep 14 05:13:38 2007 New Revision: 35 Added: trunk/asn.1/asn.1.zb trunk/asn.1/oid.lisp trunk/asn.1/test/ trunk/asn.1/test/1.asn Modified: trunk/asn.1/ber.lisp trunk/asn.1/mib.lisp trunk/asn.1/stream-test.lisp Log: Add OID encode/decode support Added: trunk/asn.1/asn.1.zb ============================================================================== --- (empty file) +++ trunk/asn.1/asn.1.zb Fri Sep 14 05:13:38 2007 @@ -0,0 +1,29 @@ +;;;; -*- Mode: Lisp -*- + +(:name "asn.1" + :domain-file "asn.1-domain" + :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 + +Module-Definition --> + Module-Identifier "DEFINITIONS" "::=" + "BEGIN" Module-Body "END" + { Module-Definition:[(-identifier Module-Identifier) (-body Module-Body)] }; + +Module-Identifier --> Identifier; + +Module-Body --> Identifier; Modified: trunk/asn.1/ber.lisp ============================================================================== --- trunk/asn.1/ber.lisp (original) +++ trunk/asn.1/ber.lisp Fri Sep 14 05:13:38 2007 @@ -120,8 +120,10 @@ (defgeneric ber-decode-value (stream type length)) -(defmethod ber-decode-value ((stream stream) (type (eql :unknown)) (length integer)) - (declare (type stream stream) (ignore type)) +(defmethod ber-decode-value ((stream stream) (type (eql :unknown)) length) + (declare (type stream stream) + (type integer length) + (ignore type)) (dotimes (i length) (stream-read-byte stream)) nil) @@ -143,8 +145,10 @@ (ber-encode-length l) v)))) -(defmethod ber-decode-value ((stream stream) (type (eql :integer)) (length integer)) - (declare (type stream stream) (ignore type)) +(defmethod ber-decode-value ((stream stream) (type (eql :integer)) length) + (declare (type stream stream) + (type integer length) + (ignore type)) (labels ((iter (i acc) (if (= i length) acc (iter (1+ i) (logior (ash acc 8) (stream-read-byte stream)))))) @@ -157,8 +161,10 @@ (ber-encode-length (length value)) (map 'list #'char-code value))) -(defmethod ber-decode-value ((stream stream) (type (eql :octet-string)) (length integer)) - (declare (type stream stream) (ignore type)) +(defmethod ber-decode-value ((stream stream) (type (eql :octet-string)) length) + (declare (type stream stream) + (type integer length) + (ignore type)) (let ((str (make-string length))) (map-into str #'(lambda () (code-char (stream-read-byte stream)))))) @@ -171,16 +177,18 @@ (ber-encode-length (length sub-encode)) sub-encode))) -(defmethod ber-decode-value ((stream stream) (type (eql :sequence)) (length integer)) - (declare (type stream stream) (ignore type)) - (labels ((iter (left acc) - (if (= left 0) +(defmethod ber-decode-value ((stream stream) (type (eql :sequence)) length) + (declare (type stream stream) + (type integer length) + (ignore type)) + (labels ((iter (length-left acc) + (if (= length-left 0) (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 (- left + (iter (- length-left sub-type-length sub-length-length sub-length) @@ -193,8 +201,10 @@ (nconc (ber-encode-type 0 0 5) (ber-encode-length 0))) -(defmethod ber-decode-value ((stream stream) (type (eql :null)) (length integer)) - (declare (type stream stream)) +(defmethod ber-decode-value ((stream stream) (type (eql :null)) length) + (declare (type stream stream) + (type integer length) + (ignore type)) (assert (= length 0)) nil) Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Fri Sep 14 05:13:38 2007 @@ -4,3 +4,43 @@ (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)) +(defun tree-object (node) (cdadr node)) +(defun tree-nodes (node) (cddr node)) + +(defun find-node (name &optional (node *mib-tree*)) + (declare (type string name)) + (labels ((test (n) + (string= name (tree-name n))) + (iter (queue) + (if (null queue) nil + (let ((head (car queue))) + (if (test head) head + (iter (cdr (append queue + (copy-list (tree-nodes (car queue))))))))))) + (if (test node) node + (iter (copy-list (tree-nodes node)))))) + +(defun make-node (id name &optional (object nil)) + (declare (type integer id) + (type string name)) + (list id (cons name object))) + +(defun insert-node (node parent-name) + (let ((parent-node (find-node parent-name))) + (if parent-node + (if (find-if #'(lambda (x) (= (tree-id node) + (tree-id x))) + (tree-nodes parent-node)) + (error "id conflict") + (nconc parent-node (list node))) + (error "cannot find parent")))) + +(defmethod print-object ((obj object-id) stream) + (format stream "[~{.~A~}]" (oid-subids obj))) Added: trunk/asn.1/oid.lisp ============================================================================== --- (empty file) +++ trunk/asn.1/oid.lisp Fri Sep 14 05:13:38 2007 @@ -0,0 +1,135 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Object ID Base Support ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(in-package :asn.1) + +(defclass object-id () + ((subids :initform nil :type list :reader oid-subids :initarg :id) + (length :initform 0 :type integer :reader oid-length))) + +(defmethod shared-initialize :after ((obj object-id) slot-names &rest initargs) + (declare (ignore slot-names initargs)) + (with-slots (subids length) obj + (setf length (list-length subids)))) + +(defgeneric parse-oid (oids)) + +(defmethod parse-oid ((oids list)) + (make-instance 'object-id :id oids)) + +(defmethod parse-oid ((oids string)) + nil) + +;;; 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)))) + +;;; Note: oid-component, oid-component-length, list-prefix-p, oid-list->=, +;;; oid-list-< and oid-prefix-p are copyed from +;;; the Lisp-SNMP Project: http://www.cliki.net/Lisp-SNMP + +(deftype oid-component () '(unsigned-byte 29)) +(deftype oid-component-length () '(integer 0 4)) + +(defun list-prefix-p (list1 list2) + (if (endp list1) + (values t list2) + (let ((f1 (first list1)) (f2 (first list2))) + (declare (type oid-component f1 f2)) + (and (eql f1 f2) (list-prefix-p (rest list1) (rest list2)))))) + +(defun oid-list->= (oid1 oid2) + (declare (type list oid1 oid2)) + (or (endp oid2) + (and (not (endp oid1)) + (let ((f1 (first oid1)) (f2 (first oid2))) + (declare (type oid-component f1 f2)) + (or (> f1 f2) + (and (= f1 f2) + (oid-list->= (rest oid1) (rest oid2)))))))) + +(defun oid-list-< (oid1 oid2) + (declare (type list oid1 oid2)) + (and (not (endp oid2)) + (or (endp oid1) + (let ((f1 (first oid1)) (f2 (first oid2))) + (declare (type oid-component f1 f2)) + (or (< f1 f2) + (and (= f1 f2) + (oid-list-< (rest oid1) (rest oid2)))))))) + +(defun oid-prefix-p (oid1 oid2) + (declare (type object-id oid1 oid2)) + (list-prefix-p (oid-subids oid1) (oid-subids oid2))) + +;;; BER Encode & Decode (:object-identifier) + +(defmethod ber-encode ((value object-id)) + (labels ((number-get (n) + (if (= n 0) (values (list 0) 1) + (number-split n 0 nil 0))) + (number-split (n p acc l) + (if (= n 0) (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) + (if (endp oids) + (values acc len) + (multiple-value-bind (sub-oid sub-length) (number-get (car oids)) + (iter (cdr oids) (nconc acc sub-oid) (+ len sub-length)))))) + (with-slots (subids length) value + (multiple-value-bind (v l) + (case length + (0 (values nil 0)) + (1 (number-split (* (first subids) 40) 0 nil 0)) + (2 (number-split (+ (* (first subids) 40) + (second subids)) 0 nil 0)) + (otherwise (apply #'iter + (cddr subids) + (multiple-value-list + (number-split (+ (* (first subids) 40) + (second subids)) 0 nil 0))))) + (nconc (ber-encode-type 0 0 6) + (ber-encode-length l) + v))))) + +(defmethod ber-decode-value ((stream stream) (type (eql :object-identifier)) length) + (declare (type stream stream) + (type integer length) + (ignore type)) + (if (= length 0) #{} + (labels ((get-number (acc len) + (let* ((byte (stream-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) + (multiple-value-bind (n l) (get-number 0 1) + (if head-p + (multiple-value-bind (q r) (floor n 40) + (iter (- left-length l) (cons r (cons q acc)) nil)) + (iter (- left-length l) (cons n acc) nil)))))) + (make-instance 'object-id :id (iter length nil t))))) + +(eval-when (:load-toplevel :execute) + (install-asn.1-type :object-identifier 0 0 6)) Modified: trunk/asn.1/stream-test.lisp ============================================================================== --- trunk/asn.1/stream-test.lisp (original) +++ trunk/asn.1/stream-test.lisp Fri Sep 14 05:13:38 2007 @@ -15,3 +15,10 @@ (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)) Added: trunk/asn.1/test/1.asn ============================================================================== --- (empty file) +++ trunk/asn.1/test/1.asn Fri Sep 14 05:13:38 2007 @@ -0,0 +1,4 @@ +aAAA DEFINITIONS ::= +BEGIN + bBBB +END

1 0