-
Notifications
You must be signed in to change notification settings - Fork 2
/
network.lisp
134 lines (122 loc) · 5.37 KB
/
network.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
;;;; -*- Mode: Lisp -*-
;;;; $Id$
(in-package :snmp)
;;; SOCKET-SYNC (from old USOCKET-UDP)
(defparameter *socket-sync-timeout* 2 "in seconds")
(defparameter *socket-sync-retries* 3 "in seconds")
(defun default-rtt-function (message) (values message 0))
(defun socket-sync (socket message &key
(max-receive-length +max-snmp-packet-size+)
(encode-function #'default-rtt-function)
(decode-function #'default-rtt-function)
&aux
send-seq send-data send-data-length
(send-retries *socket-sync-retries*)
recv-message recv-seq recv-data
(sockets (list socket)))
"sync messages on single socket"
(declare (type usocket:datagram-usocket socket))
;; Encode data for send
(multiple-value-setq (send-data send-seq)
(funcall encode-function message))
(setq send-data-length (length send-data))
(setq recv-data (make-array max-receive-length
:element-type '(unsigned-byte 8)
:initial-element 0))
;; Define basic network operations
(labels ((send ()
(let ((nbytes (usocket:socket-send socket send-data send-data-length)))
(unless (plusp nbytes)
(error 'snmp-error))
nbytes))
(wait ()
(multiple-value-bind (return-sockets real-time)
(usocket:wait-for-input sockets :timeout *socket-sync-timeout*)
(declare (ignore return-sockets))
real-time))
(recv ()
(multiple-value-bind (return-recv-data recv-data-length)
(usocket:socket-receive socket recv-data max-receive-length)
(declare (ignore return-recv-data))
(when (plusp recv-data-length)
(multiple-value-setq (recv-message recv-seq)
(funcall decode-function recv-data))
(= send-seq recv-seq)))))
;; Work cycles
(prog ()
:send
;; (princ "S")
(if (plusp (decf send-retries))
(unless (send) (go :exit))
(go :exit))
:wait
;; (princ "W")
(unless (wait) (go :send))
:recv
;; (princ "R")
(unless (recv) (go :wait))
:exit
;; (princ "E")
(return recv-message))))
(defun stream-session-p (session)
(declare (type session session))
(typep (socket-of session) 'usocket:stream-usocket))
(defun send-stream-message (session message receive-p)
(declare (type session session)
(type message message))
(let* ((stream (usocket:socket-stream (socket-of session)))
(data (coerce (ber-encode message) 'octets)))
(write-sequence data stream)
(finish-output stream)
(when receive-p
(decode-message session stream))))
(defgeneric send-snmp-message (session message &key &allow-other-keys))
(defmethod send-snmp-message ((session v1-session) (message v1-message) &key (receive t))
"this new send-snmp-message is just a interface,
all UDP retransmit code are moved into usocket-udp project."
(if (stream-session-p session)
(send-stream-message session message receive)
(if receive ; normal message
(flet ((encode-function (x)
(values (coerce (ber-encode x) 'octets)
(request-id-of (pdu-of x))))
(decode-function (x)
(let ((m (decode-message session x)))
(values m (request-id-of (pdu-of m))))))
(socket-sync (socket-of session) message
:encode-function #'encode-function
:decode-function #'decode-function
:max-receive-length +max-snmp-packet-size+))
;; trap message: only send once
(let* ((data (coerce (ber-encode message) 'octets))
(data-length (length data)))
(usocket:socket-send (socket-of session) data data-length)))))
(defmethod send-snmp-message ((session v3-session) (message v3-message) &key (receive t))
"this new send-snmp-message is just a interface,
all UDP retransmit code are moved into usocket-udp project."
(if (stream-session-p session)
(flet ((send () (send-stream-message session message receive)))
(let ((reply-message (send)))
(if (and receive (report-flag-of reply-message))
(send)
reply-message)))
(if receive ; normal message
(labels ((encode-function (x)
(values (coerce (ber-encode x) 'octets)
(message-id-of x)))
(decode-function (x)
(let ((m (decode-message session x)))
(values m (message-id-of m))))
(send ()
(socket-sync (socket-of session) message
:encode-function #'encode-function
:decode-function #'decode-function
:max-receive-length +max-snmp-packet-size+)))
(let ((reply-message (send)))
(if (report-flag-of reply-message)
(send) ; send again when got a snmp report
reply-message)))
;; trap message: only send once
(let* ((data (coerce (ber-encode message) 'octets))
(data-length (length data)))
(usocket:socket-send (socket-of session) data data-length)))))