-;; Sockets
-
-#+lispworks
-(progn
-
-(define-condition lw-stream-error (error)
- ((stream :initarg :stream
- :reader stream-error-stream)
- (action :initarg :action
- :reader stream-error-action)
- (code :initarg :code
- :reader stream-error-code)
- (identifier :initarg :identifier
- :reader stream-error-identifier))
- (:report (lambda (condition stream)
- (format stream "A stream error occured (action=~A identifier=~A code=~A stream=~S)."
- (stream-error-action condition)
- (stream-error-identifier condition)
- (stream-error-code condition)
- (stream-error-stream condition)))))
-
-(define-condition socket-error (lw-stream-error)
- ()
- (:report (lambda (condition stream)
- (format stream "A socket error occured (action=~A identifier=~A code=~A stream=~S)."
- (stream-error-action condition)
- (stream-error-identifier condition)
- (stream-error-code condition)
- (stream-error-stream condition)))))
-
-(defclass socket ()
- ((passive-socket :type fixnum
- :initarg :passive-socket
- :reader socket-os-fd)))
-
- (defclass passive-socket (socket)
- ((element-type :type (member signed-byte unsigned-byte base-char)
- :initarg :element-type
- :reader element-type)
- (port :type fixnum
- :initarg :port
- :reader local-port)))
-
- (defmethod print-object ((passive-socket passive-socket) stream)
- (print-unreadable-object (passive-socket stream :type t :identity nil)
- (format stream "@~d on port ~d" (socket-os-fd passive-socket) (local-port passive-socket))))
-
- (defclass binary-socket-stream (comm:socket-stream) ())
-(defclass input-binary-socket-stream (binary-socket-stream)())
-(defclass output-binary-socket-stream (binary-socket-stream)())
-(defclass bidirectional-binary-socket-stream (input-binary-socket-stream output-binary-socket-stream)())
-
-#+unix
-(defun %socket-error-identifier (code)
- (case code
- (32 :x-broken-pipe)
- (98 :address-in-use)
- (99 :address-not-available)
- (100 :network-down)
- (102 :network-reset)
- (103 :connection-aborted)
- (104 :connection-reset)
- (105 :no-buffer-space)
- (108 :shutdown)
- (110 :connection-timed-out)
- (111 :connection-refused)
- (112 :host-down)
- (113 :host-unreachable)
- (otherwise :unknown)))
-
-#+win32
-(defun %socket-error-identifier (code)
- (case code
- (10048 :address-in-use)
- (10049 :address-not-available)
- (10050 :network-down)
- (10052 :network-reset)
- (10053 :connection-aborted)
- (10054 :connection-reset)
- (10055 :no-buffer-space)
- (10058 :shutdown)
- (10060 :connection-timed-out)
- (10061 :connection-refused)
- (10064 :host-down)
- (10065 :host-unreachable)
- (otherwise :unknown)))
-
-(defun socket-error (stream error-code action format-string &rest format-args)
- (let ((code (if (numberp error-code) error-code #+unix(lw:errno-value))))
- (error 'socket-error :stream stream :code code
- :identifier (if (keywordp error-code)
- error-code
- (%socket-error-identifier error-code))
- :action action
- :format-control "~A occured while doing socket IO (~?)"
- :format-arguments (list 'socket-error format-string format-args))))