marcuskammer/coleslaw
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Packaging cleanups to S3 plugin.

Browse source
This commit is contained in:
Brit Butler 2013-03-06 13:05:57 -05:00
parent 6be80e8d5c
commit b72eb5b03a
2 changed files with 9 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
coleslaw.asd
View file

@ -1,5 +1,5 @@
(defsystem #:coleslaw (defsystem #:coleslaw
:name "coleslaw-core" :name "coleslaw"
:description "Flexible Lisp Blogware" :description "Flexible Lisp Blogware"
:version "0.9" :version "0.9"
:license "BSD" :license "BSD"

18
plugins/s3.lisp
View file

@ -2,13 +2,9 @@
(ql:quickload 'zs3)) (ql:quickload 'zs3))
(defpackage :coleslaw-s3 (defpackage :coleslaw-s3
(:use :cl :zs3) (:use :cl)
(:import-from :coleslaw #:deploy (:import-from :coleslaw #:deploy
#:*config*) #:*config*)
(:import-from :zs3 #:all-keys
#:etag
#:file-etag
#:put-file)
(:export #:enable)) (:export #:enable))
(in-package :coleslaw-s3) (in-package :coleslaw-s3)
@ -37,11 +33,11 @@ and the secret key on the second.")
(loop for key being the hash-values in *cache* collecting key)) (loop for key being the hash-values in *cache* collecting key))
(defun s3-sync (filepath dir) (defun s3-sync (filepath dir)
(let ((etag (file-etag filepath)) (let ((etag (zs3:file-etag filepath))
(key (enough-namestring filepath dir))) (key (enough-namestring filepath dir)))
(if (gethash etag *cache*) (if (gethash etag *cache*)
(remhash etag *cache*) (remhash etag *cache*)
(put-file filepath *bucket* key :public t (zs3:put-file filepath *bucket* key :public t
:content-type (content-type (pathname-type filepath)))))) :content-type (content-type (pathname-type filepath))))))
(defun dir->s3 (dir) (defun dir->s3 (dir)
@ -50,11 +46,11 @@ and the secret key on the second.")
(defmethod deploy :after (staging) (defmethod deploy :after (staging)
(let ((blog (deploy *config*))) (let ((blog (deploy *config*)))
(loop for key across (all-keys *bucket*) (loop for key across (zs3:all-keys *bucket*)
do (setf (gethash (etag key) *cache*) key)) do (setf (gethash (zs3:etag key) *cache*) key))
(dir->s3 blog) (dir->s3 blog)
(delete-objects (stale-keys) *bucket*))) (zs3:delete-objects (stale-keys) *bucket*)))
(defun enable (&key auth-file bucket) (defun enable (&key auth-file bucket)
(setf *credentials* (file-credentials auth-file) (setf *credentials* (zs3:file-credentials auth-file)
*bucket* bucket)) *bucket* bucket))