mocl.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
mocl.lisp (5501B)
---
1 ;;;; See LICENSE for licensing information.
2
3 (in-package :usocket)
4
5 (defun handle-condition (condition &optional (socket nil) (host-or-ip nil))
6 "Dispatch correct usocket condition."
7 (declare (ignore socket))
8 (signal condition))
9
10 (defun socket-connect (host port &key (protocol :stream) (element-type 'character)
11 timeout deadline (nodelay t nodelay-specified)
12 (local-host nil local-host-p)
13 (local-port nil local-port-p))
14 (when (and nodelay-specified
15 (not (eq nodelay :if-supported)))
16 (unsupported 'nodelay 'socket-connect))
17 (when deadline (unsupported 'deadline 'socket-connect))
18 (when timeout (unimplemented 'timeout 'socket-connect))
19 (when local-host-p
20 (unimplemented 'local-host 'socket-connect))
21 (when local-port-p
22 (unimplemented 'local-port 'socket-connect))
23
24 (let (socket)
25 (ecase protocol
26 (:stream
27 (setf socket (rt::socket-connect host port))
28 (let ((stream (rt::make-socket-stream socket :binaryp (not (eq element-type 'character)))))
29 (make-stream-socket :socket socket :stream stream)))
30 (:datagram
31 (error 'unsupported
32 :feature '(protocol :datagram)
33 :context 'socket-connect)))))
34
35 (defun socket-listen (host port
36 &key reuseaddress
37 (reuse-address nil reuse-address-supplied-p)
38 (backlog 5)
39 (element-type 'character))
40 (unimplemented 'socket-listen 'mocl))
41
42 (defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
43 (unimplemented 'socket-accept 'mocl))
44
45 ;; Sockets and their associated streams are modelled as
46 ;; different objects. Be sure to close the socket stream
47 ;; when closing stream-sockets; it makes sure buffers
48 ;; are flushed and the socket is closed correctly afterwards.
49 (defmethod socket-close ((usocket usocket))
50 "Close socket."
51 (rt::socket-shutdown usocket)
52 (rt::c-fclose usocket))
53
54 (defmethod socket-close ((usocket stream-usocket))
55 "Close socket."
56 (close (socket-stream usocket)))
57
58 ;; (defmethod socket-close :after ((socket datagram-usocket))
59 ;; (setf (%open-p socket) nil))
60
61 (defmethod socket-shutdown ((usocket stream-usocket) direction)
62 (declare (ignore usocket direction))
63 ;; sure would be nice if there was some documentation for mocl...
64 (unimplemented "shutdown" 'socket-shutdown))
65
66 ;; (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port)
67 ;; (let ((s (socket usocket))
68 ;; (host (if host (host-to-hbo host)))
69 ;; (real-buffer (if (zerop offset)
70 ;; buffer
71 ;; (subseq buffer offset (+ offset size)))))
72 ;; (multiple-value-bind (result errno)
73 ;; (ext:inet-socket-send-to s real-buffer size
74 ;; :remote-host host :remote-port port)
75 ;; (or result
76 ;; (mocl-map-socket-error errno :socket usocket)))))
77
78 ;; (defmethod socket-receive ((socket datagram-usocket) buffer length &key)
79 ;; (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
80 ;; (integer 0) ; size
81 ;; (unsigned-byte 32) ; host
82 ;; (unsigned-byte 16))) ; port
83 ;; (let ((s (socket socket)))
84 ;; (let ((real-buffer (or buffer
85 ;; (make-array length :element-type '(unsigned-byte 8))))
86 ;; (real-length (or length
87 ;; (length buffer))))
88 ;; (multiple-value-bind (result errno remote-host remote-port)
89 ;; (ext:inet-socket-receive-from s real-buffer real-length)
90 ;; (if result
91 ;; (values real-buffer result remote-host remote-port)
92 ;; (mocl-map-socket-error errno :socket socket))))))
93
94 ;; (defmethod get-local-name ((usocket usocket))
95 ;; (multiple-value-bind (address port)
96 ;; (with-mapped-conditions (usocket)
97 ;; (ext:get-socket-host-and-port (socket usocket)))
98 ;; (values (hbo-to-vector-quad address) port)))
99
100 ;; (defmethod get-peer-name ((usocket stream-usocket))
101 ;; (multiple-value-bind (address port)
102 ;; (with-mapped-conditions (usocket)
103 ;; (ext:get-peer-host-and-port (socket usocket)))
104 ;; (values (hbo-to-vector-quad address) port)))
105
106 ;; (defmethod get-local-address ((usocket usocket))
107 ;; (nth-value 0 (get-local-name usocket)))
108
109 ;; (defmethod get-peer-address ((usocket stream-usocket))
110 ;; (nth-value 0 (get-peer-name usocket)))
111
112 ;; (defmethod get-local-port ((usocket usocket))
113 ;; (nth-value 1 (get-local-name usocket)))
114
115 ;; (defmethod get-peer-port ((usocket stream-usocket))
116 ;; (nth-value 1 (get-peer-name usocket)))
117
118
119 ;; (defun get-host-by-address (address)
120 ;; (multiple-value-bind (host errno)
121 ;; (ext:lookup-host-entry (host-byte-order address))
122 ;; (cond (host
123 ;; (ext:host-entry-name host))
124 ;; (t
125 ;; (let ((condition (cdr (assoc errno +unix-ns-error-map+))))
126 ;; (cond (condition
127 ;; (error condition :host-or-ip address))
128 ;; (t
129 ;; (error 'ns-unknown-error :host-or-ip address
130 ;; :real-error errno))))))))
131
132 (defun get-hosts-by-name (name)
133 (rt::lookup-host name))
134
135 ;; (defun get-host-name ()
136 ;; (unix:unix-gethostname))
137
138
139 ;;
140 ;;
141 ;; WAIT-LIST part
142 ;;
143
144
145 (defun %add-waiter (wl waiter)
146 (declare (ignore wl waiter)))
147
148 (defun %remove-waiter (wl waiter)
149 (declare (ignore wl waiter)))
150
151 (defun %setup-wait-list (wl)
152 (declare (ignore wl)))
153
154 (defun wait-for-input-internal (wait-list &key timeout)
155 (unimplemented 'wait-for-input-internal 'mocl))