diff --git a/src/application-globals.rkt b/src/application-globals.rkt index 2d715f4..11d610a 100644 --- a/src/application-globals.rkt +++ b/src/application-globals.rkt @@ -1,6 +1,9 @@ #lang racket/base -(require net/http-easy - "config.rkt") +(require racket/string + net/http-easy + "config.rkt" + "xexpr-utils.rkt" + "url-utils.rkt") (provide ; timeout durations for http-easy requests @@ -50,7 +53,11 @@ (define (generate-wiki-page source-url wikiname title content) (define (required-styles origin) - (map (λ (dest-path) (format dest-path origin)) + (map (λ (dest-path) + (define url (format dest-path origin)) + (if (config-true? 'strict_proxy) + (u-proxy-url url) + url)) '(#;"~a/load.php?lang=en&modules=skin.fandomdesktop.styles&only=styles&skin=fandomdesktop" #;"~a/load.php?lang=en&modules=ext.gadget.dungeonsWiki%2CearthWiki%2Csite-styles%2Csound-styles&only=styles&skin=fandomdesktop" #;"~a/load.php?lang=en&modules=site.styles&only=styles&skin=fandomdesktop" @@ -82,4 +89,16 @@ ,content)) ,(application-footer source-url))))))) (module+ test - (check-not-false (xexp->html (generate-wiki-page "" "test" "test" '(template))))) + (define page + (parameterize ([(config-parameter 'strict_proxy) "true"]) + (generate-wiki-page "" "test" "test" '(template)))) + ; check the page is a valid xexp + (check-not-false (xexp->html page)) + ; check the stylesheet is proxied + (check-true (string-prefix? + (get-attribute 'href + (bits->attributes + ((query-selector + (λ (t a c) (eq? t 'link)) + page)))) + "/proxy?dest=https%3A%2F%2Ftest.fandom.com"))) diff --git a/src/config.rkt b/src/config.rkt index 4dc133e..16d1daf 100644 --- a/src/config.rkt +++ b/src/config.rkt @@ -4,16 +4,20 @@ ini) (provide + config-parameter config-true? config-get) (define-runtime-path path-config "../config.ini") +(define (config-parameter key) + (hash-ref config key)) + (define (config-true? key) - (not (member (hash-ref config key) '("" "false")))) + (not (member ((config-parameter key)) '("" "false")))) (define (config-get key) - (hash-ref config key)) + ((config-parameter key))) (define default-config '((application_name . "BreezeWiki") @@ -23,35 +27,43 @@ (port . "10416") (strict_proxy . "true"))) +(define loaded-alist + (with-handlers + ([exn:fail:filesystem:errno? + (λ (exn) + (begin0 + '() + (displayln "note: config file not detected, using defaults")))] + [exn:fail:contract? + (λ (exn) + (begin0 + '() + (displayln "note: config file empty or missing [] section, using defaults")))]) + (define l + (hash->list + (hash-ref + (ini->hash + (call-with-input-file path-config + (λ (in) + (read-ini in)))) + '||))) + (begin0 + l + (printf "note: ~a items loaded from config file~n" (length l))))) + +(define combined-alist (append default-config loaded-alist)) + (define config (make-hasheq - (append - default-config - (with-handlers - ([exn:fail:filesystem:errno? - (λ (exn) - (begin0 - '() - (displayln "note: config file not detected, using defaults")))] - [exn:fail:contract? - (λ (exn) - (begin0 - '() - (displayln "note: config file empty or missing [] section, using defaults")))]) - (define l - (hash->list - (hash-ref - (ini->hash - (call-with-input-file path-config - (λ (in) - (read-ini in)))) - '||))) - (begin0 - l - (printf "note: ~a items loaded from config file~n" (length l))))))) + (map (λ (pair) + (cons (car pair) (make-parameter (cdr pair)))) + combined-alist))) (when (config-true? 'debug) ; all values here are optimised for maximum prettiness (parameterize ([pretty-print-columns 80]) (display "config: ") - (pretty-write (hash->list config)))) + (pretty-write (sort + (hash->list (make-hasheq combined-alist)) + symbol

Caption text.

") "
Caption text.
")) -(define (update-tree-wiki tree wikiname #:strict-proxy? strict-proxy?) +(define (update-tree-wiki tree wikiname) (update-tree (λ (element element-type attributes children) ;; replace whole element? @@ -154,10 +154,10 @@ "url(" (u-proxy-url url) ")"))))) - ; and also their links, if strict-proxy is set + ; and also their links, if strict_proxy is set (curry u (λ (v) - (and strict-proxy? + (and (config-true? 'strict_proxy) (eq? element-type 'a) (has-class? "image-thumbnail" v))) (λ (v) (attribute-maybe-update 'href u-proxy-url v))) @@ -183,7 +183,9 @@ children))])) tree)) (module+ test - (define transformed (update-tree-wiki wiki-document "test" #:strict-proxy? #t)) + (define transformed + (parameterize ([(config-parameter 'strict_proxy) "true"]) + (update-tree-wiki wiki-document "test"))) ; check that wikilinks are changed to be local (check-equal? (get-attribute 'href (bits->attributes ((query-selector @@ -249,7 +251,7 @@ (next-dispatcher) (response-handler (define body - (generate-wiki-page source-url wikiname title (update-tree-wiki page wikiname #:strict-proxy? (config-true? 'strict_proxy)))) + (generate-wiki-page source-url wikiname title (update-tree-wiki page wikiname))) (define redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body))) (define headers (if redirect-msg (let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))]