diff --git a/TODO b/TODO index 48d63be..3782f21 100644 --- a/TODO +++ b/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) diff --git a/plugins/s3.lisp b/plugins/s3.lisp index d92b33b..2558873 100644 --- a/plugins/s3.lisp +++ b/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*)))) diff --git a/static/coleslaw.lisp b/static/coleslaw.lisp index 8ba8f64..fcdbcd7 100644 --- a/static/coleslaw.lisp +++ b/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") - *output-dir*))) + (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") - *output-dir*))) + (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) diff --git a/static/indices.lisp b/static/indices.lisp index 0426f65..0b1df9d 100644 --- a/static/indices.lisp +++ b/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))) diff --git a/static/posts.lisp b/static/posts.lisp index 2c67be2..517dd5e 100644 --- a/static/posts.lisp +++ b/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)))