diff --git a/facilservil.asd b/facilservil.asd index 2066d65..a61c1d0 100755 --- a/facilservil.asd +++ b/facilservil.asd @@ -1,5 +1,5 @@ (defsystem "facilservil" - :version "0.1" + :version "0.2" :author "Jaidyn Lev " :license "CC0" :depends-on ("usocket" "trivial-utf-8" "alexandria" "nih") diff --git a/src/client.lisp b/src/client.lisp index c7e86d6..5bdbb62 100644 --- a/src/client.lisp +++ b/src/client.lisp @@ -11,42 +11,83 @@ (random 999999)) ;; STRING --> STRING -(defun make-client-input-id (client-id) +(defun client-data-id (client-id data) "Make an 'input ID' from a client-id." - (format nil "~A-input" client-id)) + (format nil "~A-~A" client-id data)) -(defun make-client-output-id (client-id) - "Make an 'output ID' from a client-id." - (format nil "~A-output" client-id)) + +;; ------------------------------------- + + +;; SOCKET --> NUMBER +(defun socket-to-client (socket) + "Return the client of a socket." + (cadr (socket-pair socket))) + + +;; NUMBER --> SOCKET +(defun client-to-socket (client) + "Return the socket of a client." + (car (client-pair client))) + + + +;; NUMBER --> LIST +(defun client-pair (client) + "Return the '(socket client) pair of a client." + (nih:getf-cadr *socket-client* client)) + + +;; SOCKET --> LIST +(defun socket-pair (socket) + "Return the '(socket client) pair of a socket." + (nih:getf-car *socket-client* socket)) + + +;; ------------------------------------- + + +;; NUMBER STRING DATA --> NIL +(defun client-data-set (client data value) + "Set a piece of a `client`'s `data` to `value`." + + (setf + (gethash (client-data-id client data) *client-data*) + value)) + + +;; NUMBER STRING --> ??? +(defun client-data-get (client data) + "Get the value of a client's `data` from *client-data*." + (gethash (client-data-id client data) *client-data*)) + + +;; NUMBER STRING --> NIL +(defun client-data-rem (client data) + "Remove a piece of client's `data` from *client-data*." + (remhash (client-data-id client data) *client-data*)) ;; ------------------------------------- ;; SOCKET --> NIL -(defun client-register (socket) - "Register a new client; add their data to globals, log it, etc." +(defun socket-register (socket) + "Register a new socket; add their data to globals, log it, etc." - (let* ((client-id (make-client-id)) - (socket-id (make-socket-id socket)) - (output-id (make-client-output-id client-id)) - (input-id (make-client-input-id client-id))) + (let* ((client-id (make-client-id))) (setq *socket-list* (concatenate 'list *socket-list* (list socket))) - (setq *client-socket-list* (concatenate 'list *client-socket-list* - (list socket))) + (setq *socket-client* (concatenate 'list *socket-client* + (list (list socket client-id)))) + (setq *csocket-list* (concatenate 'list *csocket-list* + (list socket))) (setq - *client-list* - (concatenate 'list *client-list* (list client-id))) - (setf - (gethash client-id *client-pairs*) socket-id) - (setf - (gethash socket-id *socket-pairs*) client-id) - (setf - (gethash output-id *client-data*) '()) - (setf - (gethash input-id *client-data*) '()) + *client-list* (concatenate 'list *client-list* + (list client-id))) + + (client-data-set client-id "input" '()) (journal (format nil "Client ~A has connected!" client-id) "Connect"))) @@ -54,21 +95,23 @@ ;; ------------------------------------- -(defun client-slaughter (socket) +;; NUMBER --> NIL +(defun client-slaughter (client) + "Clean up data from client, and disconnect their socket." + (socket-slaughter (client-to-socket client))) + + +;; SOCKET --> NIL +(defun socket-slaughter (socket) "Clean up data from a client, and disconnect their socket." - (let* ((socket-id (make-socket-id socket)) - (client-id (gethash socket-id *socket-pairs*)) - (output-id (make-client-output-id client-id)) - (input-id (make-client-input-id client-id))) + (let* ((client-id (socket-to-client socket))) - (remhash socket-id *socket-pairs*) - (remhash client-id *client-pairs*) - (remhash client-id *client-data*) - (remhash input-id *client-data*) - (setq *client-list* (delete client-id *client-list*)) + (client-data-rem client-id "input") + (setq *socket-client* (delete (socket-pair socket) *socket-client*)) (setq *socket-list* (delete socket *socket-list*)) - (setq *client-socket-list* (delete socket *client-socket-list*)) + (setq *client-list* (delete client-id *client-list*)) + (setq *csocket-list* (delete socket *csocket-list*)) (usocket:socket-close socket) (journal diff --git a/src/ex.lisp b/src/ex.lisp index d47d891..30f402e 100644 --- a/src/ex.lisp +++ b/src/ex.lisp @@ -4,7 +4,7 @@ (defun connect-ex (socket client-id) "Example connection handler-- sends a friendly welcome message!" - (client-write socket + (client-write client-id (format nil "Hey, welcome to this server, ~A! <3" client-id) 'T)) @@ -30,7 +30,7 @@ (format nil "Sorry, I didn't hear that quite right.~%") (format nil "Did you say, \"~A?\"" reversed-input)))) - (client-write socket output-string 'T)))) + (client-write client-id output-string 'T)))) (defun halt-ex () diff --git a/src/io.lisp b/src/io.lisp index 1e32af7..73f620b 100644 --- a/src/io.lisp +++ b/src/io.lisp @@ -1,23 +1,25 @@ (in-package :facilservil) +;; ------------------------------------- +;; SOCKET I/O + + ;; SOCKET --> NIL -(defun client-read (socket) +(defun socket-read (socket) "Read new input from a client socket to its `stack` list of bytes." - (let* ((socket-id (make-socket-id socket)) - (client-id (gethash socket-id *socket-pairs*)) - (input-id (make-client-input-id client-id)) - (input-stack (gethash input-id *client-data*))) - - (setf (gethash input-id *client-data*) - (concatenate 'list input-stack - (list (read-byte (usocket:socket-stream socket))))))) + (let* ((client-id (socket-to-client socket)) + (input-stack (client-data-get client-id "input"))) + (client-data-set + client-id "input" + (concatenate 'list input-stack + (list (read-byte (usocket:socket-stream socket))))))) ;; SOCKET LIST/ARRAY --> NIL -(defun client-write-bytes (socket bytes) +(defun socket-write-bytes (socket bytes) "Write bytes to a client socket." (let ((sstream (usocket:socket-stream socket)) @@ -35,65 +37,128 @@ (force-output sstream))) - ;; SOCKET STRING [BOOLEAN] --> NIL -(defun client-write (socket string &optional (line-break nil)) - "Writes a string to a client socket-- w/o line-break, by default." +(defun socket-write (socket string &optional (line-break nil)) + "Writes a string to a socket-- w/o line-break, by default." - (client-write-bytes + (socket-write-bytes socket - (trivial-utf-8:string-to-utf-8-bytes + (tu8:string-to-utf-8-bytes (if line-break (format nil "~A~%" string) string)))) -;; SOCKET --> NIl -(defun client-input-flush (socket) - "Clean all input from a socket." +;; 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." - (let* ((socket-id (make-socket-id socket)) - (client-id (gethash socket-id *socket-pairs*)) - (input-id (make-client-input-id client-id))) - - (setf (gethash input-id *client-data*) '()))) + (client-broadcast string line-break + (ignore-errors (socket-to-client exception)))) -;; STRING BOOLEAN --> NIL -(defun client-broadcast (string &optional (line-break nil)) - "Writes a string to all client sockets-- w/o line-break, by default." + ;; SOCKET --> NIL + (defun socket-input-flush (socket) + "Clean all input from a socket." - (mapcar - (lambda (socket) (client-write socket string line-break)) - *client-socket-list*)) + (let ((client-id (socket-to-client socket))) + (client-data-set client-id "input" '()))) -;; SOCKET --> STRING -(defun client-input-string (socket) - "Get input from a client as a string." + ;; SOCKET --> STRING + (defun socket-input-string (socket) + "Get input from a socket as a string." - (let* ((socket-id (make-socket-id socket)) - (client-id (gethash socket-id *socket-pairs*)) - (input-id (make-client-input-id client-id)) - (input-bytes (gethash input-id *client-data*)) - (sanitized-bytes (remove-newline-bytes input-bytes))) - - (ignore-errors (trivial-utf-8:utf-8-bytes-to-string sanitized-bytes)))) + (client-input-string (socket-to-client socket))) - -;; ------------------------------------- - - - -(defun remove-newline-bytes (bytes) - (remove 13 (remove 10 bytes))) -(defun commandp (socket) - (let* ((socket-id (make-socket-id socket)) - (client-id (gethash socket-id *socket-pairs*)) - (input-id (make-client-input-id client-id)) - (input-bytes (gethash input-id *client-data*)) - (last-byte (car (last input-bytes)))) + ;; ------------------------------------- + ;; CLIENT I/O - (eq *command-byte* last-byte))) + + + ;; NUMBER --> NIL + (defun client-read (client) + "Read new input from a client to their stack of input bytes." + + (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)) + + (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." + + (socket-write (client-to-socket client) string line-break)) + + + ;; NUMBER --> NIL + (defun client-input-flush (client) + "Clean up input from a 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." + + (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." + + (let* ((input-bytes (client-data-get client "input")) + (sanitized-bytes (remove-newline-bytes input-bytes))) + + (ignore-errors (trivial-utf-8:utf-8-bytes-to-string sanitized-bytes)))) + + + + ;; ------------------------------------- + ;; MISC. + + + + ;; 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)))) + + + ;; 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)))) + + (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))) + (str2-u + (delete 0 (tu8:string-to-utf-8-bytes str2)))) + + (equalp str1-u str2-u))) diff --git a/src/meta.lisp b/src/meta.lisp index 7506b71..4096626 100644 --- a/src/meta.lisp +++ b/src/meta.lisp @@ -4,13 +4,14 @@ ;; DATA [STRING] --> STRING (defun journal (data &optional (name "unnamed")) "Print out a piece of data for logging on stdout." - (format t "~A | ~A~%" (force-string-length name 10) data)) (defun standard-journaling ()) +;; ------------------------------------- + ;; LIST --> STRING (defun print-bytes (bytes) @@ -18,7 +19,7 @@ (if bytes (format t "~A" - (ignore-errors (trivial-utf-8:utf-8-bytes-to-string bytes))))) + (ignore-errors (tu8:utf-8-bytes-to-string bytes))))) ;; STRING NUMBER [STRING} --> STRING diff --git a/src/package.lisp b/src/package.lisp index 1bef822..b680ca5 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,22 +1,38 @@ (defpackage :facilservil (:use :cl) + (:nicknames :fs) (:export + *socket-client* + *socket-list* - *socket-pairs* + *csocket-list* *client-list* - *client-pairs* *client-data* - *client-socket-list* :journal :client-write :cline-write-bytes :client-broadcast + :client-read :client-slaughter + :socket-write + :socket-write-bytes + :socket-broadcast + :socket-read + :socket-register + :socket-slaughter + + :client-data-get + :client-data-set + :client-data-rem + + :socket-to-client + :client-to-socket + :connect-ex :disconnect-ex :input-handle-ex @@ -28,6 +44,11 @@ :server-shutdown :server-reboot + :strequal + :server)) (in-package :facilservil) + + +(rename-package :trivial-utf-8 :trivial-utf-8 (list :tu8)) diff --git a/src/server.lisp b/src/server.lisp index f2c37bf..ca34434 100644 --- a/src/server.lisp +++ b/src/server.lisp @@ -1,27 +1,27 @@ (in-package :facilservil) ;; ------------------------------------- -;; GLOAL VARIABLES +;; GLOBAL VARIABLES -(defvar *socket-list* '()) -(defvar *socket-pairs* '()) +(defvar *socket-client* '()) (defvar *client-list* '()) -(defvar *client-socket-list* '()) -(defvar *client-pairs* '()) (defvar *client-data* '()) -(defvar *command-byte* 10) +(defvar *socket-list* '()) +(defvar *csocket-list* '()) + (defun reset-globals () "Set all global variables to default state." - (setq *socket-pairs* (make-hash-table :test 'equal)) - (setq *client-list* '()) - (setq *client-socket-list* '()) - (setq *client-pairs* (make-hash-table :test 'equal)) + (setq *socket-client* '()) ;; list correlating client IDs and sockets + + (setq *client-list* '()) ;; list of client (ID numbers) (setq *client-data* (make-hash-table :test 'equal)) - (setq *command-byte* 10)) + + (setq *socket-list* '()) ;; all sockets + (setq *csocket-list* '())) ;; all sockets except for master socket ;; ------------------------------------- @@ -48,9 +48,8 @@ (let* ((master-socket (usocket:socket-listen host port :reuse-address 'T - :element-type '(unsigned-byte 8)))) + :element-type 'unsigned-byte ))) (reset-globals) - (setq *command-byte* command-byte) (setq *socket-list* (list master-socket)) (unwind-protect @@ -66,40 +65,37 @@ (let ((new-socket (usocket:socket-accept socket))) ;; add data to client-pairs, socket-pairs, client-data vv - (client-register new-socket) + (socket-register new-socket) ;; execute user-provided #'connecting ^-^ - (let* ((socket-id (make-socket-id new-socket)) - (client-id (gethash socket-id *socket-pairs*))) - (funcall connecting new-socket client-id)))) + (funcall connecting new-socket (socket-to-client new-socket)))) ;; ...if functioning old connection... ((listen (usocket:socket-stream socket)) - (progn (client-read socket) + (progn (socket-read socket) ;; check if command is complete-- if so, use user-provided ;; input-handler. - (let* ((socket-id (make-socket-id socket)) - (client-id (gethash socket-id *socket-pairs*)) - (client-input (client-input-string socket))) + (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 socket) - (progn (funcall input-handler socket client-id client-input) - (client-input-flush socket)))))) + (if (commandp client-bytes command-byte) + (progn + (funcall input-handler socket client-id client-input) + (socket-input-flush socket)))))) ;; ...if EOF connection or error...