clucumber 0.1.1 → 0.2.0

data/lib/clucumber/vendor/usocket/condition.lisp

@@ -0,0 +1,227 @@
+;;;; $Id: condition.lisp 500 2009-09-17 07:01:50Z hhubner $
+;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/trunk/condition.lisp $
+
+;;;; See LICENSE for licensing information.
+
+(in-package :usocket)
+
+;; Condition signalled by operations with unsupported arguments
+;; For trivial-sockets compatibility.
+
+(define-condition insufficient-implementation (error)
+  ((feature :initarg :feature :reader feature)
+   (context :initarg :context :reader context
+    :documentation "String designator of the public API function which
+the feature belongs to."))
+  (:documentation "The ancestor of all errors usocket may generate
+because of insufficient support from the underlying implementation
+with respect to the arguments given to `function'.
+
+One call may signal several errors, if the caller allows processing
+to continue.
+"))
+
+(define-condition unsupported (insufficient-implementation)
+  ((minimum :initarg :minimum :reader minimum
+            :documentation "Indicates the minimal version of the
+implementation required to support the requested feature."))
+  (:report (lambda (c stream)
+	     (format stream "~A in ~A is unsupported."
+		     (feature c) (context c))
+	     (when (minimum c)
+	       (format stream " Minimum version (~A) is required."
+		       (minimum c)))))
+  (:documentation "Signalled when the underlying implementation
+doesn't allow supporting the requested feature.
+
+When you see this error, go bug your vendor/implementation developer!"))
+
+(define-condition unimplemented (insufficient-implementation)
+  ()
+  (:report (lambda (c stream)
+	     (format stream "~A in ~A is unimplemented."
+		     (feature c) (context c))))
+  (:documentation "Signalled if a certain feature might be implemented,
+based on the features of the underlying implementation, but hasn't
+been implemented yet."))
+
+;; Conditions raised by sockets operations
+
+(define-condition socket-condition (condition)
+  ((socket :initarg :socket
+           :accessor usocket-socket))
+  ;;###FIXME: no slots (yet); should at least be the affected usocket...
+  (:documentation "Parent condition for all socket related conditions."))
+
+(define-condition socket-error (socket-condition error)
+  () ;; no slots (yet)
+  (:documentation "Parent error for all socket related errors"))
+
+(define-condition ns-condition (condition)
+  ((host-or-ip :initarg :host-or-ip
+               :accessor host-or-ip))
+  (:documentation "Parent condition for all name resolution conditions."))
+
+(define-condition ns-error (ns-condition error)
+  ()
+  (:documentation "Parent error for all name resolution errors."))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun define-usocket-condition-class (class &rest parents)
+    `(progn
+       (define-condition ,class ,parents ())
+       (export ',class))))
+
+(defmacro define-usocket-condition-classes (class-list parents)
+  `(progn ,@(mapcar #'(lambda (x)
+                        (apply #'define-usocket-condition-class
+                               x parents))
+                    class-list)))
+
+;; Mass define and export our conditions
+(define-usocket-condition-classes
+  (interrupted-condition)
+  (socket-condition))
+
+(define-condition unknown-condition (socket-condition)
+  ((real-condition :initarg :real-condition
+                   :accessor usocket-real-condition))
+  (:documentation "Condition raised when there's no other - more applicable -
+condition available."))
+
+
+;; Mass define and export our errors
+(define-usocket-condition-classes
+  (address-in-use-error
+   address-not-available-error
+   bad-file-descriptor-error
+   connection-refused-error
+   connection-aborted-error
+   connection-reset-error
+   invalid-argument-error
+   no-buffers-error
+   operation-not-supported-error
+   operation-not-permitted-error
+   protocol-not-supported-error
+   socket-type-not-supported-error
+   network-unreachable-error
+   network-down-error
+   network-reset-error
+   host-down-error
+   host-unreachable-error
+   shutdown-error
+   timeout-error
+   deadline-timeout-error
+   invalid-socket-error
+   invalid-socket-stream-error)
+  (socket-error))
+
+(define-condition unknown-error (socket-error)
+  ((real-error :initarg :real-error
+               :accessor usocket-real-error))
+  (:report (lambda (c stream)
+             (typecase c
+               (simple-condition
+                (format stream
+                        (simple-condition-format-control (usocket-real-error c))
+                        (simple-condition-format-arguments (usocket-real-error c))))
+               (otherwise
+                (format stream "The condition ~A occurred." (usocket-real-error c))))))
+  (:documentation "Error raised when there's no other - more applicable -
+error available."))
+
+(define-usocket-condition-classes
+  (ns-try-again)
+  (ns-condition))
+
+(define-condition ns-unknown-condition (ns-condition)
+  ((real-error :initarg :real-condition
+               :accessor ns-real-condition))
+  (:documentation "Condition raised when there's no other - more applicable -
+condition available."))
+
+(define-usocket-condition-classes
+  ;; the no-data error code in the Unix 98 api
+  ;; isn't really an error: there's just no data to return.
+  ;; with lisp, we just return NIL (indicating no data) instead of
+  ;; raising an exception...
+  (ns-host-not-found-error
+   ns-no-recovery-error)
+  (ns-error))
+
+(define-condition ns-unknown-error (ns-error)
+  ((real-error :initarg :real-error
+               :accessor ns-real-error))
+  (:report (lambda (c stream)
+             (typecase c
+               (simple-condition
+                (format stream
+                        (simple-condition-format-control (usocket-real-error c))
+                        (simple-condition-format-arguments (usocket-real-error c))))
+               (otherwise
+                (format stream "The condition ~A occurred." (usocket-real-error c))))))
+  (:documentation "Error raised when there's no other - more applicable -
+error available."))
+
+(defmacro with-mapped-conditions ((&optional socket) &body body)
+  `(handler-bind ((condition #'(lambda (c) (handle-condition c ,socket))))
+    ,@body))
+
+(defparameter +unix-errno-condition-map+
+  `(((11) . retry-condition) ;; EAGAIN
+    ((35) . retry-condition) ;; EDEADLCK
+    ((4) . interrupted-condition))) ;; EINTR
+
+(defparameter +unix-errno-error-map+
+  ;;### the first column is for non-(linux or srv4) systems
+  ;; the second for linux
+  ;; the third for srv4
+  ;;###FIXME: How do I determine on which Unix we're running
+  ;;          (at least in clisp and sbcl; I know about cmucl...)
+  ;; The table below works under the assumption we'll *only* see
+  ;; socket associated errors...
+  `(((48 98) . address-in-use-error)
+    ((49 99) . address-not-available-error)
+    ((9) . bad-file-descriptor-error)
+    ((61 111) . connection-refused-error)
+    ((54 104) . connection-reset-error)
+    ((53 103) . connection-aborted-error)
+    ((22) . invalid-argument-error)
+    ((55 105) . no-buffers-error)
+    ((12) . out-of-memory-error)
+    ((45 95) . operation-not-supported-error)
+    ((1) . operation-not-permitted-error)
+    ((43 92) . protocol-not-supported-error)
+    ((44 93) . socket-type-not-supported-error)
+    ((51 101) . network-unreachable-error)
+    ((50 100) . network-down-error)
+    ((52 102) . network-reset-error)
+    ((58 108) . already-shutdown-error)
+    ((60 110) . timeout-error)
+    ((64 112) . host-down-error)
+    ((65 113) . host-unreachable-error)))
+
+
+(defun map-errno-condition (errno)
+  (cdr (assoc errno +unix-errno-error-map+ :test #'member)))
+
+
+(defun map-errno-error (errno)
+  (cdr (assoc errno +unix-errno-error-map+ :test #'member)))
+
+
+(defparameter +unix-ns-error-map+
+  `((1 . ns-host-not-found-error)
+    (2 . ns-try-again-condition)
+    (3 . ns-no-recovery-error)))
+
+
+
+(defmacro unsupported (feature context &key minimum)
+  `(cerror "Ignore it and continue" 'unsupported
+	   :feature ,feature
+	   :context ,context
+	   :minimum ,minimum))
+
+(defmacro unimplemented (feature context)
+  `(signal 'unimplemented :feature ,feature :context ,context))

data/lib/clucumber/vendor/usocket/package.lisp

@@ -0,0 +1,82 @@
+;;;; $Id: package.lisp 515 2010-01-07 18:26:06Z ctian $
+;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/trunk/package.lisp $
+
+;;;; See the LICENSE file for licensing information.
+
+(in-package :usocket-system)
+
+#+lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require "comm"))
+
+(defpackage :usocket
+  (:use :common-lisp)
+  (:export   #:*wildcard-host*
+             #:*auto-port*
+
+             #:*remote-host* ; special variables (udp)
+             #:*remote-port*
+
+             #:socket-connect ; socket constructors and methods
+             #:socket-listen
+             #:socket-accept
+             #:socket-close
+             #:get-local-address
+             #:get-peer-address
+             #:get-local-port
+             #:get-peer-port
+             #:get-local-name
+             #:get-peer-name
+
+             #:socket-send    ; udp function (send)
+             #:socket-receive ; udp function (receive)
+             #:socket-server  ; udp server
+
+             #:wait-for-input ; waiting for input-ready state (select() like)
+             #:make-wait-list
+             #:add-waiter
+             #:remove-waiter
+             #:remove-all-waiters
+
+             #:with-connected-socket ; convenience macros
+             #:with-server-socket
+             #:with-client-socket
+             #:with-socket-listener
+
+             #:usocket ; socket object and accessors
+             #:stream-usocket
+             #:stream-server-usocket
+             #:socket
+             #:socket-stream
+             #:datagram-usocket
+
+             #:host-byte-order ; IP(v4) utility functions
+             #:hbo-to-dotted-quad
+             #:hbo-to-vector-quad
+             #:vector-quad-to-dotted-quad
+             #:dotted-quad-to-vector-quad
+             #:ip=
+             #:ip/=
+
+             #:integer-to-octet-buffer ; Network utility functions
+             #:octet-buffer-to-integer
+             #:port-to-octet-buffer
+             #:port-from-octet-buffer
+             #:ip-to-octet-buffer
+             #:ip-from-octet-buffer
+
+             #:with-mapped-conditions
+
+             #:socket-condition ; conditions
+             #:ns-condition
+             #:socket-error ; errors
+             #:ns-error
+             #:unknown-condition
+             #:ns-unknown-condition
+             #:unknown-error
+             #:ns-unknown-error
+             #:socket-warning ; warnings (udp)
+
+             #:insufficient-implementation ; conditions regarding usocket support level
+             #:unsupported
+             #:unimplemented))

data/lib/clucumber/vendor/usocket/server.lisp

@@ -0,0 +1,45 @@
+;;;; $Id: server.lisp 515 2010-01-07 18:26:06Z ctian $
+;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/trunk/server.lisp $
+
+(in-package :usocket)
+
+(defvar *remote-host*)
+(defvar *remote-port*)
+
+(defun socket-server (host port function &optional arguments
+                      &key (timeout 1)
+		           (max-buffer-size +max-datagram-packet-size+))
+  (let ((socket (socket-connect nil nil
+				:protocol :datagram
+				:local-host host
+				:local-port port))
+        (buffer (make-array max-buffer-size
+                            :element-type '(unsigned-byte 8)
+                            :initial-element 0)))
+    (unwind-protect
+        (loop (progn
+		(multiple-value-bind (sockets real-time)
+                    (wait-for-input socket :timeout timeout)
+                  (declare (ignore sockets))
+                  (when real-time
+                    (multiple-value-bind (recv n *remote-host* *remote-port*)
+                        (socket-receive socket buffer max-buffer-size)
+                      (declare (ignore recv))
+                      (if (plusp n)
+                          (progn
+                            (let ((reply
+                                   (apply function
+                                          (cons (subseq buffer 0 n) arguments))))
+                              (when reply
+                                (replace buffer reply)
+                                (let ((n (socket-send socket buffer (length reply)
+                                                      :host *remote-host*
+                                                      :port *remote-port*)))
+                                  (when (minusp n)
+                                    (error "send error: ~A~%" n))))))
+			(error "receive error: ~A" n))))
+                  #+scl (when thread:*quitting-lisp*
+                          (return))
+                  #+(and cmu mp) (mp:process-yield))))
+      (socket-close socket)
+      (values))))

data/lib/clucumber/vendor/usocket/test/package.lisp

@@ -0,0 +1,13 @@
+;;;; $Id: package.lisp 57 2006-02-07 19:39:46Z ehuelsmann $
+;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/trunk/test/package.lisp $
+
+;;;; See the LICENSE file for licensing information.
+
+(in-package :cl-user)
+
+(eval-when (:execute :load-toplevel :compile-toplevel)
+  (defpackage :usocket-test
+      (:use :cl :regression-test)
+    (:nicknames :usoct)
+    (:export :do-tests :run-usocket-tests)))
+

data/lib/clucumber/vendor/usocket/test/test-usocket.lisp

@@ -0,0 +1,166 @@
+;;;; $Id: test-usocket.lisp 510 2010-01-04 07:49:39Z ctian $
+;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/trunk/test/test-usocket.lisp $
+
+;;;; See LICENSE for licensing information.
+
+(in-package :usocket-test)
+
+;; The parameters below may need adjustments to match the system
+;; the tests are run on.
+(defparameter +non-existing-host+ "192.168.1.199")
+(defparameter +unused-local-port+ 15213)
+(defparameter *soc1* (usocket::make-stream-socket :socket :my-socket
+                                                  :stream :my-stream))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defparameter +local-ip+ #(192 168 1 25))
+  (defparameter +common-lisp-net+
+    #+ignore #(80 68 86 115) ;; common-lisp.net IP (not valid as of 2010-01-03
+    (first (usocket::get-hosts-by-name "common-lisp.net"))))
+
+(defmacro with-caught-conditions ((expect throw) &body body)
+  `(catch 'caught-error
+     (handler-case
+      (progn ,@body)
+      (usocket:unknown-error (c) (if (typep c ,expect)
+                                     (throw 'caught-error ,throw)
+                                   (progn
+                                     (describe c)
+                                     (describe
+                                      (usocket::usocket-real-error c))
+                                     c)))
+      (error (c) (if (typep c ,expect)
+                     (throw 'caught-error ,throw)
+                   (progn
+                     (describe c)
+                     c)))
+      (usocket:unknown-condition (c) (if (typep c ,expect)
+                                         (throw 'caught-error ,throw)
+                                       (progn
+                                         (describe c)
+                                         (describe
+                                          (usocket::usocket-real-condition c))
+                                         c)))
+      (condition (c) (if (typep c ,expect)
+                         (throw 'caught-error ,throw)
+                       (progn
+                         (describe c)
+                         c))))))
+
+(deftest make-socket.1 (usocket:socket *soc1*) :my-socket)
+(deftest make-socket.2 (usocket:socket-stream *soc1*) :my-stream)
+
+(deftest socket-no-connect.1
+  (with-caught-conditions ('usocket:socket-error nil)
+      (usocket:socket-connect "127.0.0.0" +unused-local-port+ :timeout 0)
+      t)
+  nil)
+(deftest socket-no-connect.2
+  (with-caught-conditions ('usocket:socket-error nil)
+    (usocket:socket-connect #(127 0 0 0) +unused-local-port+ :timeout 0)
+    t)
+  nil)
+(deftest socket-no-connect.3
+  (with-caught-conditions ('usocket:socket-error nil)
+    (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; == #(127 0 0 0)
+    t)
+  nil)
+
+(deftest socket-failure.1
+  (with-caught-conditions (#-(or cmu lispworks armedbear openmcl mcl)
+                             'usocket:network-unreachable-error
+                           #+(or cmu lispworks armedbear)
+                             'usocket:unknown-error
+                           #+(or openmcl mcl)
+                             'usocket:timeout-error
+                           nil)
+    (usocket:socket-connect 2130706432 +unused-local-port+ :timeout 0) ;; == #(127 0 0 0)
+    :unreach)
+  nil)
+(deftest socket-failure.2
+  (with-caught-conditions (#+(or lispworks armedbear)
+                             'usocket:unknown-error
+                           #+cmu
+                             'usocket:network-unreachable-error
+                           #+(or openmcl mcl)
+                             'usocket:timeout-error
+                           #-(or lispworks armedbear cmu openmcl mcl)
+                             'usocket:host-unreachable-error
+                           nil)
+      (usocket:socket-connect +non-existing-host+ 80 :timeout 0) ;; 80 = just a port
+      :unreach)
+  nil)
+
+
+;; let's hope c-l.net doesn't move soon, or that people start to
+;; test usocket like crazy..
+(deftest socket-connect.1
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect "common-lisp.net" 80)))
+      (unwind-protect
+          (when (typep sock 'usocket:usocket) t)
+        (usocket:socket-close sock))))
+  t)
+(deftest socket-connect.2
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect +common-lisp-net+ 80)))
+      (unwind-protect
+          (when (typep sock 'usocket:usocket) t)
+        (usocket:socket-close sock))))
+  t)
+(deftest socket-connect.3
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect (usocket::host-byte-order +common-lisp-net+) 80)))
+      (unwind-protect
+          (when (typep sock 'usocket:usocket) t)
+        (usocket:socket-close sock))))
+  t)
+
+;; let's hope c-l.net doesn't change its software any time soon
+(deftest socket-stream.1
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect "common-lisp.net" 80)))
+      (unwind-protect
+          (progn
+            (format (usocket:socket-stream sock)
+                    "GET / HTTP/1.0~c~c~c~c"
+                    #\Return #\linefeed #\Return #\linefeed)
+            (force-output (usocket:socket-stream sock))
+            (read-line (usocket:socket-stream sock)))
+        (usocket:socket-close sock))))
+  #+(or mcl clisp) "HTTP/1.1 200 OK"
+  #-(or clisp mcl) #.(format nil "HTTP/1.1 200 OK~A" #\Return) nil)
+
+(deftest socket-name.1
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect +common-lisp-net+ 80)))
+      (unwind-protect
+          (usocket::get-peer-address sock)
+        (usocket:socket-close sock))))
+  #.+common-lisp-net+)
+(deftest socket-name.2
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect +common-lisp-net+ 80)))
+      (unwind-protect
+          (usocket::get-peer-port sock)
+        (usocket:socket-close sock))))
+  80)
+(deftest socket-name.3
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect +common-lisp-net+ 80)))
+      (unwind-protect
+          (usocket::get-peer-name sock)
+        (usocket:socket-close sock))))
+  #.+common-lisp-net+ 80)
+(deftest socket-name.4
+  (with-caught-conditions (nil nil)
+    (let ((sock (usocket:socket-connect +common-lisp-net+ 80)))
+      (unwind-protect
+          (usocket::get-local-address sock)
+        (usocket:socket-close sock))))
+  #.+local-ip+)
+
+
+(defun run-usocket-tests ()
+  (do-tests))
+
+;;; (usoct::run-usocket-tests )

data/lib/clucumber/vendor/usocket/usocket-test.asd

@@ -0,0 +1,26 @@
+;;;; -*- Mode: Lisp -*-
+;;;; $Id: usocket-test.asd 46 2006-02-06 20:50:07Z ehuelsmann $
+;;;; $URL: svn+ssh://common-lisp.net/project/usocket/svn/usocket/trunk/test/usocket-test.asd $
+
+;;;; See the LICENSE file for licensing information.
+
+(in-package :cl-user)
+
+(unless (find-package ':usocket-system)
+  (make-package ':usocket-system
+		:use '(:cl :asdf)))
+
+(in-package :usocket-system)
+
+(defsystem usocket-test
+    :name "usocket test"
+    :author "Erik Enge"
+    :version "0.1.0"
+    :licence "MIT"
+    :description "Tests for usocket"
+    :depends-on (:usocket
+                 :rt)
+    :components ((:module "test"
+		  :components ((:file "package")
+			       (:file "test-usocket"
+				      :depends-on ("package"))))))

data/lib/clucumber/vendor/usocket/usocket.asd

@@ -0,0 +1,37 @@
+;;;; -*- Mode: Lisp -*-
+;;;; $Id: usocket.asd 519 2010-01-13 09:48:05Z ctian $
+;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/trunk/usocket.asd $
+
+;;;; See the LICENSE file for licensing information.
+
+(in-package #:cl-user)
+
+(defpackage #:usocket-system
+    (:use #:cl #:asdf))
+
+(in-package #:usocket-system)
+
+(defsystem usocket
+    :name "usocket"
+    :author "Erik Enge & Erik Huelsmann"
+    :version "0.5.0"
+    :licence "MIT"
+    :description "Universal socket library for Common Lisp"
+    :depends-on (#+sbcl :sb-bsd-sockets)
+    :components ((:file "package")
+		 (:module "vendor" :depends-on ("package")
+		  :components ((:file "split-sequence")
+			       #+mcl (:file "kqueue")))
+                 (:file "usocket" :depends-on ("vendor"))
+                 (:file "condition" :depends-on ("usocket"))
+		 (:module "backend" :depends-on ("condition")
+		  :components (#+clisp		(:file "clisp")
+			       #+cmu		(:file "cmucl")
+			       #+scl		(:file "scl")
+			       #+(or sbcl ecl)	(:file "sbcl")
+			       #+lispworks	(:file "lispworks")
+			       #+mcl		(:file "mcl")
+			       #+openmcl	(:file "openmcl")
+			       #+allegro	(:file "allegro")
+			       #+armedbear	(:file "armedbear")))
+		 (:file "server" :depends-on ("backend"))))