plugins/s3.lisp (1822 bytes)
1 (eval-when (:compile-toplevel :load-toplevel) 2 (ql:quickload 'zs3)) 3 4 (defpackage :coleslaw-s3 5 (:use :cl) 6 (:import-from :coleslaw #:deploy 7 #:deploy-dir 8 #:*config*) 9 (:export #:enable)) 10 11 (in-package :coleslaw-s3) 12 13 (defparameter *content-type-map* '(("html" . "text/html") 14 ("css" . "text/css") 15 ("png" . "image/png") 16 ("jpg" . "image/jpg")) 17 "A mapping from file extensions to content types.") 18 19 (defparameter *cache* (make-hash-table :test #'equal) 20 "A cache of keys in a given bucket hashed by etag.") 21 22 (defparameter *bucket* nil 23 "A string designating the bucket to upload to.") 24 25 (defun content-type (extension) 26 (cdr (assoc extension *content-type-map* :test #'equal))) 27 28 (defun stale-keys () 29 (loop for key being the hash-values in *cache* collecting key)) 30 31 (defun s3-sync (filepath dir) 32 (let ((etag (zs3:file-etag filepath)) 33 (key (enough-namestring filepath dir))) 34 (if (gethash etag *cache*) 35 (remhash etag *cache*) 36 (zs3:put-file filepath *bucket* key :public t 37 :content-type (content-type (pathname-type filepath)))))) 38 39 (defun dir->s3 (dir) 40 (flet ((upload (file) (s3-sync file dir))) 41 (cl-fad:walk-directory dir #'upload))) 42 43 (defmethod deploy :after (staging) 44 (let ((blog (deploy-dir *config*))) 45 (loop for key across (zs3:all-keys *bucket*) 46 do (setf (gethash (zs3:etag key) *cache*) key)) 47 (dir->s3 blog) 48 (zs3:delete-objects (stale-keys) *bucket*))) 49 50 (defun enable (&key auth-file bucket) 51 "AUTH-FILE: Path to file with the access key on the first line and the secret 52 key on the second." 53 (setf zs3:*credentials* (zs3:file-credentials auth-file) 54 *bucket* bucket))