Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
69 lines (60 sloc) 2.68 KB
#lang racket
;; Use Glacier for archival backups, and SDB to store the metadata.
(require (planet gh/aws/sdb)
(planet gh/aws/sns)
(planet gh/aws/glacier)
(planet gh/http/request)) ;just for seconds->gmt-8601-string
(define path->archive-domain "examplesBackupPathToArchive")
(define archive->meta-domain "examplesBackupArchiveToMeta")
(define vault "examples.backup")
(define (ensure-assets)
;; Creating a vault on Glacier is idempotent; harmless to do again.
(create-vault vault)
;; Creating a domain on SDB is idempotent; harmless to do again.
(create-domain path->archive-domain)
(create-domain archive->meta-domain))
(define/contract (archive-file path)
(path? . -> . void?)
(define path/string (path->string path))
;; Upload to Glacier.
(printf "~a\nUploading to Amazon Glacier ...\n" path/string)
(define archive-id (create-archive-from-file vault path))
;; Store some metadata on SDB.
;; Using the path for SDB's ItemName, store an attribute named
;; ArchiveId with the Glacier archive ID as the value. Remember that
;; SDB allows multiple values per attribute, so setting this more
;; than once will add more values rather than replace.
(printf "Updating Amazon Simple Database with metadata ...\n")
(put-attributes path->archive-domain
`([ArchiveId ,archive-id]))
;; Also store some info about this specific archive.
(put-attributes archive->meta-domain
`([Size ,(number->string (file-size path))]
[Date ,(seconds->gmt-8601-string)]
[Path ,path/string]))
(define/contract (archive-directory path [sns-topic #f])
((path-string?) (string?) . ->* . void?)
(printf "Ensuring Amazon SDB and Glacier resources are created ...\n")
(printf "Starting archive of all files under ~a ...\n" path)
(for ([x (in-directory path)])
;; Unless a directory or a dot file
(unless (or (directory-exists? x)
(equal? #\. (string-ref (path->string x) 0)))
(archive-file x)))
(when sns-topic
(publish sns-topic (format "Archive completed ~a." (seconds->gmt-string))))
;; For example let's archive the file in our tests dir.
(define root-dir
(path->string (simplify-path (path->complete-path (build-path 'up "tests")))))
;; Let's notify to our first SNS topic (if any)
(define sns-topic (match (list-topics) [(list x rest ...) x][else #f]))
(archive-directory root-dir sns-topic)
;; Let's look at the information from SDB
(select-hash (format "SELECT * FROM ~a" path->archive-domain))
(select-hash (format "SELECT * FROM ~a" archive->meta-domain))
Something went wrong with that request. Please try again.