diff options
Diffstat (limited to 'web/tazblog_lisp')
-rw-r--r-- | web/tazblog_lisp/default.nix | 21 | ||||
-rw-r--r-- | web/tazblog_lisp/store.lisp | 79 |
2 files changed, 0 insertions, 100 deletions
diff --git a/web/tazblog_lisp/default.nix b/web/tazblog_lisp/default.nix deleted file mode 100644 index b5527c196dbf..000000000000 --- a/web/tazblog_lisp/default.nix +++ /dev/null @@ -1,21 +0,0 @@ -{ depot, ... }: - -depot.nix.buildLisp.library { - name = "tazblog"; - - deps = - # Local dependencies - (with pkgs.lisp; [ dns ]) - - # Third-party dependencies - ++ (with pkgs.third_party.lisp; [ - cl-base64 - cl-json - hunchentoot - iterate - ]); - - srcs = [ - ./store.lisp - ]; -} diff --git a/web/tazblog_lisp/store.lisp b/web/tazblog_lisp/store.lisp deleted file mode 100644 index 01935a68a023..000000000000 --- a/web/tazblog_lisp/store.lisp +++ /dev/null @@ -1,79 +0,0 @@ -(defpackage #:tazblog/store - (:documentation - "This module implements fetching of individual blog entries from DNS. - Yes, you read that correctly. - - Each blog post is stored as a set of records in a designated DNS - zone. For the production blog, this zone is `blog.tazj.in.`. - - A top-level record at `_posts` contains a list of all published - post IDs. - - For each of these post IDs, there is a record at `_meta.$postID` - that contains the title and number of post chunks. - - For each post chunk, there is a record at `_$chunkID.$postID` that - contains a base64-encoded post fragment. - - This module implements logic for assembling a post out of these - fragments and caching it based on the TTL of its `_meta` record.") - - (:use #:cl #:dns #:iterate) - (:import-from #:cl-base64 #:base64-string-to-string)) -(in-package :tazblog/store) - -;; TODO: -;; -;; - implement DNS caching - -(defvar *tazblog-zone* ".blog.tazj.in." - "DNS zone in which blog posts are persisted.") - -(deftype entry-id () 'string) - -(defun list-entries (&key (offset 0) (count 4) (zone *tazblog-zone*)) - "Retrieve COUNT entry IDs from ZONE at OFFSET." - (let ((answers (lookup-txt (concatenate 'string "_posts" zone)))) - (map 'vector #'dns-rr-rdata (subseq answers offset (+ offset count))))) - -(defun get-entry-meta (entry-id zone) - (let* ((name (concatenate 'string "_meta." entry-id zone)) - (answer (lookup-txt name)) - (encoded (dns-rr-rdata (alexandria:first-elt answer))) - (meta-json (base64-string-to-string encoded))) - (json:decode-json-from-string meta-json))) - -(defun base64-add-padding (string) - "Adds padding to the base64-encoded STRING if required." - (let ((rem (- 4 (mod (length string) 4)))) - (if (= 0 rem) string - (format nil "~A~v@{~A~:*~}" string rem "=")))) - -(defun collect-entry-fragments (entry-id count zone) - (let* ((fragments - (iter (for i from 0 below count) - (for name = (format nil "_~D.~A~A" i entry-id zone)) - (collect (alexandria:first-elt (lookup-txt name))))) - (decoded (map 'list (lambda (f) - (base64-string-to-string - (base64-add-padding (dns-rr-rdata f)))) - fragments))) - (apply #'concatenate 'string decoded))) - -(defstruct entry - (id "" :type string) - (title "" :type string) - (content "" :type string) - (date "" :type string)) - -(defun get-entry (entry-id &optional (zone *tazblog-zone*)) - "Retrieve the entry at ENTRY-ID from ZONE." - (let* ((meta (get-entry-meta entry-id zone)) - (count (cdr (assoc :c meta))) - (title (cdr (assoc :t meta))) - (date (cdr (assoc :d meta))) - (content (collect-entry-fragments entry-id count zone))) - (make-entry :id entry-id - :date date - :title title - :content content))) |