176b3458b0
This is mostly equivalent to the Haskell implementation, with the primary difference that the Lisp DNS library does not support caching yet.
79 lines
2.8 KiB
Common Lisp
79 lines
2.8 KiB
Common Lisp
(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)))
|