Abstract socket-verification
This commit is contained in:
parent
9696ecb825
commit
1b7120486a
23
src/io.lisp
23
src/io.lisp
|
@ -11,7 +11,6 @@
|
||||||
|
|
||||||
(let* ((client-id (socket-to-client socket))
|
(let* ((client-id (socket-to-client socket))
|
||||||
(input-stack (client-data-get client-id "input")))
|
(input-stack (client-data-get client-id "input")))
|
||||||
|
|
||||||
(client-data-set
|
(client-data-set
|
||||||
client-id "input"
|
client-id "input"
|
||||||
(concatenate 'list input-stack
|
(concatenate 'list input-stack
|
||||||
|
@ -24,7 +23,6 @@
|
||||||
|
|
||||||
(let ((sstream (usocket:socket-stream socket))
|
(let ((sstream (usocket:socket-stream socket))
|
||||||
(i 0))
|
(i 0))
|
||||||
|
|
||||||
(loop
|
(loop
|
||||||
:while (< i (length bytes))
|
:while (< i (length bytes))
|
||||||
:do
|
:do
|
||||||
|
@ -43,11 +41,12 @@
|
||||||
|
|
||||||
(socket-write-bytes
|
(socket-write-bytes
|
||||||
socket
|
socket
|
||||||
|
(ignore-errors
|
||||||
(babel:string-to-octets
|
(babel:string-to-octets
|
||||||
(if line-break
|
(if line-break
|
||||||
(format nil "~A~%" string)
|
(format nil "~A~%" string)
|
||||||
string)
|
string)
|
||||||
:encoding :utf-8)))
|
:encoding :utf-8))))
|
||||||
|
|
||||||
|
|
||||||
;; STRING [BOOLEAN] [SOCKET] --> NIL
|
;; STRING [BOOLEAN] [SOCKET] --> NIL
|
||||||
|
@ -138,6 +137,14 @@
|
||||||
:initial-contents list
|
:initial-contents list
|
||||||
:element-type '(unsigned-byte 8)))
|
:element-type '(unsigned-byte 8)))
|
||||||
|
|
||||||
|
|
||||||
|
;; -------------------------------------
|
||||||
|
|
||||||
|
;; SOCKET --> BOOLEAN
|
||||||
|
(defun socket-connectp (socket)
|
||||||
|
"Return whether or not a socket is still connected."
|
||||||
|
(listen (usocket:socket-stream socket)))
|
||||||
|
|
||||||
;; -------------------------------------
|
;; -------------------------------------
|
||||||
;; MISC.
|
;; MISC.
|
||||||
|
|
||||||
|
@ -159,13 +166,3 @@
|
||||||
(eq command-byte last-byte)))
|
(eq command-byte last-byte)))
|
||||||
|
|
||||||
|
|
||||||
;; STRING STRING
|
|
||||||
(defun strequal (str1 str2)
|
|
||||||
"Returns whether or not strings are equal-- in their UTF bytes."
|
|
||||||
|
|
||||||
(let ((str1-u
|
|
||||||
(delete 0 (tu8:string-to-utf-8-bytes str1 :encoding :utf-8)))
|
|
||||||
(str2-u
|
|
||||||
(delete 0 (tu8:string-to-utf-8-bytes str2 :encoding :utf-8))))
|
|
||||||
|
|
||||||
(equalp str1-u str2-u)))
|
|
||||||
|
|
|
@ -30,7 +30,7 @@
|
||||||
;; STRING NUMBER CHARACTER FUNCTION-NAME FUNCTION-NAME FUNCTION-NAME --> NIL
|
;; STRING NUMBER CHARACTER FUNCTION-NAME FUNCTION-NAME FUNCTION-NAME --> NIL
|
||||||
(defun server
|
(defun server
|
||||||
(host port connecting disconnecting input-handler
|
(host port connecting disconnecting input-handler
|
||||||
&key (command-byte 10) (halting 'halt-ex))
|
&key (command-byte 10) (halting 'halt-ex) (init 'blank))
|
||||||
|
|
||||||
"Runs the basic server on `host`:`port`, running `connecting` when a new
|
"Runs the basic server on `host`:`port`, running `connecting` when a new
|
||||||
client connects, `disconnecting` when one disconnects, and `input-handler`
|
client connects, `disconnecting` when one disconnects, and `input-handler`
|
||||||
|
@ -52,6 +52,8 @@
|
||||||
(reset-globals)
|
(reset-globals)
|
||||||
(setq *socket-list* (list master-socket))
|
(setq *socket-list* (list master-socket))
|
||||||
|
|
||||||
|
(funcall init)
|
||||||
|
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(loop
|
(loop
|
||||||
(loop
|
(loop
|
||||||
|
@ -72,7 +74,7 @@
|
||||||
|
|
||||||
|
|
||||||
;; ...if functioning old connection...
|
;; ...if functioning old connection...
|
||||||
((listen (usocket:socket-stream socket))
|
((socket-connectp socket)
|
||||||
(progn (socket-read socket)
|
(progn (socket-read socket)
|
||||||
;; check if command is complete-- if so, use user-provided
|
;; check if command is complete-- if so, use user-provided
|
||||||
;; input-handler.
|
;; input-handler.
|
||||||
|
@ -128,3 +130,6 @@
|
||||||
(server host port connecting disconnecting input-handler
|
(server host port connecting disconnecting input-handler
|
||||||
:command-byte command-byte
|
:command-byte command-byte
|
||||||
:halting halting))
|
:halting halting))
|
||||||
|
|
||||||
|
|
||||||
|
(defun blank ())
|
||||||
|
|
Ŝarĝante…
Reference in New Issue