diff --git a/src/ex.lisp b/src/ex.lisp index 30f402e..14a94e8 100644 --- a/src/ex.lisp +++ b/src/ex.lisp @@ -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)))) diff --git a/src/io.lisp b/src/io.lisp index 73f620b..46c7de1 100644 --- a/src/io.lisp +++ b/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))) diff --git a/src/meta.lisp b/src/meta.lisp index 4096626..840ac2e 100644 --- a/src/meta.lisp +++ b/src/meta.lisp @@ -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 diff --git a/src/server.lisp b/src/server.lisp index ca34434..7dda08b 100644 --- a/src/server.lisp +++ b/src/server.lisp @@ -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)