Less verbosity, tweaks
This commit is contained in:
parent
a7f5301e87
commit
9696ecb825
|
@ -21,7 +21,7 @@
|
|||
(defun input-handle-ex (socket client-id input-string)
|
||||
"Example input-handler. Reverses user input and sends it back at them!"
|
||||
|
||||
(if input-string
|
||||
(if (< 0 (length input-string))
|
||||
(let* ((reversed-input
|
||||
(nih:char-string (reverse (nih:char-list input-string))))
|
||||
|
||||
|
|
143
src/io.lisp
143
src/io.lisp
|
@ -43,122 +43,129 @@
|
|||
|
||||
(socket-write-bytes
|
||||
socket
|
||||
(tu8:string-to-utf-8-bytes
|
||||
(babel:string-to-octets
|
||||
(if line-break
|
||||
(format nil "~A~%" string)
|
||||
string))))
|
||||
string)
|
||||
:encoding :utf-8)))
|
||||
|
||||
|
||||
;; STRING [BOOLEAN] [SOCKET] --> NIL
|
||||
(defun socket-broadcast (string &optional (line-break nil) (exception nil))
|
||||
"Writes a `string` to all client sockets (aside from an `exception`--
|
||||
w/o line-break, by default."
|
||||
"Writes a `string` to all client sockets (aside from an `exception`)."
|
||||
|
||||
(client-broadcast string line-break
|
||||
(ignore-errors (socket-to-client exception))))
|
||||
(client-broadcast string line-break
|
||||
(socket-to-client exception)))
|
||||
|
||||
|
||||
;; SOCKET --> NIL
|
||||
(defun socket-input-flush (socket)
|
||||
"Clean all input from a socket."
|
||||
;; SOCKET --> NIL
|
||||
(defun socket-input-flush (socket)
|
||||
"Clean all input from a socket."
|
||||
|
||||
(let ((client-id (socket-to-client socket)))
|
||||
(client-data-set client-id "input" '())))
|
||||
(let ((client-id (socket-to-client socket)))
|
||||
(client-data-set client-id "input" '())))
|
||||
|
||||
|
||||
;; SOCKET --> STRING
|
||||
(defun socket-input-string (socket)
|
||||
"Get input from a socket as a string."
|
||||
;; SOCKET --> STRING
|
||||
(defun socket-input-string (socket)
|
||||
"Get input from a socket as a string."
|
||||
|
||||
(client-input-string (socket-to-client socket)))
|
||||
(client-input-string (socket-to-client socket)))
|
||||
|
||||
|
||||
|
||||
;; -------------------------------------
|
||||
;; CLIENT I/O
|
||||
;; -------------------------------------
|
||||
;; CLIENT I/O
|
||||
|
||||
|
||||
|
||||
;; NUMBER --> NIL
|
||||
(defun client-read (client)
|
||||
"Read new input from a client to their stack of input bytes."
|
||||
;; NUMBER --> NIL
|
||||
(defun client-read (client)
|
||||
"Read new input from a client to their stack of input bytes."
|
||||
|
||||
(socket-read (client-to-socket client)))
|
||||
(socket-read (client-to-socket client)))
|
||||
|
||||
|
||||
;; NUMBER LIST --> NIL
|
||||
(defun client-write-bytes (client bytes)
|
||||
"Write bytes to a client's socket."
|
||||
(format t "CLIENT-TO-SOCKET: " (client-to-socket client))
|
||||
;; NUMBER LIST --> NIL
|
||||
(defun client-write-bytes (client bytes)
|
||||
"Write bytes to a client's socket."
|
||||
(format t "CLIENT-TO-SOCKET: " (client-to-socket client))
|
||||
|
||||
(socket-write-bytes (client-to-socket client) bytes))
|
||||
(socket-write-bytes (client-to-socket client) bytes))
|
||||
|
||||
|
||||
;; NUMBER STRING [BOOLEAN] --> NIL
|
||||
(defun client-write (client string &optional (line-break nil))
|
||||
"Writes a string to a client's socket-- w/o line-break, default."
|
||||
;; NUMBER STRING [BOOLEAN] --> NIL
|
||||
(defun client-write (client string &optional (line-break nil))
|
||||
"Writes a string to a client's socket-- w/o line-break, default."
|
||||
|
||||
(socket-write (client-to-socket client) string line-break))
|
||||
(socket-write (client-to-socket client) string line-break))
|
||||
|
||||
|
||||
;; NUMBER --> NIL
|
||||
(defun client-input-flush (client)
|
||||
"Clean up input from a client."
|
||||
;; NUMBER --> NIL
|
||||
(defun client-input-flush (client)
|
||||
"Clean up input from a client."
|
||||
|
||||
(socket-input-flush (client-to-socket client)))
|
||||
(socket-input-flush (client-to-socket client)))
|
||||
|
||||
|
||||
;; STRING [BOOLEAN] [SOCKET] --> NIL
|
||||
(defun client-broadcast (string &optional (line-break nil) (exception nil))
|
||||
"Writes a `string` to all client sockets (aside from an `exception`--
|
||||
w/o line-break, by default."
|
||||
;; STRING [BOOLEAN] [SOCKET] --> NIL
|
||||
(defun client-broadcast (string &optional (line-break nil) (exception nil))
|
||||
"Writes a `string` to all client sockets (aside from an `exception`-- w/o line-break, by default."
|
||||
|
||||
(mapcar
|
||||
(lambda (client)
|
||||
(if (not (eq client exception))
|
||||
(client-write client string line-break)))
|
||||
*client-list*))
|
||||
(mapcar
|
||||
(lambda (client)
|
||||
(if (not (eq client exception))
|
||||
(client-write client string line-break)))
|
||||
*client-list*))
|
||||
|
||||
|
||||
;; NUMBER --> STRING
|
||||
(defun client-input-string (client)
|
||||
"Get input from a client as a string."
|
||||
;; NUMBER --> STRING
|
||||
(defun client-input-string (client)
|
||||
"Get input from a client as a string."
|
||||
|
||||
(let* ((input-bytes (client-data-get client "input"))
|
||||
(sanitized-bytes (remove-newline-bytes input-bytes)))
|
||||
(let* ((input-bytes (client-data-get client "input"))
|
||||
(sanitized-bytes (remove-newline-bytes input-bytes))
|
||||
(byte-vector (list-to-byte-vector sanitized-bytes)))
|
||||
|
||||
(ignore-errors (trivial-utf-8:utf-8-bytes-to-string sanitized-bytes))))
|
||||
(if sanitized-bytes
|
||||
(ignore-errors (babel:octets-to-string byte-vector :encoding :utf-8))
|
||||
"")))
|
||||
|
||||
|
||||
|
||||
;; -------------------------------------
|
||||
;; MISC.
|
||||
(defun list-to-byte-vector (list)
|
||||
(make-array (list (length list))
|
||||
:initial-contents list
|
||||
:element-type '(unsigned-byte 8)))
|
||||
|
||||
;; -------------------------------------
|
||||
;; MISC.
|
||||
|
||||
|
||||
|
||||
;; LIST --> LIST
|
||||
(defun remove-newline-bytes (bytes)
|
||||
"Remove undesired bytes-- null, LF, CR, etc, from a list of bytes."
|
||||
;; LIST --> LIST
|
||||
(defun remove-newline-bytes (bytes)
|
||||
"Remove undesired bytes-- null, LF, CR, etc, from a list of bytes."
|
||||
|
||||
(remove 0 (remove 10 (remove 13 bytes))))
|
||||
(remove 0 (remove 10 (remove 13 bytes))))
|
||||
|
||||
|
||||
;; SOCKET
|
||||
(defun commandp (byte-list command-byte)
|
||||
"Returns whether or not a command is complete, judging on it's bytes."
|
||||
;; SOCKET
|
||||
(defun commandp (byte-list command-byte)
|
||||
"Returns whether or not a command is complete, judging on it's bytes."
|
||||
|
||||
(let* ((last-byte (car (last byte-list))))
|
||||
(let* ((last-byte (car (last byte-list))))
|
||||
|
||||
(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."
|
||||
;; 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)))
|
||||
(str2-u
|
||||
(delete 0 (tu8:string-to-utf-8-bytes str2))))
|
||||
(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)))
|
||||
(equalp str1-u str2-u)))
|
||||
|
|
|
@ -2,9 +2,13 @@
|
|||
|
||||
|
||||
;; DATA [STRING] --> STRING
|
||||
(defun journal (data &optional (name "unnamed"))
|
||||
(defun journal (data &optional (name "unnamed") (second-name "-"))
|
||||
"Print out a piece of data for logging on stdout."
|
||||
(format t "~A | ~A~%" (force-string-length name 10) data))
|
||||
(format t "~A | ~A | ~A | ~A~%"
|
||||
(string-date (get-universal-time))
|
||||
(force-string-length name 10)
|
||||
(force-string-length second-name 10)
|
||||
data))
|
||||
|
||||
|
||||
(defun standard-journaling ())
|
||||
|
@ -13,13 +17,29 @@
|
|||
;; -------------------------------------
|
||||
|
||||
|
||||
(defun string-date (universal-time)
|
||||
(multiple-value-bind (second minute hour day month year)
|
||||
(decode-universal-time universal-time)
|
||||
|
||||
(nih:string-combine
|
||||
(nih:string-combine year (make-digits month 2) (make-digits day 2)
|
||||
:seperator "-")
|
||||
" "
|
||||
(nih:string-combine (make-digits hour 2) (make-digits minute 2)
|
||||
(make-digits second 2) :seperator ":"))))
|
||||
|
||||
|
||||
(defun make-digits (string number)
|
||||
(nih:min-string-length string number :prefix "0"))
|
||||
|
||||
|
||||
;; LIST --> STRING
|
||||
(defun print-bytes (bytes)
|
||||
"Print a list of (UTF-8) bytes as a string to stdout."
|
||||
|
||||
(if bytes
|
||||
(format t "~A"
|
||||
(ignore-errors (tu8:utf-8-bytes-to-string bytes)))))
|
||||
(ignore-errors (babel:octets-to-string bytes :encoding :utf-8)))))
|
||||
|
||||
|
||||
;; STRING NUMBER [STRING} --> STRING
|
||||
|
|
|
@ -48,7 +48,7 @@
|
|||
(let* ((master-socket
|
||||
(usocket:socket-listen host port
|
||||
:reuse-address 'T
|
||||
:element-type 'unsigned-byte )))
|
||||
:element-type '(unsigned-byte 8))))
|
||||
(reset-globals)
|
||||
(setq *socket-list* (list master-socket))
|
||||
|
||||
|
@ -79,7 +79,6 @@
|
|||
(let* ((client-id (socket-to-client socket))
|
||||
(client-bytes (client-data-get client-id "input"))
|
||||
(client-input (client-input-string client-id)))
|
||||
(journal client-input "Client Input")
|
||||
|
||||
;; if reached *command-byte*, handle and flush input
|
||||
(if (commandp client-bytes command-byte)
|
||||
|
|
Ŝarĝante…
Reference in New Issue