Browse code

Refactoring, etc.

Jaidyn Lev authored on 2018-12-03 01:27:18
Showing 7 changed files
... ...
@@ -1,5 +1,5 @@
1 1
 (defsystem "facilservil"
2
-  :version "0.1"
2
+  :version "0.2"
3 3
   :author "Jaidyn Lev <jadedctrl@teknik.io>"
4 4
   :license "CC0"
5 5
   :depends-on ("usocket" "trivial-utf-8" "alexandria" "nih")
... ...
@@ -11,42 +11,83 @@
11 11
   (random 999999))
12 12
 
13 13
 ;; STRING --> STRING
14
-(defun make-client-input-id (client-id)
14
+(defun client-data-id (client-id data)
15 15
   "Make an 'input ID' from a client-id."
16
-  (format nil "~A-input" client-id))
16
+  (format nil "~A-~A" client-id data))
17
+
18
+
19
+;; -------------------------------------
20
+
21
+
22
+;; SOCKET --> NUMBER
23
+(defun socket-to-client (socket)
24
+  "Return the client of a socket."
25
+  (cadr (socket-pair socket)))
26
+
27
+
28
+;; NUMBER --> SOCKET
29
+(defun client-to-socket (client)
30
+  "Return the socket of a client."
31
+  (car (client-pair client)))
17 32
 
18
-(defun make-client-output-id (client-id)
19
-  "Make an 'output ID' from a client-id."
20
-  (format nil "~A-output" client-id))
33
+
34
+
35
+;; NUMBER --> LIST
36
+(defun client-pair (client)
37
+  "Return the '(socket client) pair of a client."
38
+  (nih:getf-cadr *socket-client* client))
39
+
40
+
41
+;; SOCKET --> LIST
42
+(defun socket-pair (socket)
43
+  "Return the '(socket client) pair of a socket."
44
+  (nih:getf-car *socket-client* socket))
45
+
46
+
47
+;; -------------------------------------
48
+
49
+
50
+;; NUMBER STRING DATA --> NIL
51
+(defun client-data-set (client data value)
52
+  "Set a piece of a `client`'s `data` to `value`."
53
+
54
+  (setf
55
+    (gethash (client-data-id client data) *client-data*)
56
+    value))
57
+
58
+
59
+;; NUMBER STRING --> ???
60
+(defun client-data-get (client data)
61
+  "Get the value of a client's `data` from *client-data*."
62
+  (gethash (client-data-id client data) *client-data*))
63
+
64
+
65
+;; NUMBER STRING --> NIL
66
+(defun client-data-rem (client data)
67
+  "Remove a piece of client's `data` from *client-data*."
68
+  (remhash (client-data-id client data) *client-data*))
21 69
 
22 70
 
23 71
 ;; -------------------------------------
24 72
 
25 73
 
26 74
 ;; SOCKET --> NIL
27
-(defun client-register (socket)
28
-  "Register a new client; add their data to globals, log it, etc."
75
+(defun socket-register (socket)
76
+  "Register a new socket; add their data to globals, log it, etc."
29 77
 
30
-  (let* ((client-id (make-client-id))
31
-	 (socket-id (make-socket-id socket))
32
-	 (output-id (make-client-output-id client-id))
33
-	 (input-id (make-client-input-id client-id)))
78
+  (let* ((client-id (make-client-id)))
34 79
 
35 80
     (setq *socket-list* (concatenate 'list *socket-list* (list socket)))
36
-    (setq *client-socket-list* (concatenate 'list *client-socket-list*
37
-					    (list socket)))
38 81
 
82
+    (setq *socket-client* (concatenate 'list *socket-client*
83
+				       (list (list socket client-id))))
84
+    (setq *csocket-list* (concatenate 'list *csocket-list*
85
+				      (list socket)))
39 86
     (setq
40
-      *client-list*
41
-      (concatenate 'list *client-list* (list client-id)))
42
-    (setf
43
-      (gethash client-id *client-pairs*) socket-id)
44
-    (setf
45
-      (gethash socket-id *socket-pairs*) client-id)
46
-    (setf
47
-      (gethash output-id *client-data*) '())
48
-    (setf
49
-      (gethash input-id *client-data*) '())
87
+      *client-list* (concatenate 'list *client-list*
88
+				 (list client-id)))
89
+
90
+    (client-data-set client-id "input" '())
50 91
 
51 92
     (journal (format nil "Client ~A has connected!" client-id) "Connect")))
52 93
 
... ...
@@ -54,21 +95,23 @@
54 95
 ;; -------------------------------------
55 96
 
56 97
 
57
-(defun client-slaughter (socket)
98
+;; NUMBER --> NIL
99
+(defun client-slaughter (client)
100
+  "Clean up data from client, and disconnect their socket."
101
+  (socket-slaughter (client-to-socket client)))
102
+
103
+
104
+;; SOCKET --> NIL
105
+(defun socket-slaughter (socket)
58 106
   "Clean up data from a client, and disconnect their socket."
59 107
 
60
-  (let* ((socket-id (make-socket-id socket))
61
-	 (client-id (gethash socket-id *socket-pairs*))
62
-	 (output-id (make-client-output-id client-id))
63
-	 (input-id (make-client-input-id client-id)))
108
+  (let* ((client-id (socket-to-client socket)))
64 109
 
65
-    (remhash socket-id *socket-pairs*)
66
-    (remhash client-id *client-pairs*)
67
-    (remhash client-id *client-data*)
68
-    (remhash input-id *client-data*)
69
-    (setq *client-list* (delete client-id *client-list*))
110
+    (client-data-rem client-id "input")
111
+    (setq *socket-client* (delete (socket-pair socket) *socket-client*))
70 112
     (setq *socket-list* (delete socket *socket-list*))
71
-    (setq *client-socket-list* (delete socket *client-socket-list*))
113
+    (setq *client-list* (delete client-id *client-list*))
114
+    (setq *csocket-list* (delete socket *csocket-list*))
72 115
 
73 116
     (usocket:socket-close socket)
74 117
     (journal
... ...
@@ -4,7 +4,7 @@
4 4
 (defun connect-ex (socket client-id)
5 5
   "Example connection handler-- sends a friendly welcome message!"
6 6
 
7
-  (client-write socket
7
+  (client-write client-id
8 8
 		(format nil "Hey, welcome to this server, ~A! <3" client-id)
9 9
 		'T))
10 10
 
... ...
@@ -30,7 +30,7 @@
30 30
 	       (format nil "Sorry, I didn't hear that quite right.~%")
31 31
 	       (format nil "Did you say, \"~A?\"" reversed-input))))
32 32
 
33
-      (client-write socket output-string 'T))))
33
+      (client-write client-id output-string 'T))))
34 34
 
35 35
 
36 36
 (defun halt-ex ()
... ...
@@ -1,23 +1,25 @@
1 1
 (in-package :facilservil)
2 2
 
3 3
 
4
+;; -------------------------------------
5
+;; SOCKET I/O
6
+
7
+
4 8
 ;; SOCKET --> NIL
5
-(defun client-read (socket)
9
+(defun socket-read (socket)
6 10
   "Read new input from a client socket to its `stack` list of bytes."
7 11
 
8
-  (let* ((socket-id   (make-socket-id socket))
9
-	 (client-id   (gethash socket-id *socket-pairs*))
10
-	 (input-id    (make-client-input-id client-id))
11
-	 (input-stack (gethash input-id *client-data*)))
12
-
13
-    (setf (gethash input-id *client-data*)
14
-	  (concatenate 'list input-stack
15
-		       (list (read-byte (usocket:socket-stream socket)))))))
12
+  (let* ((client-id   (socket-to-client socket))
13
+	 (input-stack (client-data-get client-id "input")))
16 14
 
15
+    (client-data-set
16
+      client-id "input"
17
+      (concatenate 'list input-stack
18
+		   (list (read-byte (usocket:socket-stream socket)))))))
17 19
 
18 20
 
19 21
 ;; SOCKET LIST/ARRAY --> NIL
20
-(defun client-write-bytes (socket bytes)
22
+(defun socket-write-bytes (socket bytes)
21 23
   "Write bytes to a client socket."
22 24
 
23 25
   (let ((sstream (usocket:socket-stream socket))
... ...
@@ -35,65 +37,128 @@
35 37
     (force-output sstream)))
36 38
 
37 39
 
38
-
39 40
 ;; SOCKET STRING [BOOLEAN] --> NIL
40
-(defun client-write (socket string &optional (line-break nil))
41
-  "Writes a string to a client socket-- w/o line-break, by default."
41
+(defun socket-write (socket string &optional (line-break nil))
42
+  "Writes a string to a socket-- w/o line-break, by default."
42 43
 
43
-  (client-write-bytes
44
+  (socket-write-bytes
44 45
     socket
45
-    (trivial-utf-8:string-to-utf-8-bytes
46
+    (tu8:string-to-utf-8-bytes
46 47
       (if line-break
47 48
 	(format nil "~A~%" string)
48 49
 	string))))
49 50
 
50 51
 
51
-;; SOCKET --> NIl
52
-(defun client-input-flush (socket)
53
-  "Clean all input from a socket."
52
+;; STRING [BOOLEAN] [SOCKET] --> NIL
53
+(defun socket-broadcast (string &optional (line-break nil) (exception nil))
54
+  "Writes a `string` to all client sockets (aside from an `exception`--
55
+						  w/o line-break, by default."
54 56
 
55
-  (let* ((socket-id   (make-socket-id socket))
56
-	 (client-id   (gethash socket-id *socket-pairs*))
57
-	 (input-id    (make-client-input-id client-id)))
57
+						  (client-broadcast string line-break
58
+								    (ignore-errors (socket-to-client exception))))
58 59
 
59
-    (setf (gethash input-id *client-data*) '())))
60 60
 
61
+  ;; SOCKET --> NIL
62
+  (defun socket-input-flush (socket)
63
+    "Clean all input from a socket."
61 64
 
62
-;; STRING BOOLEAN --> NIL
63
-(defun client-broadcast (string &optional (line-break nil))
64
-  "Writes a string to all client sockets-- w/o line-break, by default."
65
+    (let ((client-id   (socket-to-client socket)))
66
+      (client-data-set client-id "input" '())))
65 67
 
66
-  (mapcar
67
-    (lambda (socket) (client-write socket string line-break))
68
-    *client-socket-list*))
69 68
 
69
+  ;; SOCKET --> STRING
70
+  (defun socket-input-string (socket)
71
+    "Get input from a socket as a string."
70 72
 
71
-;; SOCKET --> STRING
72
-(defun client-input-string (socket)
73
-  "Get input from a client as a string."
73
+    (client-input-string (socket-to-client socket)))
74 74
 
75
-  (let* ((socket-id (make-socket-id socket))
76
-	 (client-id (gethash socket-id *socket-pairs*))
77
-	 (input-id (make-client-input-id client-id))
78
-	 (input-bytes (gethash input-id *client-data*))
79
-	 (sanitized-bytes (remove-newline-bytes input-bytes)))
80 75
 
81
-    (ignore-errors (trivial-utf-8:utf-8-bytes-to-string sanitized-bytes))))
82 76
 
77
+  ;; -------------------------------------
78
+  ;; CLIENT I/O
83 79
 
84
- 
85
-;; -------------------------------------
86
- 
87
- 
88
- 
89
-(defun remove-newline-bytes (bytes)
90
-  (remove 13 (remove 10 bytes)))
91
-
92
-(defun commandp (socket)
93
-  (let* ((socket-id (make-socket-id socket))
94
-	 (client-id (gethash socket-id *socket-pairs*))
95
-	 (input-id (make-client-input-id client-id))
96
-	 (input-bytes (gethash input-id *client-data*))
97
-	 (last-byte (car (last input-bytes))))
98
-
99
-    (eq *command-byte* last-byte)))
80
+
81
+
82
+  ;; NUMBER --> NIL
83
+  (defun client-read (client)
84
+    "Read new input from a client to their stack of input bytes."
85
+
86
+    (socket-read (client-to-socket client)))
87
+
88
+
89
+  ;; NUMBER LIST --> NIL
90
+  (defun client-write-bytes (client bytes)
91
+    "Write bytes to a client's socket."
92
+    (format t "CLIENT-TO-SOCKET: " (client-to-socket client))
93
+
94
+    (socket-write-bytes (client-to-socket client) bytes))
95
+
96
+
97
+  ;; NUMBER STRING [BOOLEAN] --> NIL
98
+  (defun client-write (client string &optional (line-break nil))
99
+    "Writes a string to a client's socket-- w/o line-break, default."
100
+
101
+    (socket-write (client-to-socket client) string line-break))
102
+
103
+
104
+  ;; NUMBER --> NIL
105
+  (defun client-input-flush (client)
106
+    "Clean up input from a client."
107
+
108
+    (socket-input-flush (client-to-socket client)))
109
+
110
+
111
+  ;; STRING [BOOLEAN] [SOCKET] --> NIL
112
+  (defun client-broadcast (string &optional (line-break nil) (exception nil))
113
+    "Writes a `string` to all client sockets (aside from an `exception`--
114
+						    w/o line-break, by default."
115
+
116
+						    (mapcar
117
+						      (lambda (client)
118
+							(if (not (eq client exception))
119
+							  (client-write client string line-break)))
120
+						      *client-list*))
121
+
122
+
123
+    ;; NUMBER --> STRING
124
+    (defun client-input-string (client)
125
+      "Get input from a client as a string."
126
+
127
+      (let* ((input-bytes (client-data-get client "input"))
128
+	     (sanitized-bytes (remove-newline-bytes input-bytes)))
129
+
130
+	(ignore-errors (trivial-utf-8:utf-8-bytes-to-string sanitized-bytes))))
131
+
132
+
133
+
134
+    ;; -------------------------------------
135
+    ;; MISC.
136
+
137
+
138
+
139
+    ;; LIST --> LIST
140
+    (defun remove-newline-bytes (bytes)
141
+      "Remove undesired bytes-- null, LF, CR, etc, from a list of bytes."
142
+
143
+      (remove 0 (remove 10 (remove 13 bytes))))
144
+
145
+
146
+    ;; SOCKET
147
+    (defun commandp (byte-list command-byte)
148
+      "Returns whether or not a command is complete, judging on it's bytes."
149
+
150
+      (let* ((last-byte (car (last byte-list))))
151
+
152
+	(eq command-byte last-byte)))
153
+
154
+
155
+    ;; STRING STRING
156
+    (defun strequal (str1 str2)
157
+      "Returns whether or not strings are equal-- in their UTF bytes."
158
+
159
+      (let ((str1-u
160
+	      (delete 0 (tu8:string-to-utf-8-bytes str1)))
161
+	    (str2-u
162
+	      (delete 0 (tu8:string-to-utf-8-bytes str2))))
163
+
164
+	(equalp str1-u str2-u)))
... ...
@@ -4,13 +4,14 @@
4 4
 ;; DATA [STRING] --> STRING
5 5
 (defun journal (data &optional (name "unnamed"))
6 6
   "Print out a piece of data for logging on stdout."
7
-
8 7
   (format t "~A | ~A~%" (force-string-length name 10)  data))
9 8
 
10 9
 
11 10
 (defun standard-journaling ())
12 11
 
13 12
 
13
+;; -------------------------------------
14
+
14 15
 
15 16
 ;; LIST --> STRING
16 17
 (defun print-bytes (bytes)
... ...
@@ -18,7 +19,7 @@
18 19
 
19 20
   (if bytes
20 21
     (format t "~A"
21
-	    (ignore-errors (trivial-utf-8:utf-8-bytes-to-string bytes)))))
22
+	    (ignore-errors (tu8:utf-8-bytes-to-string bytes)))))
22 23
 
23 24
 
24 25
 ;; STRING NUMBER [STRING} --> STRING
... ...
@@ -1,22 +1,38 @@
1 1
 (defpackage :facilservil
2 2
   (:use :cl)
3
+  (:nicknames :fs)
3 4
   (:export
4 5
 
6
+    *socket-client*
7
+
5 8
     *socket-list*
6
-    *socket-pairs*
9
+    *csocket-list*
7 10
 
8 11
     *client-list*
9
-    *client-pairs*
10 12
     *client-data*
11
-    *client-socket-list*
12 13
 
13 14
     :journal
14 15
 
15 16
     :client-write
16 17
     :cline-write-bytes
17 18
     :client-broadcast
19
+    :client-read
18 20
     :client-slaughter
19 21
 
22
+    :socket-write
23
+    :socket-write-bytes
24
+    :socket-broadcast
25
+    :socket-read
26
+    :socket-register
27
+    :socket-slaughter
28
+
29
+    :client-data-get
30
+    :client-data-set
31
+    :client-data-rem
32
+
33
+    :socket-to-client
34
+    :client-to-socket
35
+
20 36
     :connect-ex
21 37
     :disconnect-ex
22 38
     :input-handle-ex
... ...
@@ -28,6 +44,11 @@
28 44
     :server-shutdown
29 45
     :server-reboot
30 46
 
47
+    :strequal
48
+
31 49
     :server))
32 50
 
33 51
 (in-package :facilservil)
52
+
53
+
54
+(rename-package :trivial-utf-8 :trivial-utf-8 (list :tu8))
... ...
@@ -1,27 +1,27 @@
1 1
 (in-package :facilservil)
2 2
 
3 3
 ;; -------------------------------------
4
-;; GLOAL VARIABLES
4
+;; GLOBAL VARIABLES
5 5
 
6
-(defvar *socket-list* '())
7
-(defvar *socket-pairs* '())
6
+(defvar *socket-client* '())
8 7
 
9 8
 (defvar *client-list* '())
10
-(defvar *client-socket-list* '())
11
-(defvar *client-pairs* '())
12 9
 (defvar *client-data* '())
13 10
 
14
-(defvar *command-byte* 10)
11
+(defvar *socket-list* '())
12
+(defvar *csocket-list* '())
13
+
15 14
 
16 15
 
17 16
 (defun reset-globals ()
18 17
   "Set all global variables to default state."
19
-  (setq *socket-pairs* (make-hash-table :test 'equal))
20
-  (setq *client-list* '())
21
-  (setq *client-socket-list* '())
22
-  (setq *client-pairs* (make-hash-table :test 'equal))
18
+  (setq *socket-client* '()) ;; list correlating client IDs and sockets
19
+
20
+  (setq *client-list* '())  ;; list of client (ID numbers)
23 21
   (setq *client-data* (make-hash-table :test 'equal))
24
-  (setq *command-byte* 10))
22
+
23
+  (setq *socket-list* '())  ;; all sockets
24
+  (setq *csocket-list* '())) ;; all sockets except for master socket
25 25
 
26 26
 
27 27
 ;; -------------------------------------
... ...
@@ -48,9 +48,8 @@
48 48
   (let* ((master-socket
49 49
 	   (usocket:socket-listen host port
50 50
 				  :reuse-address 'T
51
-				  :element-type '(unsigned-byte 8))))
51
+				  :element-type 'unsigned-byte )))
52 52
     (reset-globals)
53
-    (setq *command-byte* command-byte)
54 53
     (setq *socket-list* (list master-socket))
55 54
 
56 55
     (unwind-protect
... ...
@@ -66,40 +65,37 @@
66 65
 	     (let ((new-socket (usocket:socket-accept socket)))
67 66
 
68 67
 	       ;; add data to client-pairs, socket-pairs, client-data vv
69
-	       (client-register new-socket) 
68
+	       (socket-register new-socket)
70 69
 
71 70
 	       ;; execute user-provided #'connecting ^-^
72
-	       (let* ((socket-id (make-socket-id new-socket))
73
-		      (client-id (gethash socket-id *socket-pairs*)))
74
-		 (funcall connecting new-socket client-id))))
71
+	       (funcall connecting new-socket (socket-to-client new-socket))))
75 72
 
76 73
 
77 74
 	    ;; ...if functioning old connection...
78 75
 	    ((listen (usocket:socket-stream socket))
79
-	     (progn (client-read socket)
76
+	     (progn (socket-read socket)
80 77
 		    ;; check if command is complete-- if so, use user-provided
81 78
 		    ;; input-handler.
82
-		    (let* ((socket-id (make-socket-id socket))
83
-			   (client-id (gethash socket-id *socket-pairs*))
84
-			   (client-input (client-input-string socket)))
79
+		    (let* ((client-id (socket-to-client socket))
80
+			   (client-bytes (client-data-get client-id "input"))
81
+			   (client-input (client-input-string client-id)))
82
+		      (journal client-input "Client Input")
85 83
 
86 84
 		      ;; if reached *command-byte*, handle and flush input
87
-		      (if (commandp socket)
88
-			(progn (funcall input-handler socket client-id client-input)
89
-			       (client-input-flush socket))))))
85
+		      (if (commandp client-bytes command-byte)
86
+			(progn
87
+			  (funcall input-handler socket client-id client-input)
88
+			  (socket-input-flush socket))))))
90 89
 
91 90
 
92 91
 	    ;; ...if EOF connection or error... </3
93 92
 	    ('T
94
-	     (let* ((socket-id (make-socket-id socket))
95
-		    (client-id (gethash socket-id *socket-pairs*)))
96
-
97
-	       ;; execute user-provided #'disconnecting ;-;
98
-	       (funcall disconnecting socket client-id)
99
-	       (client-slaughter socket))))
93
+	     ;; execute user-provided #'disconnecting ;-;
94
+	     (funcall disconnecting socket (socket-to-client socket))
95
+	     (socket-slaughter socket))))
100 96
 
101
-	  ;; now, let's write that shit down
102
-	  (standard-journaling)))
97
+	;; now, let's write that shit down
98
+	(standard-journaling))
103 99
 
104 100
       ;; unwind-protect's cleanup form:
105 101
       ;; if error, shut down gracefully.