From 8cf1683903eaad9f12e43b8927031b5d6cc77638 Mon Sep 17 00:00:00 2001 From: Jaidyn Lev Date: Sun, 23 Sep 2018 21:58:22 -0500 Subject: [PATCH] Init --- qotd_sets/qotd2018-WIP | 18 ++++ qotdd.asd | 16 ++++ src/misc.lisp | 36 ++++++++ src/package.lisp | 7 ++ src/quote.lisp | 56 +++++++++++++ src/server.lisp | 53 ++++++++++++ src/stream.lisp | 37 +++++++++ src/string.lisp | 182 +++++++++++++++++++++++++++++++++++++++++ 8 files changed, 405 insertions(+) create mode 100644 qotd_sets/qotd2018-WIP create mode 100755 qotdd.asd create mode 100644 src/misc.lisp create mode 100644 src/package.lisp create mode 100644 src/quote.lisp create mode 100644 src/server.lisp create mode 100644 src/stream.lisp create mode 100644 src/string.lisp diff --git a/qotd_sets/qotd2018-WIP b/qotd_sets/qotd2018-WIP new file mode 100644 index 0000000..57a6a9e --- /dev/null +++ b/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 +% diff --git a/qotdd.asd b/qotdd.asd new file mode 100755 index 0000000..1f35705 --- /dev/null +++ b/qotdd.asd @@ -0,0 +1,16 @@ +(defsystem "qotdd" + :version "0.1" + :author "Jaidyn Ann " + :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)") diff --git a/src/misc.lisp b/src/misc.lisp new file mode 100644 index 0000000..d606148 --- /dev/null +++ b/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))) diff --git a/src/package.lisp b/src/package.lisp new file mode 100644 index 0000000..563553f --- /dev/null +++ b/src/package.lisp @@ -0,0 +1,7 @@ +(defpackage :qotdd + (:export + + :server)) + +(in-package :qotdd) + diff --git a/src/quote.lisp b/src/quote.lisp new file mode 100644 index 0000000..2cd0e23 --- /dev/null +++ b/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)))) diff --git a/src/server.lisp b/src/server.lisp new file mode 100644 index 0000000..1fba217 --- /dev/null +++ b/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)) diff --git a/src/stream.lisp b/src/stream.lisp new file mode 100644 index 0000000..5fa6cf9 --- /dev/null +++ b/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))))) diff --git a/src/string.lisp b/src/string.lisp new file mode 100644 index 0000000..3ca6b85 --- /dev/null +++ b/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))