Init

qotd_sets/qotd2018-WIP

@@ -0,0 +1,18 @@
+:Date 2018-09-23
+
+"Don't despair that others don't know you--
+despair that you don't know them."
+	-- Master Kung
+
+%
+:Date 2018-09-24
+
+"Death to the bourgeousie class!"
+	-- Some comrade
+
+%
+:Date 2018-09-25
+
+"I don't have a quote for today!"
+	-- Lazy sysadmin
+%

qotdd.asd

@@ -0,0 +1,16 @@
+(defsystem "qotdd"
+           :version "0.1"
+           :author "Jaidyn Ann <jadedctrl@teknik.io>"
+           :license "AGPLv3"
+           :depends-on ("cl-strings" "usocket")
+           :components ((:module "src"
+                                 :components
+                                 ((:file "package")
+                                  (:file "misc")
+                                  (:file "string")
+                                  (:file "stream")
+                                  (:file "quote")
+                                  (:file "server"))))
+
+           :description
+           "Question of the Day server (RFC 865-compliant)")

src/misc.lisp

@@ -0,0 +1,36 @@
+(in-package :qotdd)
+
+;; EXPRESSION BACKUP --> EXPRESSION_OR_BACKUP
+(defun value-or (expression backup)
+  "If an expression is non-NIL, return it. Otherwise,
+  return a backup."
+
+  (if expression
+    expression
+    backup))
+
+
+
+;; UNIVERSAL_TIME --> ISO8601-FORMATTED_STRING
+(defun iso8601 (universal-time)
+  "Return `universal-time` in ISO 8601 format. :)"
+
+  (multiple-value-bind
+    (second minute hour date month year)
+    (decode-universal-time universal-time)
+
+    (format nil "~A-~A-~A"
+            year
+            (min-string-length month 2 "0")
+            (min-string-length date 2 "0"))))
+
+
+
+;; LIST --> RANDOM_ITEM
+(defun random-item (list)
+  "Get a random item from a list."
+
+  (let* ((length (length list))
+         (n (random length)))
+
+    (nth n list)))

src/package.lisp

@@ -0,0 +1,7 @@
+(defpackage :qotdd
+  (:export
+
+    :server))
+
+(in-package :qotdd) 
+

src/quote.lisp

@@ -0,0 +1,56 @@
+(in-package :qotdd)
+
+;; QUOTE_FILE_PATH --> LIST_OF_LISTS
+(defun get-quotes (path)
+  "Read quotes into a list of quotes by path.
+  The list'll look like this:
+
+      ((DATE QUOTE)
+       (DATE QUOTE)
+       (DATE QUOTE))"
+
+  (mapcar
+    (lambda (quote)
+      (list
+        (get-quote-date quote)
+        (remove-quote-date quote)))
+    (read-line-chunked (open path) "%")))
+
+
+
+;; QUOTE_STRING --> DATE_IN_STRING
+(defun get-quote-date (quote)
+  "Get the date of a set quote."
+
+  (let ((date (get-colon-value quote "Date")))
+    (if date
+      date
+      nil)))
+
+
+
+;; QUOTE_STRING --> QUOTE_STRING_WITHOUT_DATE
+(defun remove-quote-date (quote)
+  "Remove the date from a set quote."
+
+  (if (get-quote-date quote)
+    (remove-colon-value quote "Date")
+    quote))
+
+
+
+;; PATH_TO_QOTD_FILE [UNIVERSAL_TIME] --> DATED_OR_RANDOM_QUOTE
+(defun get-quote (path &optional universal-time)
+  "Return a quote of the day.
+  If you pass `universal-time`, then it'll try to get a quote
+  specific to that day.
+  If a quote doesn't exist for that day (or you don't pass
+  `universal-time`), it'll return a random quote."
+
+  (let* ((quotes (get-quotes path))
+        (date (ignore-errors (iso8601 universal-time)))
+        (dated-quote (ignore-errors (cadr (getf-string quotes date)))))
+
+    (if dated-quote
+      dated-quote
+      (random-item quotes))))

src/server.lisp

@@ -0,0 +1,53 @@
+(in-package :qotdd)
+
+;; [HOST] [PORT]
+(defun server (&optional
+                (host "127.0.0.1")
+                (port 1117)
+                (qotd-path "/usr/share/games/qotdd/qotd2018"))
+  "Start the QOTD server."
+
+  (let ((socket (usocket:socket-listen host port)))
+
+    (unwind-protect
+      (loop
+        :do
+        (let ((connection (connection-get socket)))
+          (main connection qotd-path)
+          (connection-kill connection)))
+
+      (progn
+        (format t "Dying...")
+        (usocket:socket-close socket)))))
+
+
+
+;; SOCKET --> CONNECTION_ON_SOCKET
+(defun connection-get (socket)
+  "Return a Connection from a Socket; until Connection recieved,
+  wait patiently."
+
+  (usocket:socket-accept socket :element-type 'character))
+
+
+
+;; CONNECTION
+(defun connection-kill (connection)
+  "Close a connection."
+
+  (usocket:socket-close connection))
+
+
+
+(defun main (connection qotd-path)
+  "Main function on a connection-- send the QOTD to them."
+
+  (connection-msg connection
+                  (get-quote qotd-path (get-universal-time))))
+
+
+;; CONNECTION
+(defun connection-msg (connection message)
+  "Send a message to a connection."
+
+  (format (usocket:socket-stream connection) "~A" message))

src/stream.lisp

@@ -0,0 +1,37 @@
+(in-package :qotdd)
+
+;; STREAM [FOOTER-STRING] --> DATA_FROM_STREAM_UNTIL_FOOTER
+(defun read-line-until (stream seperator-line)
+  "Read lines from a stream until a certain line is reached."
+
+  (let ((cur-line
+          (ignore-errors (read-line stream))))
+
+    (cond
+      ((and cur-line (not (equal cur-line (string seperator-line))))
+       (format nil "~A~%~A"
+               cur-line 
+               (value-or
+                 (read-line-until stream seperator-line)
+                 "")))
+
+      ('T nil))))
+
+
+
+;; STREAM SEPERATOR --> LIST_OF_STRINGS
+(defun read-line-chunked (stream seperator-line)
+  "read-line over a stream until EOF into a single string--
+  but, whenver the `seperator-line` is reached, start a
+  brand new string.
+  Returns a list of (multi-lined) strings."
+
+  (let ((chunk
+          (read-line-until stream seperator-line)))
+
+    (if chunk
+      (concatenate 'list
+                   (list chunk)
+                   (read-line-chunked
+                     stream
+                     seperator-line)))))

src/string.lisp

@@ -0,0 +1,182 @@
+(in-package :qotdd)
+
+;; MULTI-LINE_STRING --> LIST_OF_LINES
+(defun string-line-list (string)
+  "Return a list of lines from a multi-line string."
+
+  (cl-strings:split string (format nil "~%")))
+
+
+
+;; LIST_OF_STRINGS --> MULTI-LINE_STRING
+(defun line-list-string (line-list)
+  "Turn a list of lines (string) into a multi-line string."
+
+  (reduce
+    (lambda (x y)
+      (format nil "~A~%~A" x y))
+    line-list))
+
+
+
+;; SINGLE-LINE_STRING PREFIX_SUBSTRING --> POST-PREFIX_SUBSTRING
+(defun string-after-prefix (string prefix)
+  "Return substring after a `prefix` substring at the start of a string."
+
+  (cl-strings:clean
+    (cadr (cl-strings:split string prefix))))
+
+
+
+;; MULTI-LINE_STRING QUERY --> LINE_CONTAINING_QUERY
+(defun get-line (string query)
+  "Return a single line that query starts from a multi-line string."
+
+  (let ((line-number (position-line string query)))
+
+    (if line-number
+      (nth line-number (string-line-list string))
+      nil)))
+
+
+
+;; MULTI-LINE_STRING QUERY --> LINE_NUMBER
+(defun position-line (string query)
+  "Return the line number that the string `query` starts off--
+  from a multi-line string."
+
+  (position 'T
+            (mapcar
+              (lambda (line)
+                (cl-strings:starts-with line query))
+              (string-line-list string))))
+
+
+
+;; NUMBER MULTI-LINE_STRING --> SINGLE-LINE_STRING
+(defun nth-string (n string)
+  "Return line of number `n` from a multi-line string."
+
+  (nth n (string-line-list string)))
+
+
+
+;; STRING COLON_VARIABLE_NAME --> COLON_VALUE
+(defun get-colon-value (string variable)
+  "Return a the value of a `colon variable`; I.E.,
+  a line of a string starting with `:` followed by a variable
+  name, a space, then the value of said `colon variable`.
+
+  Here's an example:
+      (setq *example-string*
+      \"Blah blah blah
+      :Date 1999
+      Blah blah blah\")
+
+  If you ran
+      (get-colon-value *example-string* \"Date\")
+
+  you would get
+      \"1999\" in return.
+
+  Mainly useful for multi-line strings, but your use-case might
+  involve a `colon variable` in a single-lined string."
+
+  (let ((variable-string (format nil ":~A " variable)))
+
+    (values
+      (ignore-errors
+        (string-after-prefix
+          (get-line string variable-string)
+          variable-string)))))
+
+
+
+;; STRING COLON_VARIABLE_NAME --> STRING_WITHOUT_COLON_VARIABLE
+(defun remove-colon-value (string variable)
+  "Remove the colon-variable declaration from a string."
+
+  (let ((variable-string (format nil ":~A " variable)))
+
+    (line-list-string
+      (remove
+        (get-line string variable-string)
+        (string-line-list string)
+        :test 'equal))))
+
+
+
+;; STRING DESIRED_LENGTH [PREFIX] [SUFFIX] --> STRING_OF_DESIRED_LENGTH
+(defun min-string-length (string target-length
+                                &optional (prefix-substitute "0")
+                                           (suffix-substitute ""))
+  "If a string *must* be a certain length (formatting reasons), use
+  this function.
+
+  Returns a string of `length`, using the `prefix-substitutor` or
+  `suffix-substitutor` to beef up the character-count if it's too short.
+
+  If both `prefix` and `suffix` are defined, `prefix` is used.
+
+  Example:
+      (min-string-length \"9\" 3 \"0\")
+
+      \"009\""
+
+  (let* ((string (format nil "~A" string))
+         (cur-length (length string)))
+      
+    (if (eq cur-length target-length)
+      string
+
+      (min-string-length
+        (pad-string string prefix-substitute suffix-substitute)
+        target-length
+        prefix-substitute
+        suffix-substitute))))
+
+
+
+
+;; STRING PREFIX SUFFIX --> STRING_ONE_OR_TWO_CHARS_LARGER
+(defun pad-string (string prefix-substitute suffix-substitute)
+  "Increase the character-count of a string by 1; either by
+  adding a prefix-substitutor or a suffix-substitutor.
+
+  Set the substitutor you don't want to use to \"\".
+  If you set both to a value, then the count will increase by 2."
+
+  (format nil "~A~A~A" prefix-substitute string suffix-substitute))
+
+
+
+;; LIST_OF_SUBLISTS STRING --> SUBLIST_WITH_STRING_AS_CAR
+(defun getf-string (list string)
+  "Get an item from a list by an identifying string in `car`.
+  I.E., if the string is 'apple', the first sublist like this:
+  ('apple' 1 2 3)
+  will be returned."
+
+  (car (getf-strings list string)))
+
+
+
+;; LIST_OF_SUBLISTS STRING --> LIST_OF_SUBLISTS_WITH_STRING_AS_CAR
+(defun getf-strings (list string &optional (stack '()))
+  "Get items from list by an identifying string in `car`.
+  I.E., if the string is 'apple', any sublists like this:
+  ('apple' 1 2 3)
+  will be returned."
+
+  ;; just recurse through the list, adding each new matching
+  ;; item to the `stack`
+
+  (if (and (< 0 (length list)) (listp list))
+    (if (ignore-errors
+          ;; the item might not be a list; for our purposes, let's ignore that.
+          (equal
+            (car (car list))    ;; '( ( here ) )
+            string))
+      (getf-strings (cdr list) string (concatenate 'list stack (list (car list))))
+      (getf-strings (cdr list) string stack))
+    stack))