jadedctrl/ facilservil
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Actions Packages Projects Eldonoj Wiki Activity

Refactoring, etc.

This commit is contained in:
Jaidyn Lev 2018-12-02 19:27:18 -06:00
parent 60e62e7146
commit a7f5301e87
7 changed files with 253 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
facilservil.asd
View File

@ -1,5 +1,5 @@
(defsystem "facilservil"
:version "0.1"
:version "0.2"
:author "Jaidyn Lev <jadedctrl@teknik.io>"
:license "CC0"
:depends-on ("usocket" "trivial-utf-8" "alexandria" "nih")

111
src/client.lisp
View File

@ -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

4
src/ex.lisp
View File

@ -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 ()

147
src/io.lisp
View File

@ -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*)))
(let* ((client-id (socket-to-client socket))
(input-stack (client-data-get client-id "input")))
(setf (gethash input-id *client-data*)
(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)
;; 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."
(client-broadcast string line-break
(ignore-errors (socket-to-client exception))))
;; SOCKET --> NIL
(defun socket-input-flush (socket)
"Clean all input from a socket."
(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*) '())))
(let ((client-id (socket-to-client socket)))
(client-data-set client-id "input" '())))
;; 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 --> STRING
(defun socket-input-string (socket)
"Get input from a socket as a string."
(client-input-string (socket-to-client socket)))
;; -------------------------------------
;; CLIENT I/O
;; 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 (socket) (client-write socket string line-break))
*client-socket-list*))
(lambda (client)
(if (not (eq client exception))
(client-write client string line-break)))
*client-list*))
;; SOCKET --> STRING
(defun client-input-string (socket)
;; NUMBER --> STRING
(defun client-input-string (client)
"Get input from a client 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*))
(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.
(defun remove-newline-bytes (bytes)
(remove 13 (remove 10 bytes)))
;; LIST --> LIST
(defun remove-newline-bytes (bytes)
"Remove undesired bytes-- null, LF, CR, etc, from a list of 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))))
(remove 0 (remove 10 (remove 13 bytes))))
(eq *command-byte* last-byte)))
;; 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)))

5
src/meta.lisp
View File

@ -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

27
src/package.lisp
View File

@ -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))

56
src/server.lisp
View File

@ -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... </3
('T
(let* ((socket-id (make-socket-id socket))
(client-id (gethash socket-id *socket-pairs*)))
;; execute user-provided #'disconnecting ;-;
(funcall disconnecting socket client-id)
(client-slaughter socket))))
(funcall disconnecting socket (socket-to-client socket))
(socket-slaughter socket))))
;; now, let's write that shit down
(standard-journaling)))
(standard-journaling))
;; unwind-protect's cleanup form:
;; if error, shut down gracefully.