breezewiki/src/page-static-archive.rkt

91 lines
3.7 KiB
Racket
Raw Normal View History

#lang racket/base
(require racket/file
racket/path
racket/port
racket/runtime-path
racket/string
net/url
web-server/http
web-server/servlet-dispatch
web-server/dispatchers/filesystem-map
(only-in web-server/dispatchers/dispatch next-dispatcher)
"../archiver/archiver.rkt"
"../lib/mime-types.rkt"
"../lib/xexpr-utils.rkt"
"../src/config.rkt")
(provide
page-static-archive)
(define-runtime-path path-archive "../storage/archive")
(define ((replacer wikiname) whole url)
(format
"url(~a)"
(if (or (equal? url "")
(equal? url "'")
(string-contains? url "/resources-ucp/")
(string-contains? url "/fonts/")
(string-contains? url "/drm_fonts/")
(string-contains? url "//db.onlinewebfonts.com/")
(string-contains? url "//bits.wikimedia.org/")
(string-contains? url "dropbox")
(string-contains? url "only=styles")
(string-contains? url "https://https://")
(regexp-match? #rx"^%20|^'" url)
(regexp-match? #rx"^\"?data:" url))
url
(let* ([norm-url
(cond
[(string-prefix? url "https://") url]
[(string-prefix? url "http://") (regexp-replace #rx"http:" url "https:")]
[(string-prefix? url "//") (string-append "https:" url)]
[(string-prefix? url "/") (format "https://~a.fandom.com~a" wikiname url)]
[else (raise-user-error "While calling replace-style-for-images, this URL had an unknown format and couldn't be saved:" url)])])
(define p (image-url->values norm-url))
;; (printf "hashed: ~a~n -> ~a~n #-> ~a~n" url (car p) (cdr p))
(format "/archive/~a/images/~a" wikiname (cdr p))))))
(define (replace-style-for-images wikiname path)
(define content (file->string path))
(regexp-replace* #rx"url\\(([^)]*)\\)" content (replacer wikiname)))
(define (handle-style wikiname dest)
(when (config-true? 'debug)
(printf "using offline mode for style ~a ~a~n" wikiname dest))
(define fs-path (build-path path-archive wikiname "styles" dest))
(println fs-path)
(unless (file-exists? fs-path)
(next-dispatcher))
(response-handler
(define new-content (replace-style-for-images wikiname fs-path))
(response/output
#:code 200
#:headers (list (header #"Content-Type" #"text/css")
(header #"Referrer-Policy" #"same-origin"))
(λ (out) (displayln new-content out)))))
(define (handle-image wikiname dest) ;; dest is the hash with no extension
(unless ((string-length dest) . >= . 40) (next-dispatcher))
(response-handler
(define dir (build-path path-archive wikiname "images" (substring dest 0 1) (substring dest 0 2)))
(unless (directory-exists? dir) (next-dispatcher))
(define candidates (directory-list dir))
(define target (path->string (findf (λ (f) (string-prefix? (path->string f) dest)) candidates)))
(unless target (next-dispatcher))
(define ext (substring target 41))
(response/output
#:code 200
#:headers (list (header #"Content-Type" (ext->mime-type (string->bytes/latin-1 ext))))
(λ (out)
(call-with-input-file (build-path dir target)
(λ (in)
(copy-port in out)))))))
(define (page-static-archive req)
(define path (url-path (request-uri req)))
(define-values (_ wikiname kind dest) (apply values (map path/param-path path)))
(cond [(equal? kind "styles") (handle-style wikiname dest)]
[(equal? kind "images") (handle-image wikiname dest)]
[else (response-handler (raise-user-error "page-static-archive: how did we get here?" kind))]))