/
bind.lisp
293 lines (244 loc) · 9.69 KB
/
bind.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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
;;;; Copyright (c) Frank James 2016 <frank.a.james@gmail.com>
;;;; This code is licensed under the MIT license.
(in-package #:frpc2)
;; This defines a client interface for portmapper (rpcbind version 2).
(defxenum mapping-protocol ()
(:udp 17)
(:tcp 6))
(defxstruct mapping ()
(program :uint32)
(version :uint32)
(protocol mapping-protocol)
(port :uint32))
(defxlist mapping-list () mapping)
(defxoptional mapping-list-opt () mapping-list)
(defxstruct callit-arg ()
(program :uint32)
(version :uint32)
(proc :uint32)
(args :opaque*))
(defxstruct callit-res ((:mode :list))
(port :uint32)
(res :opaque*))
;; (defun decode-callit-res-unwrapped (blk res-decoder)
;; (let ((cres (decode-callit-res blk)))
;; (destructuring-bind (port (buff start end)) cres
;; (let ((rblk (make-xdr-block :buffer buffer :offset start :count end)))
;; (list port (funcall res-decoder rblk))))))
(defconstant +rpcbind-program+ 100000)
(defconstant +rpcbind-version+ 2)
(define-rpc-client rpcbind (+rpcbind-program+ +rpcbind-version+)
(null :void :void)
(set mapping :boolean)
(unset mapping :boolean)
(getport mapping :uint32)
(dump :void mapping-list-opt)
(callit% callit-arg callit-res))
;; define a somewhat nicer wrapping function for CALLIT
(defun call-rpcbind-callit (client arg-encoder arg res-decoder program version proc)
"Execute an RPC on the remote machine, proxyinb the call via the
rpcbind service.
CLIENT ::= rpc client to send the call with.
ARG-ENCODER ::= DrX XDR encoder function.
ARG ::= value to pass to ARG-ENCODER.
RES-DECODER ::= DrX XDR decoder function.
PROGRAM, VERSION, PROC ::= the procedure to invoke.
This function makes it possible to call a procedure without knowing the port
number to contact the program on (or even if the program exists). Its primary
use is to broadcast calls on the local network, facilitating
e.g. service discovery.
The rpcbind service is silent if an error occurs.
The RPC is invoked on the remote host using the UDP protocol.
No authentication is possible."
(let ((blk (xdr-block (* 8 1024))))
;; encode the argument data
(funcall arg-encoder blk arg)
(let ((carg (make-callit-arg :program program
:version version
:proc proc
:args (list (xdr-block-buffer blk)
0
(xdr-block-offset blk)))))
(let ((results (call-rpcbind-callit% client carg)))
(flet ((decode-result (res)
(destructuring-bind (port (buff start end)) res
(let ((blk (make-xdr-block :buffer buff
:offset start
:count end)))
(list port (funcall res-decoder blk))))))
(if (typep client 'broadcast-client)
;; broadcast clients return a list of (reply-addres result)*
(mapcar (lambda (r)
(destructuring-bind (raddr res) r
(list raddr (decode-result res))))
results)
;; everything else just returns result
(decode-result results)))))))
(defconstant +rpcbind-port+ 111)
(defun resolve-addr (host)
(or (first (dns:get-host-by-name host))
(error "Couldn't resolve host <~A>" host)))
(defun get-rpc-address (program version &optional host (protocol :udp))
"Get the address to contact a specified program by contacting the rpcbind service.
PROGRAM, VERSION ::= integers specifying the program and version.
ADDR ::= if supplied should be a vector of 4 octets specifying the internet address of the host.
PROTOCOL ::= the desired protocol to contact, either :UDP or :TCP.
Returns an FSOCKET:SOCKADDR-IN address."
(declare (type integer program version)
(type (member :udp :tcp) protocol))
(let ((sin (fsocket:sockaddr-in (resolve-addr (or host #(127 0 0 1))) +rpcbind-port+)))
(with-rpc-client (c udp-client :addr sin)
(let ((port (call-rpcbind-getport c
(make-mapping :program program
:version version
:protocol protocol
:port 0))))
(if (zerop port)
(error 'accept-error :stat :prog-unavail)
(fsocket:sockaddr-in (fsocket:sockaddr-in-addr sin)
port))))))
(defun bind-udp-client (client program version &optional host)
"Bind a UDP client to the address for the specified program. Contacts
the hosts rpcbind service to discover the port number.
CLIENT ::= an instance of UDP-CLIENT.
PROGRAM, VERSION ::= integers specifying the program and version numbers.
HOST ::= a host specifier. Either a SOCKADDR-IN, a 4-octet vector,
a dotted quad string or a string representing the hostname. In the later
case a DNS resolver is used to resolve the internet address.
"
(declare (type udp-client client)
(type integer program version))
(let ((addr (get-rpc-address program version host)))
(setf (udp-client-addr client) addr)
addr))
(defun get-rpc-programs (&optional host)
"Contact the RPCBIND service to get a list of program mappings.
HOST ::= Host specifier, either dotted quad string, sockaddr-in or inaddr. Should be
acceptable input for DRAGONS:GET-HOST-BY-NAME.
Returns a list of MAPPING structures."
(let ((sin (fsocket:sockaddr-in (resolve-addr host) +rpcbind-port+)))
(with-rpc-client (c udp-client :addr sin)
(call-rpcbind-dump c))))
(defun get-rpc-hosts (&optional program version protocol broadcast-address)
"Find a list of hosts for the specified program by broadcasting
to the rpcbind service.
PROGRAM, VERSION ::= integers specifying the program to search for.
PROTOCOL ::= The protocol you wish to contact the service on,
either :UDP or :TCP. Defaults to :UDP.
BROADCAST-ADDRESS ::= Explicitly provide broadcast address.
If not provided will attempt to discover hosts on all broadcast addresses
listed by fsocket:list-adapters.
Returns a list of SOCKADDR-IN structs for each host which is
advertised as available on the local network."
(let ((brd-addrs (if broadcast-address
(list broadcast-address)
(or (mapcan (lambda (ad)
(mapcar #'fsocket:sockaddr-in-addr (fsocket:adapter-broadcast ad)))
(fsocket:list-adapters))
(list #(255 255 255 255)))))
(results nil))
(with-rpc-client (c broadcast-client)
(dolist (brd-addr brd-addrs)
;; set the client sending address explicitly
(setf (udp-client-addr c)
(fsocket:sockaddr-in brd-addr +rpcbind-port+))
(cond
((and program version)
(dolist (r (call-rpcbind-getport c
(make-mapping :program program
:version version
:protocol (or protocol :udp)
:port 0)))
(destructuring-bind (raddr port) r
(unless (zerop port)
(setf (fsocket:sockaddr-in-port raddr) port)
(pushnew raddr results
:key #'fsocket:sockaddr-in-addr
:test #'equalp)))))
(t
(dolist (r (call-rpcbind-null c))
(pushnew (car r) results
:key #'fsocket:sockaddr-in-addr
:test #'equalp))))))
results))
;; ------------- RPCBIND versions 3 and 4 -------------------
;; (defxstruct binding ()
;; (program :uint32)
;; (version :uint32)
;; (netid :string)
;; (addr :string)
;; (owner :string))
;; (defxlist binding-list () binding)
;; (defxoptional binding-list-opt () binding-list)
;; (defxstruct remote-call-arg ()
;; (program :uint32)
;; (version :uint32)
;; (proc :uint32)
;; (args (:varray* :octet)))
;; (defxstruct remote-call-res ()
;; (addr :string)
;; (result :opaque*))
;; (defxstruct bind-entry ()
;; (maddr :string)
;; (netid :string)
;; (semantics :uint32)
;; (family :string) ;; protocol family
;; (proto :string))
;; (defxlist bind-entry-list () bind-entry)
;; (defxoptional bind-entry-list-opt () bind-entry-list)
;; (defxstruct bind-addr ()
;; (program :uint32)
;; (version :uint32)
;; (success :int32)
;; (failure :int32)
;; (netid :string))
;; (defxlist bind-addr-list () bind-addr)
;; (defxoptional bind-addr-list-opt () bind-addr-list)
;; (defxstruct remote-call ()
;; (program :uint32)
;; (version :uint32)
;; (proc :uint32)
;; (success :int32)
;; (failure :int32)
;; (indirect :int32)
;; (netid :string))
;; (defxlist remote-call-list () remote-call)
;; (defxoptional remote-call-list-opt () remote-call-list)
;; (defconstant +bind-highproc+ 13)
;; (defxarray bind-proc () :uint32 +bind-highproc+)
;; (defxoptional addrinfo-opt () addr-list)
;; (defxstruct bind-stat ()
;; (info bind-proc)
;; (setinfo :int32)
;; (unsetinfo :int32)
;; (addrinfo addrinfo-opt)
;; (rmtinfo remote-call-list-opt))
;; (defconstant +bind-vers-stat+ 3)
;; (defxarray stat-by-vers () bind-stat +bind-vers-stat+)
;; (defxstruct netbuf ()
;; (maxlen :uint32)
;; (data :opaque*))
;; (define-rpc-interface rpcbind3 (+rpcbind-program+ 3)
;; (null :void :void)
;; (set binding :boolean)
;; (unset binding :boolean)
;; (getaddr binding :string)
;; (dump :void binding-list-opt)
;; (broadcast remote-call-args remote-call-res)
;; (gettime :void :uint32)
;; (uaddr2taddr :string netbuf)
;; (taddr2uaddr netebuf :string))
;; (define-rpc-interface rpcbind4 (+rpcbind-program+ 4)
;; (null :void :void)
;; (set binding :boolean)
;; (unset binding :boolean)
;; (getaddr binding :string)
;; (dump :void binding-list-opt)
;; (broadcast remote-call-args remote-call-res)
;; (gettime :void :uint32)
;; (uaddr2taddr :string netbuf)
;; (taddr2uaddr netebuf :string)
;; (versionaddr binding :string)
;; (indirect remote-call-args remote-call-res)
;; (addrlist binding entry-list-opt)
;; (getstat :void stat-by-vers))