Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 909 lines (704 sloc) 35.988 kB
6a7b76a @lisp external build, take 1
authored
1 ;;; -*- Package: de.setf.amqp.implementation; -*-
2
3 (in-package :de.setf.amqp.implementation)
4
c2728ca @lisp renaming protocol directories, phase one
authored
5 (:documentation "This file defines the protocol operators for AMQP `class` and `METHOD` entities for the
6 'de.setf.amqp' library."
6a7b76a @lisp external build, take 1
authored
7 (copyright
8 "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
9 "'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
10 of the GNU Affero General Public License as published by the Free Software Foundation.
11
12 'setf.amqp' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
13 implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14 See the Affero General Public License for more details.
15
16 A copy of the GNU Affero General Public License should be included with 'de.setf.amqp' as `AMQP:agpl.txt`.
17 If not, see the GNU [site](http://www.gnu.org/licenses/).")
18
19 (long-description "Each (object . method) combination corresponds to several operators, which act in concert
20 to implement the protocol:
21
22 - `respond-to-_method_` peforms the command on a client object in response to a broker message.
23 This includes changes to instance state, open/close side effects for `connection` and `channel` methods,
24 instantiating and binding, or releasing any related, as well as any requisite broker message responses
25 as confirmation or as further processing.
26
27 - `request-_method_` issues the request to the broker, together with any client object operations
28 required by the protocol.
29
30 - `send-_method_` encodes frames and performs transport-level operations to send the command to
31 the broker. This delegates to protocol-specific methods, which encode the respective arguments, and to
32 the network device operations for the network stream functions.
33
34 - no explicit receive operators are defined, as messages are self-describing and decoded accordingly.
35 Application code is writtein in terms of `command-case` or `command-loop` statements which dispatch based
36 on received commands type.
37
38 The `def-amqp-command` forms below define the protocol class and the generic method operators.
39 The `:response` and `:request` clauses include methods as appropriate to whether both the broker and
40 the client implement the operation. A `:request` clause automatically defined a `send-` operators.
41 An additional (possibly blank) `:send` clause can be included if sending must be supported in addition to
42 a complete command request.
43
44 The respective respond-to and and request operators are implemented in two layers.
45 The interface operator, which uses the elementary name, is implemented in terms of a second
46 operator: `channel-respond-to-`, or `channel-request-`, which requires an additional initial argument,
47 the `channel`. The delegation call interposes the respective `objects-channel` value as this initial
48 argument. The specialized methods are defined with `amqp:channel` as the initial specialization.
49
50 The interface architecture makes it possible for applications to alter the api behavior by specializing
51 just the channel, just the protocol class, or both."))
52
53
54
55
874ada0 @lisp more changes to sbcl simple streams; support basic headers in publish
authored
56 (defun response-function (name)
b20e82d @lisp continued corrections plus adjustments to rabbotmq for 0.9.1
authored
57 "For use as the initform for method response functions, if the target is defined, ok. Otherwise use instead
58 the default response function, which signals an error."
874ada0 @lisp more changes to sbcl simple streams; support basic headers in publish
authored
59 (if (fboundp name)
60 name
61 #'(lambda (class &rest args) (apply #'default-channel-respond-to class name args))))
6a7b76a @lisp external build, take 1
authored
62
63
64 (defgeneric default-channel-respond-to
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
65 (channel class &rest args)
6a7b76a @lisp external build, take 1
authored
66 (:documentation "the base protocol response operator for alert.")
67 (:method :before ((channel t) (class t) &rest args) "a before method logs the response-to-be and updates the class instance."
68 (declare (dynamic-extent args))
69 (amqp:log* default-channel-respond-to class args))
70 (:method ((channel amqp:channel) (class t) &rest args)
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
71 (amqp:not-implemented-error :message-string "Unimplemented method: ~s . ~s"
63d9977 @lisp add a method to the default channel command processing to map an unha…
authored
72 :message-arguments (list class args)))
73 (:method ((channel amqp:channel) (class (eql 'amqp::channel-respond-to-close)) &rest args)
74 "the default method for an unhandled close signals end-of-file"
75 (declare (ignore args))
76 (error 'end-of-file :stream channel)))
6a7b76a @lisp external build, take 1
authored
77
78
79 (def-amqp-command amqp:ack (class &key delivery-tag multiple)
80 (:documentation "C-->S : acknowledge one of more messages")
81
82 (:request
83 (:method ((class amqp::basic) &rest args &key delivery-tag multiple)
84 (declare (ignore delivery-tag multiple))
85 (apply #'amqp:send-ack class args)
86 class)
87
88 (:method ((class amqp::file) &rest args &key delivery-tag multiple)
89 (declare (ignore delivery-tag multiple))
90 (apply #'amqp:send-ack class args)
91 class)))
92
93
94 (def-amqp-command amqp:alert (class &key reply-code reply-text details)
95 (:documentation "C<--S : send a non-fatal warning message : Async , carries content ")
96
97 (:response
98 (:method ((class amqp::channel) &rest args)
99 (declare (ignore args))
100 "Do nothing more than log the message."
101 class)))
102
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
103 ;; 20110402 lw required the -ok be defined before the typecase refrence
104 (def-amqp-command amqp:bind-ok (class &key)
105 (:documentation "C<--S : Confirm bind successful.
106 This command appears as eventual response to a Bind, and should be processed
107 synchronously by a request-bind. If one appears independently, log it.
108 and continue.")
109
110 (:response
111 (:method ((queue amqp:queue) &key)
112 "Simply log and continue."
113 queue)))
114
6a7b76a @lisp external build, take 1
authored
115
116 (def-amqp-command amqp:bind (class &key ticket queue exchange routing-key no-wait arguments)
117 (:documentation "C-->S: Bind queue to an exchange")
118
119 (:request
120 (:method ((queue-class amqp::queue) &rest args &key ticket queue exchange routing-key no-wait arguments)
121 (declare (dynamic-extent args))
122
123 (assert-argument-types amqp:bind
124 (ticket integer nil)
125 (queue (or string amqp:queue))
126 (exchange (or string amqp:exchange))
127 (routing-key string nil)
128 (no-wait amqp:bit nil)
129 (arguments list nil))
130
131 (setf exchange (amqp:exchange-exchange exchange))
132 (setf queue (amqp:queue-queue queue))
133
134 (apply #'amqp::send-bind queue-class :exchange exchange :queue queue
135 args)
136 (command-loop (queue-class)
e5f8e5b @lisp readme build notes, rearrangements to reconcile runtimes
authored
137 (amqp:bind-ok (queue)
6a7b76a @lisp external build, take 1
authored
138 (amqp:log :debug queue "bound.")
139 (return-from command-loop))
140 (t
141 (class &rest args)
142 (amqp:log :warn class "Unexpected response: ~s . ~s" class args)
143 (return-from command-loop)))
144 queue-class)))
145
146
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
147 ;; 20110402 lw required the -ok be defined before the typecase refrence
148 (def-amqp-command amqp:cancel-ok (class &key consumer-tag)
149 (:documentation "C<--S : confirm a canceled consumer.
150 This command appears as eventual response to Cancel and should be processed
151 synchronously by a request-cancel. If one appears independently, log it.
6a7b76a @lisp external build, take 1
authored
152 and continue.")
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
153
6a7b76a @lisp external build, take 1
authored
154 (:response
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
155 (:method ((basic amqp::basic) &key consumer-tag)
156 (declare (ignore consumer-tag))
6a7b76a @lisp external build, take 1
authored
157 "Simply log and continue."
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
158 basic)))
6a7b76a @lisp external build, take 1
authored
159
160
161 (def-amqp-command amqp:cancel (class &rest args &key consumer-tag no-wait)
162 (:documentation "C-->S :
163 This method cancels a consumer. This does not affect already delivered messages, but it does mean the
164 server will not send any more messages for that consumer. The client may receive an arbitrary number of
165 messages in between sending the cancel method and receiving the cancel-ok reply.")
166
167 (:request
168 (:method ((basic amqp::basic) &rest args &key consumer-tag no-wait)
169 (declare (dynamic-extent args))
170 (assert-argument-types amqp:cancel
171 (consumer-tag (amqp:string 8) nil)
172 (no-wait amqp:bit nil))
173
174 (apply #'amqp:send-cancel basic args)
175
176 (command-loop (basic)
177 ;; skip everything except the -ok
444bb59 @lisp record and return consumer tag for use with later cancel
authored
178 (amqp:cancel-ok ((class amqp:basic) &key consumer-tag)
179 (amqp:log :debug class "cancel ok: ~s" consumer-tag)
180 ;; once the request is acknowledged, return the consumer tag
181 (return-from command-loop consumer-tag))
6a7b76a @lisp external build, take 1
authored
182 (amqp:header (frame) t)
444bb59 @lisp record and return consumer tag for use with later cancel
authored
183 (amqp:body (frame) t)))))
6a7b76a @lisp external build, take 1
authored
184
185
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
186 ;; 20110402 lw required the -ok be defined before the typecase refrence
187 (def-amqp-command amqp:close-ok (class &key)
188 (:documentation "C<->S : confirm a channel or connection close close : Sync response to Close.
189 This command appears as the eventual response to Cancel and should be processes
190 synchronously together with that. I one appears independently, ignore it.")
191
192 (:request
193 (:method ((class amqp:connection) &key)
194 (amqp::send-close-ok class)
195 class)
196
197 (:method ((class amqp:channel) &key)
198 (amqp::send-close-ok class)
199 class))
6a7b76a @lisp external build, take 1
authored
200
201 (:response
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
202 (:method ((class amqp:connection) &key)
203 class)
204
205 (:method ((class amqp:channel) &key)
206 class)))
6a7b76a @lisp external build, take 1
authored
207
208
209 (def-amqp-command amqp:close (class &key reply-code reply-text class-id method-id)
210 (:documentation "C<->S : request a connection or a channel close")
211
212 (:request
213 (:method ((channel amqp:channel) &key (reply-code 0) (reply-text "") (class-id 0) (method-id 0))
214 "Perform a local channel close and forward the reauest to the broker.
215 Invoked ambivalently with close->device-close. The channel
216 state indicates the progress: if it's :close-channel, then the stream close is
217 in progress. stream close after the protocol close. The broker request
218 entails a synchronous close-ok response."
219
220 (let ((initial-state (shiftf (channel-state channel) amqp.s:close-channel)))
221 (etypecase initial-state
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
222 ((or amqp.s:use-channel amqp.s:close-channel)
6a7b76a @lisp external build, take 1
authored
223 (when (connected-channel-p channel)
224 (amqp::send-close channel
225 :reply-code reply-code
226 :reply-text reply-text
227 :class-id class-id
228 :method-id method-id)
229 (command-loop (channel)
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
230 (amqp:header (basic &rest args)
231 (declare (dynamic-extent args))
232 (amqp:log :debug basic "Draining closed channel: ~s . ~s" basic args)
233 nil)
234 (amqp:body (basic &rest args)
235 (declare (dynamic-extent args))
236 (amqp:log :debug basic "Draining closed channel: ~s . ~s" basic args)
237 nil)
238 (amqp:close-ok (channel &key &allow-other-keys) (return-from command-loop)))
239
240 ;; once the channel is flushed, close the stream if that's not already in progress
6a7b76a @lisp external build, take 1
authored
241 (unless (typep initial-state 'amqp.s:close-channel)
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
242 (device-close channel nil)))))
6a7b76a @lisp external build, take 1
authored
243 channel))
244
245 (:method ((connection amqp:connection) &key (reply-code 0) (reply-text "")
246 (class-id (amqp:class-id connection))
247 (method-id 0))
248 "Perform a local connection close and forward the request to the broker.
249 Then close the local stream."
250
251 (let ((initial-state (shiftf (connection-state connection) amqp.s:close-connection)))
252 (etypecase initial-state
253 ;; if in use, or closing due to stream close, then send the close, and
254 ;; check whether to close the stream.
255 ((or amqp.s:use-connection amqp.s:close-connection)
256 (amqp::send-close connection
257 :reply-code reply-code
258 :reply-text reply-text
259 :class-id class-id
260 :method-id method-id)
261
262 (command-loop ((connection.channel connection :number 0))
263 (amqp:close-ok (connection) (return-from command-loop)))
264
265 ;; once the connection is flushed, if the initial state was in use, close the stream
266 (typecase initial-state
267 (amqp.s:use-connection
268 (close connection)
269 ;; once it has been closed, reset to the initial state
270 (setf (connection-state connection) amqp.s:open-connection))))
271 ;; if, eg. already closing, do nothing
272 (amqp.s:connection-state ))
273 connection)))
274
275 (:response
276 (:method ((channel amqp:channel) &key &allow-other-keys)
277 "Perform a remotely requested on the channel by sending the ok to the server and
278 disconnecting and closing the local stream."
279
280 (when (connected-channel-p channel)
281 (amqp::send-close-ok channel)
282
283 ;; disconnect it and close the stream
284 (disconnect-channel (channel-connection channel) channel)
285 (close channel)
286 channel))
287
288 (:method ((connection amqp:connection) &key reply-code reply-text class-id method-id)
289 "Perform a remotely requested connection close by sending the ok to the server and
290 closing the local stream."
291 (declare (ignore reply-code reply-text class-id method-id))
292
293 (when (open-stream-p connection)
294 (amqp::send-close-ok connection)
295
296 ;; once the response is sent, close the stream
297 (close connection))
298 connection)))
299
300
301 (def-amqp-command amqp:commit (class &key)
302 (:documentation "C-->S : Commit the current transaction.")
303
304 (:request
305 (:method ((tx amqp:tx) &key)
306 "Send the command and wait for the response."
307
308 (amqp::send-commit tx)
309 (command-loop (tx)
310 (amqp:commit-ok (class) (return-from command-loop))))))
311
312
313 (def-amqp-command amqp:commit-ok (class &key)
314 (:documentation "C<--S : Confirm a transaction as a syncronous response to Commit
315 This command appears as eventual response to Commit and should be processed
316 synchronously together with that. I one appears independently, ignore it.")
317
318 (:response
319 (:method ((tx amqp:tx) &key)
320 tx)))
321
322
323 (def-amqp-command amqp:consume (class &key queue consumer-tag no-local no-ack exclusive no-wait arguments)
324 (:documentation "C-->S : Create a consumer for a given queue.
325
326 CLASS : amqp:basic : a basic class instance bound to a channel.
327
328 The passed basic instance mediates a consume request on the channel and is
329 returned as a handle to mediate responses. In a synchronous application,
330 the channel owner can proceed directly to process deliver replies. In an
331 event-driven application, the owner can register a handler for future
332 deliver commands and process them either as polled or asynchronous events.")
333
334 (:request
fd51e77 @lisp additions and corrections in connection with spocq sae development.
authored
335 (:method ((queue amqp:queue) &rest args)
336 (declare (dynamic-extent args))
337 (let ((channel (queue-channel queue)))
338 (apply #'channel-request-consume channel (amqp:channel.basic channel)
339 :queue queue
340 args)))
341
6a7b76a @lisp external build, take 1
authored
342 (:method ((basic amqp:basic) &rest args &key queue consumer-tag no-local no-ack exclusive no-wait arguments)
343 (declare (dynamic-extent args))
344
345 (assert-argument-types amqp:consume
346 (queue (or (amqp:string 8) amqp:queue))
347 (consumer-tag (amqp:string 8) nil)
348 (no-local amqp:bit nil)
349 (no-ack amqp:bit nil)
350 (exclusive amqp:bit nil)
351 (no-wait amqp:bit nil)
352 (arguments list nil))
353
354 (setf queue (amqp:queue-queue queue))
355 (apply #'amqp::send-consume basic :queue queue args)
356
357 (command-loop (basic)
358 (amqp:consume-ok ((class amqp:basic) &key consumer-tag)
359 (amqp:log :debug class "consume ok: ~s" consumer-tag)
444bb59 @lisp record and return consumer tag for use with later cancel
authored
360 (setf (amqp:basic-consumer-tag basic) consumer-tag)
6dea972 @lisp correct deliver and consume to record no-ack setting and use it to ac…
authored
361 (setf (channel-acknowledge-messages (object-channel basic)) (not no-ack))
444bb59 @lisp record and return consumer tag for use with later cancel
authored
362 ;; once the request is acknowledged, return the consumer tag
363 (return-from command-loop consumer-tag))))))
6a7b76a @lisp external build, take 1
authored
364
365
366 (def-amqp-command amqp:consume-ok (class &key consumer-tag)
367 (:documentation "C<--S : Confirm a consume. Sync response to Commit
368 This command appears as eventual response to Consume and should be processed
369 synchronously together with that. If one appears independently, ignore it.")
370
371 (:response
372 (:method ((basic amqp:basic) &key consumer-tag)
373 (declare (ignore consumer-tag))
374 basic)))
375
376
377 (def-amqp-command amqp:declare (class &key ticket queue exchange passive durable exclusive auto-delete no-wait arguments
378 type)
379 (:documentation "C-->S : Request the broker to declare an exchange or a queue,
380 and create it if needed.")
381
382 (:request
383 (:method ((exchange amqp:exchange) &rest args)
384 (declare (dynamic-extent args))
385 (apply #'amqp::send-declare exchange args)
386 (command-loop (exchange)
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
387 (amqp:declare-ok ((class amqp:exchange) &key ) (return-from command-loop)))
6a7b76a @lisp external build, take 1
authored
388 exchange)
389
390 (:method ((queue amqp:queue) &rest args)
391 (apply #'amqp::send-declare queue args)
392 (command-loop (queue)
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
393 (amqp:declare-ok ((class amqp:queue) &key queue message-count consumer-count)
6a7b76a @lisp external build, take 1
authored
394 (amqp:log :debug queue "queue declared: ~a ~a ~a" queue message-count consumer-count)
395 (return-from command-loop)))
396 queue)))
397
398
b20e82d @lisp continued corrections plus adjustments to rabbotmq for 0.9.1
authored
399 (def-amqp-command amqp:declare-ok (class &key queue message-count consumer-count)
6a7b76a @lisp external build, take 1
authored
400 (:documentation "C<--S : Confirm a declare. Sync response to Declare.
401 This command appears as eventual response to Declare and should be processed
402 synchronously together with that. I one appears independently, ignore it.")
403
404 (:response
405 (:method ((class amqp:object) &rest args)
406 (declare (dynamic-extent args) (ignore args))
407 class)))
408
409
410 (def-amqp-command amqp:Delete (class &key queue if-unused if-empty)
411 (:documentation "C-->S : ")
412
413 (:request
414 (:method ((exchange amqp:exchange) &rest args)
415 (declare (dynamic-extent args))
416 (apply #'amqp::send-delete exchange args)
417 (command-loop (exchange)
418 (amqp:delete-ok (class) (return-from command-loop)))
419 exchange)
420
421 (:method ((queue amqp:queue) &rest args)
422 (declare (dynamic-extent args))
423 (apply #'amqp::send-declare queue args)
424 (command-loop (queue)
425 (amqp:declare-ok (class) (return-from command-loop)))
426 queue)))
427
428
429 (def-amqp-command amqp:delete-ok (class &key queue message-count)
430 (:documentation "C<--S : ")
431
432 (:response
433 (:method ((class amqp:object) &rest args)
434 (declare (dynamic-extent args) (ignore args))
435 class)))
436
437
fd51e77 @lisp additions and corrections in connection with spocq sae development.
authored
438 (def-amqp-command amqp:deliver (class &key body consumer-tag delivery-tag redelivered exchange routing-key)
6a7b76a @lisp external build, take 1
authored
439 (:documentation "C<--S : notify a client of an incoming consumer message.
440 CLASS : The client class to which the message is being delivered.
441 A read frame generates an immediate basic instance, which then delegates
442 further processing based on the connection's mode:
443 :queue causes the entire message to be read and enqueued as a raw sequence
444 :stream causes the connection/channel to be placed in content mode to, with
445 adjustments to stream parameters for future reading.")
446
447 (:response
6dea972 @lisp correct deliver and consume to record no-ack setting and use it to ac…
authored
448 (:method ((basic amqp:basic) &rest args &key delivery-tag &allow-other-keys)
6a7b76a @lisp external build, take 1
authored
449 (declare (dynamic-extent args))
450 (let ((channel (object-channel basic)))
aa0cd0d @lisp always set the delivery tag to allow app to do the ack.
authored
451 ;; save the tag for eventual acknowledgment - either by app or below
452 (setf (amqp:basic-delivery-tag basic) delivery-tag)
8e4f674 @lisp ... change amqp:deliver to return verbatim the values of a an op pass…
authored
453 (multiple-value-prog1 (apply #'device-read-content channel args)
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
454 (when (and (channel-acknowledge-messages channel)
aa0cd0d @lisp always set the delivery tag to allow app to do the ack.
authored
455 ;; in case the ack was managed elsewhere, test
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
456 (eql (amqp:basic-delivery-tag basic) delivery-tag))
aa0cd0d @lisp always set the delivery tag to allow app to do the ack.
authored
457 ;; then, set the tag to zero
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
458 (setf (amqp:basic-delivery-tag basic) 0)
6dea972 @lisp correct deliver and consume to record no-ack setting and use it to ac…
authored
459 (amqp::send-ack basic :delivery-tag delivery-tag)))))))
6a7b76a @lisp external build, take 1
authored
460
461
f5a8560 @lisp lw additions; record delivery tag in basic for later use to ack message
authored
462
6a7b76a @lisp external build, take 1
authored
463 (def-amqp-command amqp:Flow (class &key active)
464 (:documentation "C<->S : enable/disable flow from peer : Sync request ")
465
466 (:response
467 (:method ((channel amqp:channel) &key active)
468
469 (amqp::send-flow-ok channel :active active)
470 (ecase active
471 (0 (signal (channel-condition channel 'channel-flow-stop-condition)))
472 (1 (signal (channel-condition channel 'channel-flow-start-condition))))))
473
474 (:request
475 (:method ((channel amqp:channel) &key active)
476 (amqp::send-flow channel :active active)
477 ;; what happens now? the flow-ok appears in the content stream?
478 channel)))
479
480
481 (def-amqp-command amqp:Flow-Ok (class &key active)
482 (:documentation "C<->S : confirm a flow method : Async response to Flow
483 This command appears as eventual response to Flow and should be processed
484 synchronously together with that. I one appears independently, ignore it.")
485
486 (:response
487 (:method ((class amqp:channel) &key active)
488 (declare (ignore active))
489 class))
490
491 (:send )) ; needed for the send rsponse
492
493
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
494 (def-amqp-command amqp:get (object &key queue no-ack body)
495 (:documentation "C-->S : C:GET ( S:GET-OK content / S:GET-EMPTY )
496 Request the 'next' message for the given queue.
497 OBJECT : (or amqp:channel amqp:basic amqp:queue) : designates the queue
498
499 Resolves the given object to the queue and encodes a Basic.Get with the appropriate arguments.
500 Processes the responses get-ok and get-empty. If the reply is -ok invoke `device-read-content`
501 and return the result. If -empty, return nil.")
6a7b76a @lisp external build, take 1
authored
502
503 (:request
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
504 (:method ((channel amqp:channel) &rest args)
505 (declare (dynamic-extent args))
506 (apply #'channel-request-get channel (amqp:channel.basic channel) args))
507
508 (:method ((channel amqp:queue) &rest args &key queue no-ack body)
509 (declare (dynamic-extent args) (ignore no-ack body))
fd51e77 @lisp additions and corrections in connection with spocq sae development.
authored
510 ;;;??? should better use the queues own channel?
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
511 (apply #'channel-request-get amqp:channel (amqp:channel.basic amqp:channel)
512 :queue queue
513 args))
514
515 (:method ((basic amqp:basic) &rest args &key queue no-ack (body nil body-s))
6a7b76a @lisp external build, take 1
authored
516 (declare (dynamic-extent args))
517 (assert-argument-type amqp:get queue (or string amqp:queue))
518 (setf queue (amqp:queue-queue queue))
519 (setf (channel-acknowledge-messages (object-channel basic)) (not no-ack))
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
520 (when body-s
521 (setf args (copy-list args))
522 (remf args :body))
6a7b76a @lisp external build, take 1
authored
523 (apply #'amqp::send-get basic :queue queue args)
524
525 (command-case (basic)
526 (amqp:get-empty ((basic amqp:basic) &rest get-empty-args)
527 (declare (dynamic-extent get-empty-args))
528 (amqp:log :debug basic "respond-to-get, get-empty: ~s" get-empty-args)
529 (return-from command-case nil))
530 (amqp:get-ok ((basic amqp:basic) &rest get-ok-args
531 &key delivery-tag redelivered exchange routing-key message-count)
532 (declare (dynamic-extent get-ok-args)
533 (ignore redelivered exchange routing-key message-count))
534 (amqp:log :debug basic "respond-to-get, get-ok: ~s" get-ok-args)
535 (let ((channel (object-channel basic)))
536 (return-from command-case
d772d24 @lisp changes to streamed framing to eliminate extra messages
authored
537 (multiple-value-prog1 (values (apply #'device-read-content channel :body body get-ok-args)
538 (amqp:basic-headers basic))
6a7b76a @lisp external build, take 1
authored
539 (unless (amqp:basic-no-ack basic)
540 (amqp::send-ack basic :delivery-tag delivery-tag))))))))))
541
542
543 (def-amqp-command amqp:get-ok (class &key delivery-tag redelivered exchange routing-key message-count)
544 (:documentation "C<--S : provide client with a message")
545
546 (:response
547 (:method ((basic amqp:basic) &rest args)
548 (declare (dynamic-extent args))
549 (let ((channel (object-channel basic)))
550 ;;; nb. do not ack a get-ok
d772d24 @lisp changes to streamed framing to eliminate extra messages
authored
551 (apply #'device-read-content channel args)))))
6a7b76a @lisp external build, take 1
authored
552
553
554 (def-amqp-command amqp:Get-Empty (class &key)
555 (:documentation "C<--S : indicate no message available")
556
557 (:response
558 (:method ((basic amqp:basic) &key)
559 nil)))
560
561
562 (def-amqp-command amqp:open (class &key virtual-host)
563 (:documentation "C-->S : open a connection or channel for use : Sync request , carries content.
564 If on a connection, it specifies the virtual host name. On a channel, the id is in the header.")
565
566 (:request
567 (:method ((class amqp:connection) &rest args
568 &key virtual-host &allow-other-keys)
569 "Set-Up the connection for a given virutal host"
570 (declare (dynamic-extent args))
571 (assert (stringp virtual-host) ()
572 "The required virtual-host must be a string: ~s" virtual-host)
573 (apply #'amqp::send-open class args)
574 (command-loop (class)
bbae9ab @lisp rabbitmq interoperability: framing independent of protocol version, c…
authored
575 (amqp:open-ok (class &rest args)
576 (declare (dynamic-extent args))
91ee393 @lisp correct get operator to handle function valued body; correct the erro…
authored
577 (apply #'amqp::respond-to-open-ok class args)
bbae9ab @lisp rabbitmq interoperability: framing independent of protocol version, c…
authored
578 (return-from command-loop)))
6a7b76a @lisp external build, take 1
authored
579 class)
580
581 (:method ((class amqp:channel) &rest args)
582 (apply #'amqp::send-open class args)
583 (command-loop (class)
584 ; qpid answers with a channel command
585 (amqp:open-ok (class &rest args)
586 (amqp:log :debug class "Opened: ~s" args)
587 (return-from command-loop))))))
588
589
590 (def-amqp-command amqp:Open-Ok (class &key)
591 (:documentation "C<--S : signal that connection is ready")
592
593 (:response
594 (:method ((class amqp::connection) &key &allow-other-keys)
595 class)
596 (:method ((class amqp::channel) &key &allow-other-keys)
597 class)))
598
ca417ab @lisp provide integer-equivalent expiration times to publish
authored
599 (defparameter *publish-expiration* "100000"
600 "Value in milliseconds. COuld also be a default value in the instance, but this is more direct,")
6a7b76a @lisp external build, take 1
authored
601
db8a756 @lisp clean dynamic-extent declarations
authored
602 (def-amqp-command amqp:publish (class &key body exchange routing-key mandatory immediate
874ada0 @lisp more changes to sbcl simple streams; support basic headers in publish
authored
603 content-type content-encoding headers delivery-mode
604 priority correlation-id reply-to expiration message-id timestamp
605 type user-id)
6a7b76a @lisp external build, take 1
authored
606 (:documentation "C-->S : publish a message :
607 This method publishes a message to a specific exchange. The message will be routed to queues as
608 defined by the exchange configuration and distributed to any active consumers when the transaction, if
609 any, is committed.")
874ada0 @lisp more changes to sbcl simple streams; support basic headers in publish
authored
610
6a7b76a @lisp external build, take 1
authored
611 (:request
fd51e77 @lisp additions and corrections in connection with spocq sae development.
authored
612 (:method ((exchange amqp:exchange) &rest args)
613 "Given an exchange, delegate to its channel's basic instance."
614 (declare (dynamic-extent args))
615 (apply #'amqp::request-publish (amqp:channel.basic (amqp.u:exchange-channel exchange)) args))
874ada0 @lisp more changes to sbcl simple streams; support basic headers in publish
authored
616
2c787f3 @lisp add user-id default to amqp:publish to use the connection uri user in…
authored
617 (:method ((channel amqp:channel) &rest args &key (user-id (or (channel-user-id channel) "")) &allow-other-keys)
6a7b76a @lisp external build, take 1
authored
618 "The class' channel is state is set to use-channel.body.output, the stream is cleared,
619 and the encoding is asserted. If a body is supplied, then, it is written. Otherwise the
620 channel is left available as a stream."
621 (declare (dynamic-extent args))
622 ;; delegate to the channel's basic class
2c787f3 @lisp add user-id default to amqp:publish to use the connection uri user in…
authored
623 (apply #'amqp::request-publish (amqp:channel.basic channel)
624 :user-id user-id
625 args))
874ada0 @lisp more changes to sbcl simple streams; support basic headers in publish
authored
626
627 (:method ((basic amqp:basic) &rest args &key (body nil body-s)
b605602 @lisp return multiple values from response handler
authored
628 (exchange nil e-s) (routing-key nil rk-s)
bd15950 @lisp add user-id delegation from basic to the respective channel in order …
authored
629 (user-id (or (basic-user-id basic) ""))
ca417ab @lisp provide integer-equivalent expiration times to publish
authored
630 (expiration *publish-expiration*)
d772d24 @lisp changes to streamed framing to eliminate extra messages
authored
631 &allow-other-keys)
632 (when e-s
633 (setf exchange (amqp:exchange-exchange exchange)) ; coerce to a string
634 (setf (amqp:basic-exchange basic) exchange)) ; cache for possible use in chunk headers
b605602 @lisp return multiple values from response handler
authored
635 (when rk-s
636 (setf (amqp:basic-routing-key basic) routing-key))
874ada0 @lisp more changes to sbcl simple streams; support basic headers in publish
authored
637 (when body-s
6a7b76a @lisp external build, take 1
authored
638 (setf args (copy-list args))
874ada0 @lisp more changes to sbcl simple streams; support basic headers in publish
authored
639 (remf args :body))
d772d24 @lisp changes to streamed framing to eliminate extra messages
authored
640 (apply #'shared-initialize basic t args)
6a7b76a @lisp external build, take 1
authored
641 (let ((channel (object-channel basic)))
ca417ab @lisp provide integer-equivalent expiration times to publish
authored
642 (apply #'device-write-content channel body :exchange exchange :user-id user-id
643 :expiration expiration args)))))
6a7b76a @lisp external build, take 1
authored
644
645
646 (def-amqp-command amqp:purge (class &key queue no-wait)
647 (:documentation "C<->S : "))
648
649
650 (def-amqp-command amqp:purge-ok (class &key message-count)
651 (:documentation "C<->S : "))
652
653
654 (def-amqp-command amqp:qos (class &key prefetch-size prefetch-count global)
655 (:documentation "C-->S : ")
656
657 (:request
658 (:method ((basic amqp:basic) &rest args)
659 (apply #'amqp::send-qos basic args)
660 (command-loop (basic)
661 (amqp:qos-ok (basic) (return-from command-loop)))
662 basic)))
663
664 (def-amqp-command amqp:qos-ok (class &key)
665 (:documentation "C<-S : ")
666
667 (:response
668 (:method ((class amqp:basic) &key)
669 class)))
670
671 (def-amqp-command amqp:recover (class &key requeue)
672 (:documentation "C-->S : ")
673
674 (:request
675 (:method ((basic amqp:basic) &rest args)
676 (apply #'amqp::send-recover basic args)
677 (command-loop (basic)
678 (amqp:recover-ok (basic) (return-from command-loop)))
679 basic)))
680
681 (def-amqp-command amqp:recover-async (class &key requeue)
682 (:documentation "C-->S : ")
683
684 (:request
685 (:method ((basic amqp:basic) &rest args)
686 (apply #'amqp::send-recover-async basic args)
687 basic)))
688
689 (def-amqp-command amqp:recover-ok (class &key )
690 (:documentation "C<-S : ")
691
692 (:response
693 (:method ((class amqp:basic) &key)
694 class)))
695
696
697 (def-amqp-command amqp:Redirect (class &key)
698 (:documentation ""))
699
700
701 (def-amqp-command amqp:Reject (class &key delivery-tag multiple)
702 (:documentation "C-->S : reject an incoming message"))
703
704
705 (def-amqp-command amqp:request (class &key realm exclusive passive active write read)
706 (:documentation "C-->S : ")
707
708 (:request
709 (:method ((access amqp:access) &rest args)
710 (apply #'amqp::send-request access args)
711 (command-loop (access)
712 (amqp:request-ok (access) (return-from command-loop)))
713 access)))
714
715 (def-amqp-command amqp:request-ok (class &key)
716 (:documentation "C<-S : ")
717
718 (:response
719 (:method ((access amqp:access) &key ticket)
720 (declare (ignore ticket))
721 access)))
722
723
724 (def-amqp-command amqp:Return (class &key reply-code reply-text exchange routing-key)
725 (:documentation "C<--S : return a failed message"))
726
727
728 (def-amqp-command amqp:rollback (class &key)
729 (:documentation "C-->S : ")
730
731 (:request
732 (:method ((tx amqp:tx) &key)
733 "Send the command and wait for the response."
734
735 (amqp::send-rollback tx)
736 (command-loop (tx)
737 (amqp:rollback-ok ((tx amqp:tx)) (return-from command-loop)))
738 tx)))
739
740
741 (def-amqp-command amqp:rollback-ok (class &key queue message-count)
742 (:documentation "C<--S : ")
743 (:response
744 (:method ((class amqp::connection) &key &allow-other-keys)
745 class)
746 (:method ((class amqp::channel) &key &allow-other-keys)
747 class)))
748
749
750 (def-amqp-command amqp:Secure (class &key challenge)
751 (:documentation "C<--S : security mechanism challenge ")
752
753 (:response
754 (:method ((connection amqp:connection) &key &allow-other-keys)
755 (amqp::send-secure-ok connection :response (uri-userinfo (connection-uri connection))))))
756
757
758 (def-amqp-command amqp:Secure-Ok (class &key response)
759 (:documentation "C->S : security mechanism response")
760
761 (:request
762 (:method ((connection amqp:connection) &key response)
763 (declare (ignore response))
764 connection)))
765
766
767 (def-amqp-command amqp:select (class &key)
768 (:documentation "C-->S : Select transaction mode.")
769
770 (:request
771 (:method ((tx amqp:tx) &key)
772 "Send the command and wait for the response."
773
774 (amqp::send-select tx)
775 (command-loop (tx)
776 (amqp:select-ok ((tx amqp:tx)) (return-from command-loop)))
777 tx)))
778
779
780 (def-amqp-command amqp:select-ok (class &key)
781 (:documentation "C<--S : Confirm a transaction as a syncronous response to select
782 This command appears as eventual response to select and should be processed
783 synchronously together with that. I one appears independently, ignore it.")
784
785 (:response
786 (:method ((tx amqp:tx) &key)
787 tx)))
788
789
790 ;; SASL rfc4422
791 ;; . anonymous rfc4606
792 ;; . plain rfc4616
793 ;; QPID configuration : http://qpid.apache.org/qpid-design-authentication.html
794 (def-amqp-command amqp:start (class &key version-major version-minor server-properties mechanisms locales)
795 (:documentation "C<--S : start connection negotiation")
796
797 (:response
798 (:method ((connection amqp:connection)
799 &key version-major version-minor server-properties mechanisms locales)
800 (declare (ignore version-major version-minor))
801 (with-slots (amqp:locale amqp:mechanism) connection
802 (setf (amqp:connection-server-properties connection) server-properties)
803 (cond (amqp:locale
804 (unless (search amqp:locale locales)
805 (error "Specified locale not supported by server: ~s: ~s"
806 amqp:locale locales)))
807 ((stringp (setf amqp:locale (first (split-string " " locales)))))
808 (t
809 (error "No locale available.")))
810 (cond (amqp:mechanism
811 (unless (search amqp:mechanism mechanisms)
812 (error "Specified mechanism not supported by server: ~s: ~s"
813 amqp:mechanism mechanisms)))
814 ((stringp (setf amqp:mechanism (first (split-string " " mechanisms)))))
815 (t
816 (error "No mechanism available.")))
817
818 (amqp::send-start-ok connection
819 :client-properties nil
820 :mechanism amqp:mechanism
821 :response (format nil "~c~a~c~a"
822 #\null (or (uri-user (connection-uri connection)) "")
823 #\null (or (uri-password (connection-uri connection)) ""))
824 :locale amqp:locale)
825 connection))))
826
827
828 (def-amqp-command amqp:start-ok (class &key client-properties mechanism response locale)
829 (:documentation "C->S : select security mechanism and locale")
830
831 (:request
832 (:method ((connection amqp:connection) &rest args)
833 (declare (dynamic-extent args))
834 (apply #'amqp::send-start-ok connection args))))
835
836
837 (def-amqp-command amqp:tune (class &key channel-max frame-max heartbeat)
838 (:documentation "C<--S : propose connection tuning parameters")
839
840 (:response
841 (:method ((connection amqp:connection) &key channel-max frame-max heartbeat)
842 (when (> channel-max 0)
843 (setf channel-max (min channel-max *max-channels*))
844 (unless (> channel-max (position-if #'identity (get-connection-channels connection) :from-end t))
845 (amqp:not-allowed-error :connection connection
846 "Attempt to tune an active connection: ~s." connection)
847 (setf-connection-channels (adjust-array (get-connection-channels connection)
848 (1+ channel-max) :initial-element nil)
849 connection)))
850 (when (> frame-max 0)
851 (assert (>= frame-max (connection-frame-max connection)) ()
852 "Connection frame size too small: ~s, ~s" connection frame-max))
853 (setf (connection-heartbeat connection) heartbeat)
b20e82d @lisp continued corrections plus adjustments to rabbotmq for 0.9.1
authored
854 (setf frame-max (connection-frame-max connection))
6a7b76a @lisp external build, take 1
authored
855 (amqp::send-tune-ok connection :channel-max channel-max :frame-max frame-max :heartbeat heartbeat))))
856
857
858 (def-amqp-command amqp:tune-ok (class &key channel-max frame-max heartbeat)
859 (:documentation "C->S : negotiate connection tuning parameters")
860
861 (:request
862 (:method ((connection amqp:connection) &rest args)
863 (apply 'amqp::send-tune-ok connection args))))
864
865
866 (def-amqp-command amqp:unbind (class &key queue exchange routing-key arguments)
867 (:documentation "C<->S : ")
868
869 (:request
870 (:method ((class amqp:queue) &rest args)
871 (apply #'amqp::send-unbind class args)
872 (command-loop (class)
873 (amqp:unbind-ok ((class amqp:queue))
874 (return-from command-loop)))
875 class))
876
877 (:response
878 (:method ((queue amqp::queue) &rest args)
879 (declare (ignore args))
880 queue)))
881
882 (def-amqp-command amqp:unbind-ok (class &key)
883 (:documentation "C<->S : ")
884
885 (:request
886 (:method ((queue amqp::queue) &rest args)
887 (apply 'amqp::send-unbind-ok queue args)))
888
889 (:response
890 (:method ((queue amqp::queue) &rest args)
891 (declare (ignore args))
892 queue)))
893
894
895 ;;;
896 ;;; convenience operators
897
898 (defgeneric call-with-consumer (operator channel &key queue consumer-tag no-local no-ack exclusive no-wait arguments)
899
900 (:method (operator (channel amqp:channel) &rest args)
901 (declare (dynamic-extent args))
902
903 (apply #'amqp:request-consume channel args)
904 (command-loop (channel)
905 ;; up to the caller to rtansfer out
906 (amqp:deliver ((basic amqp:basic) &rest args)
907 (apply operator basic args)))))
908
Something went wrong with that request. Please try again.