REBOL [ Title: "SNMP v1 protocol" Date: 16-Dec-2001 Author: "VDemong" Email: %vdemongodin--free--fr File: %snmp.r Version: 0.8.0 Purpose: { Implementation of SNMP v1 scheme (RFC 1155,1156,1157) , no TRAP. URL is snmp://[community@]<host adr>/CMD/<id values> default community is public Where CMD is get getnext or set id values is a string like that: "1.3.6.1.2.1.1.1.0 1.3.6.1.2.1.1.5.0" Return an object: make object! [ version: 0 community: "public" request-id: 1122 error-status: 0 error-message: "NoError" error-index: 0 values: [[#1.3.6.1.2.1.1.1.0 {Hardware: x86 Family 5 Model 8 Stepping 12 AT/AT COMP ATIBLE - Software: Windows 2000 Version 5.0 (Build 2195 Uniprocessor Free)}] [#1.3.6.1. 2.1.1.5.0 "BOGOMILE"]] ] samples: p: open snmp://%public--127--0--0--1/GET/ insert p "1.3.6.1.2.1.1.5.0" rep1: copy p close p rep2: read join snmp://%public--127--0--0--1/GET/ "1.3.6.1.2.1.1.1.0 1.3.6.1.2.1.1.5.0"; rep5: read join snmp://%public--127--0--0--1/GETnext/1.3.6.1.2.1.4.21.1.1.0 adr: 172.16.1.1 while [ adr <> 172.16.1.254 ] [ error? try [ rep: read to-url rejoin [ "snmp://" adr "/GET/1.3.6.1.2.1.1.1.0 1.3.6.1.2.1.1.5.0" ] print [ "At " adr " find: " second first rep/values " : " second second rep/values ] ] adr: adr + 0.0.0.1 ] } Category: [protocol] Library: [ level: 'advanced platform: 'all type: [protocol tool] domain: [other-net protocol] tested-under: "Mac OsX" support: %vdemongodin--free--fr license: gpl see-also: none ] ] make root-protocol [ ;i pick this in mysql-protocol.r sys-copy: get in system/words 'copy sys-insert: get in system/words 'insert net-log: get in net-utils 'net-log last-snmp-id: none ; last snmp response for get-next loops (a todo work ... ) ;;;Internal object for SNMP handling decode/encoding SNMP messages SNMP-CMD: make object! [ NULL: none errors: [ "NoError" "tooBig" "noSuchName" "badValues" "readOnly" "genErr" ] ;BER decode BER-SELECT: function [ msg [ binary! ] ] [ tag ] [ if 0 = length? msg [ return sys-copy [ 0 0 ] ] tag: to-integer first msg ; GET BER id return switch tag [ 02 [ decode-integer msg ] 03 [ decode-bit-string msg ] 04 [ decode-octet-string msg ] 05 [ decode-null msg ] 06 [ decode-ob-id msg ] 48 [ decode-sequence msg ] 64 [ decode-ip msg ] 65 [ decode-counter msg ] 66 [ decode-gauge msg ] 67 [ decode-time-ticks msg ] 68 [ decode-opaque msg ] 128 [ decode-null msg ] 129 [ decode-null msg ] 130 [ decode-null msg ] ] ] ;;decode function returns a block [ length value ] ;;value: tuple! decode-ip: function [msg] [tmprsp tmpval tmpip][ tmprsp: decode-octet-string msg tmpval: second tmprsp tmpip: sys-copy [] forall tmpval [ append tmpip to-integer first tmpval ] reduce [ first tmprsp to-tuple tmpip ] ] decode-counter: func [msg][ decode-integer msg ] decode-gauge: func [msg] [ decode-integer msg ] ;;value: time! decode-time-ticks: function [msg] [tmprsp ti res][ tmprsp: decode-integer msg ti: to-time ((second tmprsp) / 100) res: join to-integer (ti/hour / 24) " day(s) " ti: to-time reduce [ (ti/hour // 24) ti/minute ti/second ] reduce [ first tmprsp join res ti ] ] ;;to test decode-opaque: function [msg] [tmpres tmpmsg] [ tmpres: decode-octet-string msg tmpmsg: BER-SELECT to-binary second tmpres reduce [ first tmpres second tmpmsg ] ] decode-null: func [msg] [ return [ 2 NULL ] ] decode-sequence: function [ msg [ binary! ] ] [sequence tmpmsg len tmplen] [ sequence: sys-copy [] tmpmsg: next msg len: decode-length tmpmsg tmplen: second len tmpmsg: skip tmpmsg first len while [ tmplen > 0 ] [ tmpres: BER-select tmpmsg append/only sequence second tmpres tmplen: tmplen - first tmpres tmpmsg: skip tmpmsg first tmpres ] reduce [ 1 + (first len) + (second len) sequence ] ] ;; value: string! decode-ob-id: function [ msg [ binary! ]] [tmpmsg len result id1 id2 acc i] [ tmpmsg: next msg len: decode-length tmpmsg tmpmsg: skip tmpmsg first len id2: (first tmpmsg) // 40 id1: to-integer ((first tmpmsg) / 40) tmpmsg: next tmpmsg tmpmsg: sys-copy/part tmpmsg -1 + second len acc: 0 result: sys-copy "" for i 1 (-1 + second len) 1 [ either 127 < tmpmsg/:i [ acc: 128 ][ append result to-string reduce [ "." (acc + tmpmsg/:i) ] acc: 0 ] ] sys-insert result to-string reduce [ id1 "." id2 ] reduce [ 1 + (first len) + (second len) result ] ] ;;value: integer! decode-integer: function [ msg [ binary! ]] [ tmpmsg ] [ tmpmsg: sys-copy/part next msg length? msg len: to-integer first tmpmsg msg: skip msg len + 1 reduce [ len + 2 to-integer sys-copy/part next tmpmsg len ] ] ;;value: string! decode-octet-string: function [ msg [ binary! ] ] [tmpmsg len str] [ tmpmsg: sys-copy next msg len: to-integer first tmpmsg either len > 128 [ use [len-len lenpart] [ len-len: len - 128 lenpart: sys-copy/part next tmpmsg len-len len: to-integer lenpart tmpmsg: skip tmpmsg len-len + 1 ] ] [ tmpmsg: next tmpmsg ] str: to-string sys-copy/part tmpmsg len tmpmsg: skip tmpmsg len reduce [ index? tmpmsg str ] ] ;;i don't care about length skip-length: function [ msg ] [len len-len] [ len: to-integer first msg either len > 128 [ len-len: len - 128 len-len + 1 ] [1] ] ;; i have care ... decode-length: function [ msg ] [len len-len] [ len: to-integer first msg either len > 128 [ len-len: len - 128 return reduce [ len-len + 1 to-integer sys-copy/part next msg len-len ] ] [ return reduce [ 1 len ] ] ] ;; build response decode-message: function [ msg [ binary! ] ] [result decode len] [ result: sys-copy [] msg: skip msg 1 ;skip sequence in front of message msg: skip msg skip-length msg decode: decode-integer msg append result reduce [ to-set-word 'version second decode ] msg: skip msg first decode decode: decode-octet-string msg append result reduce [ to-set-word 'community second decode ] msg: skip msg first decode msg: next msg msg: skip msg skip-length msg decode: decode-integer msg append result reduce [ to-set-word 'request-id second decode ] msg: skip msg first decode decode: decode-integer msg append result reduce [ to-set-word 'error-status second decode ] msg: skip msg first decode append result reduce [ to-set-word 'error-message pick errors 1 + second decode ] decode: decode-integer msg append result reduce [ to-set-word 'error-index second decode ] msg: skip msg first decode append result reduce [ to-set-word 'values second BER-SELECT msg ] return make object! result ] ;BER encode BER-length: function [ len ] [bin-len] [ net-log rejoin ["BER encode data length: " len ] bin-len: sys-copy #{} either 128 > len [ sys-insert bin-len to-char len ][ sys-insert bin-len to-char ( len // 127) sys-insert bin-len to-char to-intager ( len / 127 ) sys-insert bin-len to-char 82 ] return bin-len ] BER-IPAdr: function [ ipadr ][i tmpstr][ net-log rejoin ["BER encode ip adr: " ipadr ] tmpstr: sys-copy "" for i 1 4 1 [ append tmpstr to-char ipadr/:i ] return BER-string tmpstr ] BER-integer: function [ int ] [hex-int ber-int val] [ net-log rejoin ["BER encode integer: " int ] ber-int: sys-copy {} hex-int: to-hex int forskip hex-int 2 [ val: to-integer sys-copy/part hex-int 2 if val > 0 [ append ber-int to-char val ] ] ber-int: head ber-int ber-int: join BER-length length? ber-int ber-int sys-insert ber-int to-char 2 ; BER integer return ber-int ] BER-time: function [time-val] [ber-time hex-time][ net-log rejoin ["BER encode time: " time-val ] ber-time: sys-copy #{} hex-time: to-hex ( 100 * to-integer time-val ) forskip hext-time 2 [ val: to-integer sys-copy/part hex-int 2 if val > 0 [ append ber-time to-char val ] ] sys-insert ber-time BER-Length length? ber-time sys-insert ber-time to-char 67 ; BER time ticks id ] BER-string: function [ str ] [ber-str] [ net-log rejoin ["BER encode octet string: " str ] ber-str: sys-copy #{} sys-insert ber-str str ber-str: join BER-length length? ber-str ber-str sys-insert ber-str to-char 4 return ber-str ] BER-obj-id: function [ obj-id ] [id ber-id] [ net-log rejoin ["BER encode object id: " obj-id ] ber-id: sys-copy #{} id: parse to-string obj-id "." forall id [ sys-insert id to-integer first id remove next id ] id: head id for i 3 (length? id) 1 [ either id/:i > 127 [ append ber-id to-char 129 append ber-id to-char ( -128 + id/:i ) ][ append ber-id to-char id/:i ] ] sys-insert ber-id to-char ((40 * first id) + second id) ber-id: join BER-length (length? ber-id) ber-id sys-insert ber-id to-char 6 return ber-id ] BER-GETvarBindList: function [ objid-list ] [id-blk] [ id-blk: to-block objid-list id-blk: next id-blk forskip id-blk 2 [ sys-insert id-blk 'NULL ] sys-insert id-blk 'NULL id-blk: head id-blk return id-blk ] BER-SETvarBindList: func [ objid-list ] [ return to-block objid-list ] BER-VarBindList: function [ objid-block ] [bin-req tmp-bin typ] [ bin-req: sys-copy #{} forskip objid-block 2 [ typ: to-string type? second objid-block tmp-bin: sys-copy switch typ [ "integer" [ BER-integer second objid-block ] "tuple" [ BER-IPAdr second objid-block ] "issue" [ BER-obj-id second objid-block ] "word" [ either "NULL" = uppercase to-string second objid-block [ #{0500} ] [ BER-string to-string second objid-block ] ] "time" [ BER-time second objid-block ] ] sys-insert tmp-bin BER-obj-id first objid-block sys-insert tmp-bin BER-length length? tmp-bin sys-insert tmp-bin to-char 48 ; BER sequence ID append bin-req sys-copy tmp-bin clear tmp-bin ] sys-insert bin-req BER-length length? bin-req sys-insert bin-req to-char 48 return bin-req ] Req: function [ {build a SNMP v1 request - return binary value} community [string!] "community name" objid-block [block!] {PDU vars bind list} req-id [integer!] "request identifier" req-type "request type identifier" ] [ bin-req ] [ net-log "BUILD request" bin-req: BER-VarBindList objid-block sys-insert bin-req sys-copy #{020100020100} ; error flags sys-insert bin-req BER-integer req-id sys-insert bin-req BER-length length? bin-req sys-insert bin-req to-char req-type sys-insert bin-req BER-string community sys-insert bin-req sys-copy #{020100} ;SNMP V1 tag sys-insert bin-req BER-length length? bin-req sys-insert bin-req to-char 48 return bin-req ] ;"PUBLIC INTERFACE" Get-Request: func [ community [string!] "community name" obj-id {object identifiers eg. "1.3.6.1.1.2.1.0"} req-id [integer!] "request identifier" ][ net-log "SNMP get request" Req community (BER-GETVarBindList obj-id) req-id 160 ] Get-next-Request: func [ community [string!] "community name" obj-id {object identifiers eg. "1.3.6.1.1.2.1.0"} req-id [integer!] "request identifier" ][ net-log "SNMP getNext request" Req community (BER-GETVarBindList obj-id) req-id 161 ] Set-Request: func [ {build a SNMP v1 request - return binary value} community [string!] "community name" obj-id {object identifiers bind "1.3.6.1.1.2.1.0 <value>"} req-id [integer!] "request identifier" ][ net-log "SNMP set request" Req community (BER-SETVarBindList obj-id) req-id 163 ] ] ; protocol stuffs .... scheme: 'snmp port-id: 161 port-flags: system/standard/port-flags/pass-thru or 32 open: func [ port ] [ open-proto/sub-protocol port 'udp if none = port/user [ port/user: "public" ] if none <> port/target [ insert port port/target ] ] insert: function [ port data ] [req tmpdata] [ ;tuple are limited to length 10 ;insert a # in front then to-block read them as issue ;(see VarBindList) ;all obj id begin with 1. tmpdata: sys-copy data sys-insert tmpdata "#" replace/all tmpdata " 1." " #1." net-log "INSERT data" str-path: uppercase to-string port/path switch/default str-path [ "GET/" [ req: SNMP-CMD/get-request port/user tmpdata to-integer now/time write-io port/sub-port req length? req ] "GETNEXT/" [ req: SNMP-CMD/get-next-request port/user tmpdata to-integer now/time write-io port/sub-port req length? req ] "SET/" [ req: SNMP-CMD/set-request port/user tmpdata to-integer now/time write-io port/sub-port req length? req ] ][ net-error reform [ str-path " is an invalid SNMP command"] ] ] copy: function [ port ] [ buffer length ] [ buffer: make binary! 1000 until [ length: read-io port/sub-port buffer 1000 ( length <= 1000 ) ] net-log rejoin ["COPY read " length? buffer " byte(s)"] SNMP-CMD/decode-message buffer ] read: func [port] [ net-log "READ port" insert port port/target ] net-utils/net-install 'snmp self 161 ]