#lang racket/base (require (prefix-in http: (planet synx/http:5)) (only-in (planet vyzo/crypto) sha256) (only-in (planet vyzo/crypto/util) hex) net/url racket/file) (define cache-directory (make-parameter (build-path (find-system-path 'home-dir) ".plt-scheme/page-cache"))) (when (not (directory-exists? (cache-directory))) (make-directory* (cache-directory))) (define (add-extension path ext) (path-add-suffix path (string-append "." ext))) (define (call-with-cache-directory d next) (make-directory* d) (parameterize ((cache-directory d)) (next))) (define-syntax-rule (with-cache-directory d body ...) (call-with-cache-directory d (λ () body ...))) (define (download uri #:check? (check? #t) #:referer (referer #f) #:headers (headers null)) (let ((dest (build-path (cache-directory) (bytes->string/utf-8 (hex (sha256 (string->bytes/utf-8 (url->string uri))))))) (headers (if referer (cons (cons "Referer" (url->string referer)) headers) headers))) (let ((info (add-extension dest "info"))) (if (or check? (not (file-exists? dest))) (let-values (((type modified) (http:download uri dest headers))) (with-output-to-file info #:exists 'replace (λ () (write type) (write modified))) (values type modified dest)) (if (file-exists? info) (with-input-from-file info (λ () (values (read) (read) dest))) (values #f #f dest)))))) (define (delete file) (delete-file file)) (provide with-cache-directory download delete)