clasp.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
---
clasp.lisp (5221B)
---
1 (in-package :usocket)
2
3 #-clasp
4 (progn
5 #-:wsock
6 (ffi:clines
7 "#include <errno.h>"
8 "#include <sys/socket.h>"
9 "#include <unistd.h>")
10 #+:wsock
11 (ffi:clines
12 "#ifndef FD_SETSIZE"
13 "#define FD_SETSIZE 1024"
14 "#endif"
15 "#include <winsock2.h>")
16 (ffi:clines
17 #+:msvc "#include <time.h>"
18 #-:msvc "#include <sys/time.h>"
19 "#include <ecl/ecl-inl.h>"))
20 (progn
21 #-clasp
22 (defun cerrno ()
23 (ffi:c-inline () () :int
24 "errno" :one-liner t))
25 #+clasp
26 (defun cerrno ()
27 (sockets-internal:errno))
28
29 #-clasp
30 (defun fd-setsize ()
31 (ffi:c-inline () () :fixnum
32 "FD_SETSIZE" :one-liner t))
33 #+clasp
34 (defun fd-setsize () (sockets-internal:fd-setsize))
35
36 #-clasp
37 (defun fdset-alloc ()
38 (ffi:c-inline () () :pointer-void
39 "ecl_alloc_atomic(sizeof(fd_set))" :one-liner t))
40 #+clasp (defun fdset-alloc () (sockets-internal::alloc-atomic-sizeof-fd-set))
41
42 #-clasp
43 (defun fdset-zero (fdset)
44 (ffi:c-inline (fdset) (:pointer-void) :void
45 "FD_ZERO((fd_set*)#0)" :one-liner t))
46 #+clasp(defun fdset-zero (fdset) (sockets-internal:fdset-zero fdset))
47
48 #-clasp
49 (defun fdset-set (fdset fd)
50 (ffi:c-inline (fdset fd) (:pointer-void :fixnum) :void
51 "FD_SET(#1,(fd_set*)#0)" :one-liner t))
52 #+clasp(defun fdset-set (fdset fd) (sockets-internal:fdset-set fd fdset))
53
54 #-clasp
55 (defun fdset-clr (fdset fd)
56 (ffi:c-inline (fdset fd) (:pointer-void :fixnum) :void
57 "FD_CLR(#1,(fd_set*)#0)" :one-liner t))
58 #+clasp(defun fdset-clr (fdset fd) (sockets-internal:fdset-clr fd fdset))
59
60 #-clasp
61 (defun fdset-fd-isset (fdset fd)
62 (ffi:c-inline (fdset fd) (:pointer-void :fixnum) :bool
63 "FD_ISSET(#1,(fd_set*)#0)" :one-liner t))
64 #+clasp(defun fdset-fd-isset (fdset fd) (sockets-internal:fdset-isset fd fdset))
65
66 (declaim (inline cerrno
67 fd-setsize
68 fdset-alloc
69 fdset-zero
70 fdset-set
71 fdset-clr
72 fdset-fd-isset))
73 #-clasp
74 (defun get-host-name ()
75 (ffi:c-inline
76 () () :object
77 "{ char *buf = (char *) ecl_alloc_atomic(257);
78
79 if (gethostname(buf,256) == 0)
80 @(return) = make_simple_base_string(buf);
81 else
82 @(return) = Cnil;
83 }" :one-liner nil :side-effects nil))
84
85 #+clasp
86 (defun get-host-name ()
87 (sockets-internal:get-host-name))
88
89 #-clasp
90 (defun read-select (wl to-secs &optional (to-musecs 0))
91 (let* ((sockets (wait-list-waiters wl))
92 (rfds (wait-list-%wait wl))
93 (max-fd (reduce #'(lambda (x y)
94 (let ((sy (sb-bsd-sockets:socket-file-descriptor
95 (socket y))))
96 (if (< x sy) sy x)))
97 (cdr sockets)
98 :initial-value (sb-bsd-sockets:socket-file-descriptor
99 (socket (car sockets))))))
100 (fdset-zero rfds)
101 (dolist (sock sockets)
102 (fdset-set rfds (sb-bsd-sockets:socket-file-descriptor
103 (socket sock))))
104 (let ((count
105 (ffi:c-inline (to-secs to-musecs rfds max-fd)
106 (t :unsigned-int :pointer-void :int)
107 :int
108 "
109 int count;
110 struct timeval tv;
111
112 if (#0 != Cnil) {
113 tv.tv_sec = fixnnint(#0);
114 tv.tv_usec = #1;
115 }
116 @(return) = select(#3 + 1, (fd_set*)#2, NULL, NULL,
117 (#0 != Cnil) ? &tv : NULL);
118 " :one-liner nil)))
119 (cond
120 ((= 0 count)
121 (values nil nil))
122 ((< count 0)
123 ;; check for EINTR and EAGAIN; these should not err
124 (values nil (cerrno)))
125 (t
126 (dolist (sock sockets)
127 (when (fdset-fd-isset rfds (sb-bsd-sockets:socket-file-descriptor
128 (socket sock)))
129 (setf (state sock) :READ))))))))
130
131 #+clasp
132 (defun read-select (wl to-secs &optional (to-musecs 0))
133 (let* ((sockets (wait-list-waiters wl))
134 (rfds (wait-list-%wait wl))
135 (max-fd (reduce #'(lambda (x y)
136 (let ((sy (sb-bsd-sockets:socket-file-descriptor
137 (socket y))))
138 (if (< x sy) sy x)))
139 (cdr sockets)
140 :initial-value (sb-bsd-sockets:socket-file-descriptor
141 (socket (car sockets))))))
142 (fdset-zero rfds)
143 (dolist (sock sockets)
144 (fdset-set rfds (sb-bsd-sockets:socket-file-descriptor
145 (socket sock))))
146 (let ((count (sockets-internal:do-select to-secs to-musecs rfds max-fd)))
147 (cond
148 ((= 0 count)
149 (values nil nil))
150 ((< count 0)
151 ;; check for EINTR and EAGAIN; these should not err
152 (values nil (cerrno)))
153 (t
154 (dolist (sock sockets)
155 (when (fdset-fd-isset rfds (sb-bsd-sockets:socket-file-descriptor
156 (socket sock)))
157 (setf (state sock) :READ))))))))
158 )