Implement S3 plugin, URL/path generation cleanups and TODO updates.

TODO

@@ -9,6 +9,7 @@ TODO:
 ;;;; STATIC
 ;;;; implement start-coleslaw, stop-coleslaw!
 ;;;; implement cl-store use+init, once every 24 hours?
+;;;; implement update-site, parse-file support.
 ;;;; how many globals can we move into *storage* as keywords? ALL OF THEM!
 ;;;; --what about accessing them?
 ;;;; write a proper version of escape considering wild pathnames and valid URL issues
@@ -18,7 +19,7 @@ TODO:
 
 ;;;; PLUGINS
 ;;;; add activate-plugin, deactivate-plugin, :active-plugins?
-;;;; implement: analytics, crossposting, disqus, mathjax, pygments, recaptcha, s3
+;;;; implement: analytics, crossposting, disqus, mathjax, pygments, recaptcha
 ;;;; support input or output dirs being git repos + have git hooks?
 ;;; import
 ;; add comment handling ... (when comments ...)
@@ -28,15 +29,3 @@ TODO:
 ;;;; implement the whole damn backend!
 ;;;; make sure it has an admin interface!
 ;;;; -- spend two years trying to make it secure without HTTPS+SSL. fail.
-
-;;;; rendering hooks (pygmentize, xposting) via :around/:before/:after methods
-;; get run on rendered html before "storage"
-;; xposting may be a rendering hook but may necessitate publishing hooks
-;; again, these should be methods on a generic function
-
-;;;; template hooks *ARE* pre-rendering-hooks. or methods on GFs.
-;;;; they're methods on GFs you fool! work on the classes/constructors for post+indices
-;;;; that's the only thing that makes sense. (eg 'disqus, 'mathjax)
-;; run before the template is called to generate html or javascript includes
-;; for a given template property (eg. comments, includes). they should probably be
-;; methods on a generic function (eg. blog-comments, blog-includes)

plugins/s3.lisp

@@ -1,8 +1,59 @@
-(ql:quickload '(zs3))
+(eval-when (:compile-toplevel)
+  (ql:quickload '(zs3)))
 
 (defpackage :coleslaw-s3
-  (:use :cl :zs3))
+  (:use :cl :coleslaw :zs3))
 
 (in-package :coleslaw-s3)
 
+(defparameter *credentials* (get-credentials :s3)
+  "The credentials to authenticate with Amazon Web Services.
+Stored in a file with the access key on the first line
+and the secret key on the second.")
 
+(defparameter *content-type-map* '(("html" . "text/html")
+                                   ("css" . "text/css")
+                                   ("png" . "image/png")
+                                   ("jpg" . "image/jpg"))
+  "A mapping from file extensions to content types.")
+
+(defparameter *cache* (make-hash-table :test #'equal)
+  "A cache of keys in a given bucket hashed by etag.")
+
+(defparameter *bucket* nil
+  "A string designating the bucket to upload to.")
+
+(defun content-type (extension)
+  (cdr (assoc extension *content-type-map* :test #'equal)))
+
+(defun init ()
+  (unless *credentials*
+    (set-credentials :s3 (file-credentials "~/.aws"))
+    (setf *credentials* (get-credentials :s3))))
+
+(defun stale-keys (&key cache)
+  (loop for key being the hash-values in cache collecting key))
+
+(defun s3-sync (filepath &key bucket dir public-p cache)
+  (flet ((compute-key (namestring)
+           (subseq namestring (length (namestring (truename dir))))))
+    (let* ((etag (file-etag filepath))
+           (namestring (namestring filepath))
+           (key (compute-key namestring)))
+      (if (gethash etag cache)
+          (remhash etag cache)
+          (put-file filepath bucket key :public public-p
+                    :content-type (content-type (pathname-type filepath)))))))
+
+(defun dir->s3 (dir &key bucket cache public-p)
+  (cl-fad:walk-directory dir (lambda (file)
+                               (s3-sync file :cache cache :dir dir
+                                        :bucket bucket :public-p public-p))))
+
+(defmethod coleslaw::render-site :after ()
+  (init)
+  (let* ((keys (all-keys *bucket*)))
+    (loop for key across keys do (setf (gethash (etag key) *cache*) key))
+    (dir->s3 coleslaw::*output-dir* :bucket *bucket* :cache *cache* :public-p t)
+    (when (stale-keys :cache *cache*)
+      (delete-objects (stale-keys) *bucket*))))

static/coleslaw.lisp

@@ -65,31 +65,28 @@ e.g. \"CC-BY-SA\". Otherwise, standard copyright is assumed.")
     result))
 
 (defun write-post (post)
-  (let ((filepath (merge-pathnames
-                   (concatenate 'string (year-month (post-date post))
-                                "/" (escape (post-title post)) ".html")
+  (let* ((id (post-id post))
+         (filepath (merge-pathnames (post-file id)
                                     *output-dir*)))
     (ensure-directories-exist filepath)
     (with-open-file (out filepath :direction :output
                      :if-exists :supersede :if-does-not-exist :create)
-      (write-string (render-page (render-post (post-id post))) out))))
+      (write-string (render-page (render-post id)) out))))
 
 (defun write-index (index)
-  (ensure-directories-exist
-   (cl-fad:pathname-as-directory (merge-pathnames (index-id index)
-                                                  *output-dir*)))
   (let* ((count (length (index-posts index)))
-         (pages (ceiling (/ count 10))))
+         (pages (ceiling (/ count 10)))
+         (id (index-id index)))
+      (ensure-directories-exist
+       (cl-fad:pathname-as-directory (merge-pathnames id *output-dir*)))
     (loop for page from 1 to pages do
-         (let ((filepath (merge-pathnames
-                          (concatenate 'string (index-id index)
-                                       "/" (write-to-string page) ".html")
+         (let ((filepath (merge-pathnames (index-file id page)
                                           *output-dir*)))
            (with-open-file (out filepath :direction :output
                             :if-exists :supersede :if-does-not-exist :create)
-             (write-string (render-page (render-index (index-id index) page)) out))))))
+             (write-string (render-page (render-index id page)) out))))))
 
-(defun render-site ()
+(defmethod render-site ()
   (flet ((copy-dir (from to)
            (cl-fad:walk-directory from
              (lambda (file)

static/indices.lisp

@@ -64,5 +64,10 @@
                                          (index-url id (1+ page)))))))
     content))
 
+(defun index-file (id page)
+  (if (string= "recent" id)
+      (concatenate 'string (write-to-string page) ".html")
+      (concatenate 'string id "/" (write-to-string page) ".html")))
+
 (defmethod index-url (id page)
-  (concatenate 'string *site-root* "/" id "/" (write-to-string page) ".html"))
+  (concatenate 'string *site-root* "/" (index-file id page)))

static/posts.lisp

@@ -49,8 +49,10 @@
                                         (post-url (1+ id)))))))
     result))
 
-(defmethod post-url (id)
+(defun post-file (id)
   (let ((post (find-post id)))
-    (concatenate 'string *site-root* "/"
-                 (year-month (post-date post)) "/"
+    (concatenate 'string (year-month (post-date post)) "/"
                  (escape (post-title post)) ".html")))
+
+(defmethod post-url (id)
+  (concatenate 'string *site-root* "/" (post-file id)))