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
|
;;;; $Id$
;;;; $URL$
;;;; See LICENSE for licensing information.
(in-package :usocket)
(defun handle-condition (condition &optional (socket nil))
"Dispatch correct usocket condition."
(declare (ignore socket))
(signal condition))
(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
timeout deadline (nodelay t nodelay-specified)
(local-host nil local-host-p)
(local-port nil local-port-p))
(when (and nodelay-specified
(not (eq nodelay :if-supported)))
(unsupported 'nodelay 'socket-connect))
(when deadline (unsupported 'deadline 'socket-connect))
(when timeout (unimplemented 'timeout 'socket-connect))
(when local-host-p
(unimplemented 'local-host 'socket-connect))
(when local-port-p
(unimplemented 'local-port 'socket-connect))
(let (socket)
(ecase protocol
(:stream
(setf socket (rt::socket-connect host port))
(let ((stream (rt::make-socket-stream socket :binaryp (not (eq element-type 'character)))))
(make-stream-socket :socket socket :stream stream)))
(:datagram
(error 'unsupported
:feature '(protocol :datagram)
:context 'socket-connect)))))
(defun socket-listen (host port
&key reuseaddress
(reuse-address nil reuse-address-supplied-p)
(backlog 5)
(element-type 'character))
(unimplemented 'socket-listen 'mocl))
(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
(unimplemented 'socket-accept 'mocl))
;; Sockets and their associated streams are modelled as
;; different objects. Be sure to close the socket stream
;; when closing stream-sockets; it makes sure buffers
;; are flushed and the socket is closed correctly afterwards.
(defmethod socket-close ((usocket usocket))
"Close socket."
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket))
(rt::socket-shutdown usocket)
(rt::c-fclose usocket))
(defmethod socket-close ((usocket stream-usocket))
"Close socket."
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket))
(close (socket-stream usocket)))
;; (defmethod socket-close :after ((socket datagram-usocket))
;; (setf (%open-p socket) nil))
;; (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port)
;; (let ((s (socket usocket))
;; (host (if host (host-to-hbo host)))
;; (real-buffer (if (zerop offset)
;; buffer
;; (subseq buffer offset (+ offset size)))))
;; (multiple-value-bind (result errno)
;; (ext:inet-socket-send-to s real-buffer size
;; :remote-host host :remote-port port)
;; (or result
;; (mocl-map-socket-error errno :socket usocket)))))
;; (defmethod socket-receive ((socket datagram-usocket) buffer length &key)
;; (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
;; (integer 0) ; size
;; (unsigned-byte 32) ; host
;; (unsigned-byte 16))) ; port
;; (let ((s (socket socket)))
;; (let ((real-buffer (or buffer
;; (make-array length :element-type '(unsigned-byte 8))))
;; (real-length (or length
;; (length buffer))))
;; (multiple-value-bind (result errno remote-host remote-port)
;; (ext:inet-socket-receive-from s real-buffer real-length)
;; (if result
;; (values real-buffer result remote-host remote-port)
;; (mocl-map-socket-error errno :socket socket))))))
;; (defmethod get-local-name ((usocket usocket))
;; (multiple-value-bind (address port)
;; (with-mapped-conditions (usocket)
;; (ext:get-socket-host-and-port (socket usocket)))
;; (values (hbo-to-vector-quad address) port)))
;; (defmethod get-peer-name ((usocket stream-usocket))
;; (multiple-value-bind (address port)
;; (with-mapped-conditions (usocket)
;; (ext:get-peer-host-and-port (socket usocket)))
;; (values (hbo-to-vector-quad address) port)))
;; (defmethod get-local-address ((usocket usocket))
;; (nth-value 0 (get-local-name usocket)))
;; (defmethod get-peer-address ((usocket stream-usocket))
;; (nth-value 0 (get-peer-name usocket)))
;; (defmethod get-local-port ((usocket usocket))
;; (nth-value 1 (get-local-name usocket)))
;; (defmethod get-peer-port ((usocket stream-usocket))
;; (nth-value 1 (get-peer-name usocket)))
;; (defun get-host-by-address (address)
;; (multiple-value-bind (host errno)
;; (ext:lookup-host-entry (host-byte-order address))
;; (cond (host
;; (ext:host-entry-name host))
;; (t
;; (let ((condition (cdr (assoc errno +unix-ns-error-map+))))
;; (cond (condition
;; (error condition :host-or-ip address))
;; (t
;; (error 'ns-unknown-error :host-or-ip address
;; :real-error errno))))))))
(defun get-hosts-by-name (name)
(rt::lookup-host name))
;; (defun get-host-name ()
;; (unix:unix-gethostname))
;;
;;
;; WAIT-LIST part
;;
(defun %add-waiter (wl waiter)
(declare (ignore wl waiter)))
(defun %remove-waiter (wl waiter)
(declare (ignore wl waiter)))
(defun %setup-wait-list (wl)
(declare (ignore wl)))
(defun wait-for-input-internal (wait-list &key timeout)
(unimplemented 'wait-for-input-internal 'mocl))
|
