Browse code

Update to new facilservil

Jaidyn Levesque authored on 2019-11-11 07:07:47
Showing 5 changed files
... ...
@@ -1,14 +1,8 @@
1 1
 (defsystem "qotdd"
2
-           :version "0.2"
2
+           :version "0.3"
3 3
            :author "Jaidyn Ann <jadedctrl@teknik.io>"
4 4
            :license "AGPLv3"
5 5
            :depends-on ("nih" "facilservil")
6
-           :components ((:module "src"
7
-                                 :components
8
-                                 ((:file "package")
9
-                                  (:file "stream")
10
-                                  (:file "quote")
11
-                                  (:file "server"))))
12
-
6
+           :components ((:file "qotdd"))
13 7
            :description
14 8
            "Question of the Day server (RFC 865-compliant)")
15 9
new file mode 100644
... ...
@@ -0,0 +1,112 @@
1
+;; This file is free software: you can redistribute it and/or modify
2
+;; it under the terms of version 3 of the GNU General Public License
3
+;; as published by the Free Software Foundation.
4
+;;
5
+;; This program is distributed in the hope that it will be useful,
6
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
7
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8
+;; GNU General Public License for more details.
9
+
10
+(defpackage :qotdd
11
+  (:use :cl)
12
+  (:export
13
+    :server))
14
+
15
+(in-package :qotdd)
16
+
17
+;; —————————————————————————————————————
18
+
19
+(defvar *qotd-path*)
20
+
21
+
22
+
23
+;; —————————————————————————————————————
24
+;; SERVER
25
+
26
+;; [HOST] [PORT] [PATH] → NIL
27
+(defun server (&key (host "0.0.0.0") (port 1117)
28
+                    (path "/usr/share/games/qotdd/qotd2018"))
29
+  "Start the QOTD server."
30
+  (setq *qotd-path* path)
31
+  (facilservil:server host port :on-connect #'main))
32
+
33
+;; —————————————————
34
+
35
+;; SOCKET NUMBER → NIL
36
+(defun main (connection connection-list)
37
+  "Main function on a connection-- send the QOTD to them."
38
+
39
+  (facilservil:send connection
40
+           (get-quote *qotd-path* (get-universal-time)))
41
+  (facilservil:close-it connection))
42
+
43
+
44
+
45
+;; —————————————————————————————————————
46
+;; QUOTE READING
47
+
48
+;; PATH → LIST-OF-LISTS
49
+(defun get-quotes (path)
50
+  "Read quotes into a list of quotes by path. The list'll look like this:
51
+      ((DATE QUOTE)
52
+       (DATE QUOTE)
53
+       (DATE QUOTE))"
54
+
55
+  (mapcar
56
+    (lambda (quote)
57
+      (list
58
+        (getf (nih:get-colon-values quote) :date)
59
+        (nih:remove-colon-values quote)))
60
+    (read-line-chunked (open path) "%")))
61
+
62
+;; PATH [STRING] → STRING
63
+(defun get-quote (path &optional universal-time)
64
+  "Return a quote of the day.
65
+  If you pass universal-time, then it'll try to get a quote specific to that
66
+  day. If a quote doesn't exist for that day (or you don't pass
67
+  universal-time), it'll return a random quote."
68
+  (let* ((quotes (get-quotes path))
69
+        (date (ignore-errors (nih:iso-time universal-time)))
70
+        (dated-quote (ignore-errors (cadr (nih:getf-string quotes date)))))
71
+
72
+    (if dated-quote
73
+      dated-quote
74
+      (cadr (nih:random-item quotes)))))
75
+
76
+
77
+
78
+;; —————————————————————————————————————
79
+;; MISC
80
+
81
+;; STREAM [FOOTER-STRING] → STRING
82
+(defun read-line-until (stream seperator-line)
83
+  "Read lines from a stream until a certain line is reached."
84
+
85
+  (let ((cur-line
86
+          (ignore-errors (read-line stream))))
87
+
88
+    (cond
89
+      ((and cur-line (not (equal cur-line (string seperator-line))))
90
+       (format nil "~A~%~A"
91
+               cur-line 
92
+               (nih:value-or
93
+                 (read-line-until stream seperator-line)
94
+                 "")))
95
+
96
+      ('T nil))))
97
+
98
+;; STREAM SEPERATOR → LIST-OF-STRINGS
99
+(defun read-line-chunked (stream seperator-line)
100
+  "read-line over a stream until EOF into a single string— but, whenever the
101
+  seperator-line is reached, start a brand new string. Returns a list of
102
+  (multi-lined) strings."
103
+
104
+  (let ((chunk
105
+          (read-line-until stream seperator-line)))
106
+
107
+    (if chunk
108
+      (concatenate 'list
109
+                   (list chunk)
110
+                   (read-line-chunked
111
+                     stream
112
+                     seperator-line)))))
0 113
deleted file mode 100644
... ...
@@ -1,7 +0,0 @@
1
-(defpackage :qotdd
2
-  (:use :cl)
3
-  (:export
4
-    :server))
5
-
6
-(in-package :qotdd) 
7
-
8 0
deleted file mode 100644
... ...
@@ -1,35 +0,0 @@
1
-(in-package :qotdd)
2
-
3
-;; QUOTE_FILE_PATH --> LIST_OF_LISTS
4
-(defun get-quotes (path)
5
-  "Read quotes into a list of quotes by path.
6
-  The list'll look like this:
7
-
8
-      ((DATE QUOTE)
9
-       (DATE QUOTE)
10
-       (DATE QUOTE))"
11
-
12
-  (mapcar
13
-    (lambda (quote)
14
-      (list
15
-        (getf (nih:get-colon-values quote) :date)
16
-        (nih:remove-colon-values quote)))
17
-    (read-line-chunked (open path) "%")))
18
-
19
-
20
-
21
-;; PATH_TO_QOTD_FILE [UNIVERSAL_TIME] --> DATED_OR_RANDOM_QUOTE
22
-(defun get-quote (path &optional universal-time)
23
-  "Return a quote of the day.
24
-  If you pass `universal-time`, then it'll try to get a quote
25
-  specific to that day.
26
-  If a quote doesn't exist for that day (or you don't pass
27
-  `universal-time`), it'll return a random quote."
28
-
29
-  (let* ((quotes (get-quotes path))
30
-        (date (ignore-errors (nih:iso-time universal-time)))
31
-        (dated-quote (ignore-errors (cadr (nih:getf-string quotes date)))))
32
-
33
-    (if dated-quote
34
-      dated-quote
35
-      (cadr (nih:random-item quotes)))))
36 0
deleted file mode 100644
... ...
@@ -1,37 +0,0 @@
1
-(in-package :qotdd)
2
-
3
-;; STREAM [FOOTER-STRING] --> DATA_FROM_STREAM_UNTIL_FOOTER
4
-(defun read-line-until (stream seperator-line)
5
-  "Read lines from a stream until a certain line is reached."
6
-
7
-  (let ((cur-line
8
-          (ignore-errors (read-line stream))))
9
-
10
-    (cond
11
-      ((and cur-line (not (equal cur-line (string seperator-line))))
12
-       (format nil "~A~%~A"
13
-               cur-line 
14
-               (nih:value-or
15
-                 (read-line-until stream seperator-line)
16
-                 "")))
17
-
18
-      ('T nil))))
19
-
20
-
21
-
22
-;; STREAM SEPERATOR --> LIST_OF_STRINGS
23
-(defun read-line-chunked (stream seperator-line)
24
-  "read-line over a stream until EOF into a single string--
25
-  but, whenver the `seperator-line` is reached, start a
26
-  brand new string.
27
-  Returns a list of (multi-lined) strings."
28
-
29
-  (let ((chunk
30
-          (read-line-until stream seperator-line)))
31
-
32
-    (if chunk
33
-      (concatenate 'list
34
-                   (list chunk)
35
-                   (read-line-chunked
36
-                     stream
37
-                     seperator-line)))))