feat(web/tazblog_lisp): Implement retrieval of blog posts from DNS
This is mostly equivalent to the Haskell implementation, with the primary difference that the Lisp DNS library does not support caching yet.
This commit is contained in:
parent
dba2e5426e
commit
176b3458b0
2 changed files with 100 additions and 0 deletions
21
web/tazblog_lisp/default.nix
Normal file
21
web/tazblog_lisp/default.nix
Normal file
|
@ -0,0 +1,21 @@
|
|||
{ pkgs, ... }:
|
||||
|
||||
pkgs.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
|
||||
];
|
||||
}
|
79
web/tazblog_lisp/store.lisp
Normal file
79
web/tazblog_lisp/store.lisp
Normal file
|
@ -0,0 +1,79 @@
|
|||
(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)))
|
Loading…
Reference in a new issue