12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455 |
- (eval-when (:compile-toplevel :load-toplevel)
- (ql:quickload 'zs3))
- (defpackage :coleslaw-s3
- (:use :cl)
- (:import-from :coleslaw #:deploy
- #:deploy-dir
- #:*config*)
- (:export #:enable))
- (in-package :coleslaw-s3)
- (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 stale-keys ()
- (loop for key being the hash-values in *cache* collecting key))
- (defun s3-sync (filepath dir)
- (let ((etag (zs3:file-etag filepath))
- (key (enough-namestring filepath dir)))
- (if (gethash etag *cache*)
- (remhash etag *cache*)
- (zs3:put-file filepath *bucket* key :public t
- :content-type (content-type (pathname-type filepath))))))
- (defun dir->s3 (dir)
- (flet ((upload (file) (s3-sync file dir)))
- (cl-fad:walk-directory dir #'upload)))
- (defmethod deploy :after (staging)
- (let ((blog (deploy-dir *config*)))
- (loop for key across (zs3:all-keys *bucket*)
- do (setf (gethash (zs3:etag key) *cache*) key))
- (dir->s3 blog)
- (zs3:delete-objects (stale-keys) *bucket*)))
- (defun enable (&key auth-file bucket)
- "AUTH-FILE: Path to file with the access key on the first line and the secret
- key on the second."
- (setf zs3:*credentials* (zs3:file-credentials auth-file)
- *bucket* bucket))
|