/[de-setf-amqp]/test/device-level.lisp
ViewVC logotype

Contents of /test/device-level.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Tue Feb 23 09:05:39 2010 UTC (4 years, 1 month ago) by janderson
File size: 7971 byte(s)
Merge commit 'remotes/github/master' into remotes/git-svn
1 ;;; -*- Package: de.setf.amqp.implementation; -*-
2
3 (in-package :de.setf.amqp.implementation)
4
5
6 (document :file
7 (description "This file implements connection-related tests for streams based on AMQP connections for the
8 'de.setf.amqp' library.")
9 (copyright
10 "Copyright 2010 [james anderson](mailto:james.anderson@setf.de)"
11 "'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
12 of the GNU Affero General Public License as published by the Free Software Foundation.
13
14 'setf.amqp' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
15 implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
16 See the Affero General Public License for more details.
17
18 You should have received a copy of the GNU Affero General Public License along with 'de.setf.amqp'.
19 If not, see the GNU [site](http://www.gnu.org/licenses/)."))
20
21
22 (document (connection/open) "Test setup:
23
24 testing w/ qpid
25 installed 0.5 (/Development/Applications/AMQP/qpid-0.5/ )
26 set up ssh
27 # cd /Development/Applications/AMQP/qpid-0.5/etc
28 # create-example-ssl-stores.sh
29 set up environment variables
30 # export QPID_HOME=/Development/Applications/AMQP/qpid-0.5/
31 # export PATH=$PATH:/Development/Applications/AMQP/qpid-0.5/bin
32 # /Development/Applications/AMQP/qpid-0.5/bin/qpid-server
33
34
35 The first tests were against a QPID-0.5 broker (:AMQP-1-1-0-9). It really does
36 respond to the acceptable version token with the intial Connection.Start message.
37 If it doesn't like the sent data it does one of several things:
38 - a malfored respone, eg. a (spurious) cr/lf, cause it to try again with the version token
39 - a misframed response caused it to close the connection
40 - an unacceptable, but well-formed response, eg a bogus authentication mechanism, caused
41 it to respond with a close operation.")
42
43
44 (test:test connection/open
45 "This will open a connection, and close it."
46 (let ((connection nil))
47 (unwind-protect
48 (progn (setf connection
49 (make-instance 'amqp:connection
50 :uri "amqp://guest:guest@192.168.1.25/"))
51 (values (connection-state connection)
52 (connection-uri connection)
53 (amqp:connection-server-properties connection)))
54 (when connection (close connection) t))))
55
56
57 #|
58 The first long tests with qpid failed and left this in the terminal:
59
60 Using QPID_CLASSPATH /Development/Downloads/qpid-0.5//lib/qpid-all.jar:/Development/Downloads/qpid-0.5//lib/bdbstore-launch.jar
61 Info: QPID_JAVA_GC not set. Defaulting to JAVA_GC -XX:+UseConcMarkSweepGC -XX:+HeapDumpOnOutOfMemoryError
62 Info: QPID_JAVA_MEM not set. Defaulting to JAVA_MEM -Xmx1024m
63 Using configuration file /Development/Downloads/qpid-0.5/etc/config.xml
64 Configuring logger using configuration file /Development/Downloads/qpid-0.5/etc/log4j.xml
65 2010-01-11 01:17:06,168 INFO [main] management.JMXManagedObjectRegistry (JMXManagedObjectRegistry.java:162) - JMX ConnectorServer using SSL keystore file /Development/Downloads/qpid-0.5/etc/qpid.keystore
66 2010-01-11 01:17:06,519 WARN [main] management.JMXManagedObjectRegistry (JMXManagedObjectRegistry.java:187) - Starting JMX ConnectorServer on port '8999' (+9099) with SSL
67 2010-01-11 01:17:07,512 INFO [main] server.Main (Main.java:279) - Starting Qpid Broker 0.5 build: exported
68 2010-01-11 01:17:07,746 INFO [main] server.Main (Main.java:387) - Qpid.AMQP listening on non-SSL address 0.0.0.0/0.0.0.0:5672
69 2010-01-11 01:17:07,747 INFO [main] server.Main (Main.java:409) - Qpid Broker Ready :0.5 build: exported
70 java.lang.OutOfMemoryError: Java heap space
71 Dumping heap to java_pid688.hprof ...
72 Heap dump file created [1079483534 bytes in 35.675 secs]
73 |#
74
75 #+mcl
76 (let ((count (* 1)))
77 (multiple-value-bind (results time count)
78 (test-live-objects (list "come here watson, ..."
79 (let ((i (char-code #\a))) (map-into (make-string 26) #'(lambda () (values (code-char i) (incf i)))))
80 (lisp-implementation-type)
81 (lisp-implementation-version))
82 :log-level :error :verbose-p t
83 :no-ack nil
84 :element-type 'character
85 :content-type mime:text/plain
86 :count count)
87 (values
88 results
89 (float (/ (/ time count) internal-time-units-per-second))
90 (float (/ time internal-time-units-per-second))
91 count)))
92
93 #+clozure
94 (let ((count (* 1)))
95 (multiple-value-bind (results time count)
96 (test-live-objects (list "a thing of beauty is a wonder to behold"
97 (let ((i (char-code #\0))) (map-into (make-string 10) #'(lambda () (values (code-char i) (incf i)))))
98 (lisp-implementation-type)
99 (lisp-implementation-version))
100 :log-level :error :verbose-p t
101 :no-ack nil
102 :element-type 'character
103 :content-type mime:text/plain
104 :count count)
105 (values
106 results
107 (float (/ (/ time count) internal-time-units-per-second))
108 (float (/ time internal-time-units-per-second))
109 count)))
110
111
112 ;;; sbcl probes
113 #+(or)
114 (let ((remote-host "localhost"))
115 (etypecase remote-host
116 (string (let ((host (sb-bsd-sockets:get-host-by-name remote-host)))
117 (setf remote-host (first (sb-bsd-sockets:host-ent-addresses host)))))
118 (vector )))
119
120
121 (defmethod drain-connection ((data vector) (stream stream) &key (start 0) (end (length data)))
122 (multiple-value-bind (null error)
123 (ignore-errors
124 (do ((i start (1+ i))
125 (byte (read-byte stream)
126 (read-byte stream)))
127 ((or (>= i end) (null byte) (< byte 0))
128 (subseq data 0 i))
129 (format *trace-output* " ~2,'0d" byte)
130 (force-output *trace-output*)
131 (setf (aref data i) byte)))
132 (cond ((null null)
133 (princ error)
134 (values data error))
135 (t
136 data))))
137
138 (defun probe-connection (&key (host "127.0.0.1") (port *standard-port*) (repeat 0))
139 ;; open, write protocol token, read frame, write static frame, read complete to eof
140 (let* ((socket (usocket:socket-connect host port :element-type 'unsigned-byte))
141 (stream (usocket:socket-stream socket))
142 (data (make-frame-buffer 1024))
143 (token (make-frame-buffer 8))
144 (byte 0))
145 (unwind-protect
146 (progn
147 (setf (buffer-protocol-header token) *default-version*)
148 (write-sequence token stream)
149 (dotimes (i repeat)
150 (write-sequence (map 'vector #'char-code #(#\return #\linefeed))
151 stream))
152 (force-output stream)
153
154 ;; read header
155 (case (setf byte (read-byte stream))
156 ;; the later protocols reply with a version to confirm, but
157 ;; the early ones just send the start frame immediately
158 (#.(char-code #\A)
159 (setf (aref data 0) byte)
160 (unless (= 8 (read-sequence token stream :start 1))
161 (error "protocol token failed to read."))
162 (buffer-protocol-header token))
163 (t
164 (setf (aref data 0) byte)
165 (drain-connection data stream :start 1))))
166 (when socket (usocket:socket-close socket)))))

  ViewVC Help
Powered by ViewVC 1.1.5