Proxy stylesheets too under strict_proxy

This also refactors the configuration system to use make-parameter,
because dynamic binding allows for testing code more easily.
This commit is contained in:
Cadence Ember 2022-09-08 14:05:47 +12:00
parent 78399a3474
commit e6eabe9cf4
Signed by untrusted user: cadence
GPG key ID: BC1C2C61CF521B17
3 changed files with 69 additions and 36 deletions

View file

@ -1,6 +1,9 @@
#lang racket/base #lang racket/base
(require net/http-easy (require racket/string
"config.rkt") net/http-easy
"config.rkt"
"xexpr-utils.rkt"
"url-utils.rkt")
(provide (provide
; timeout durations for http-easy requests ; timeout durations for http-easy requests
@ -50,7 +53,11 @@
(define (generate-wiki-page source-url wikiname title content) (define (generate-wiki-page source-url wikiname title content)
(define (required-styles origin) (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=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=ext.gadget.dungeonsWiki%2CearthWiki%2Csite-styles%2Csound-styles&only=styles&skin=fandomdesktop"
#;"~a/load.php?lang=en&modules=site.styles&only=styles&skin=fandomdesktop" #;"~a/load.php?lang=en&modules=site.styles&only=styles&skin=fandomdesktop"
@ -82,4 +89,16 @@
,content)) ,content))
,(application-footer source-url))))))) ,(application-footer source-url)))))))
(module+ test (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")))

View file

@ -4,16 +4,20 @@
ini) ini)
(provide (provide
config-parameter
config-true? config-true?
config-get) config-get)
(define-runtime-path path-config "../config.ini") (define-runtime-path path-config "../config.ini")
(define (config-parameter key)
(hash-ref config key))
(define (config-true? key) (define (config-true? key)
(not (member (hash-ref config key) '("" "false")))) (not (member ((config-parameter key)) '("" "false"))))
(define (config-get key) (define (config-get key)
(hash-ref config key)) ((config-parameter key)))
(define default-config (define default-config
'((application_name . "BreezeWiki") '((application_name . "BreezeWiki")
@ -23,10 +27,7 @@
(port . "10416") (port . "10416")
(strict_proxy . "true"))) (strict_proxy . "true")))
(define config (define loaded-alist
(make-hasheq
(append
default-config
(with-handlers (with-handlers
([exn:fail:filesystem:errno? ([exn:fail:filesystem:errno?
(λ (exn) (λ (exn)
@ -48,10 +49,21 @@
'||))) '||)))
(begin0 (begin0
l l
(printf "note: ~a items loaded from config file~n" (length l))))))) (printf "note: ~a items loaded from config file~n" (length l)))))
(define combined-alist (append default-config loaded-alist))
(define config
(make-hasheq
(map (λ (pair)
(cons (car pair) (make-parameter (cdr pair))))
combined-alist)))
(when (config-true? 'debug) (when (config-true? 'debug)
; all values here are optimised for maximum prettiness ; all values here are optimised for maximum prettiness
(parameterize ([pretty-print-columns 80]) (parameterize ([pretty-print-columns 80])
(display "config: ") (display "config: ")
(pretty-write (hash->list config)))) (pretty-write (sort
(hash->list (make-hasheq combined-alist))
symbol<?
#:key car))))

View file

@ -64,7 +64,7 @@
(check-equal? (preprocess-html-wiki "<figure class=\"thumb tright\" style=\"width: 150px\"><a class=\"image\"><img></a><noscript><a><img></a></noscript><figcaption class=\"thumbcaption\"> <p class=\"caption\">Caption text.</p></figcaption></figure>") (check-equal? (preprocess-html-wiki "<figure class=\"thumb tright\" style=\"width: 150px\"><a class=\"image\"><img></a><noscript><a><img></a></noscript><figcaption class=\"thumbcaption\"> <p class=\"caption\">Caption text.</p></figcaption></figure>")
"<figure class=\"thumb tright\" style=\"width: 150px\"><a class=\"image\"><img></a><noscript><a><img></a></noscript><figcaption class=\"thumbcaption\"><span class=\"caption\">Caption text.</span></figcaption></figure>")) "<figure class=\"thumb tright\" style=\"width: 150px\"><a class=\"image\"><img></a><noscript><a><img></a></noscript><figcaption class=\"thumbcaption\"><span class=\"caption\">Caption text.</span></figcaption></figure>"))
(define (update-tree-wiki tree wikiname #:strict-proxy? strict-proxy?) (define (update-tree-wiki tree wikiname)
(update-tree (update-tree
(λ (element element-type attributes children) (λ (element element-type attributes children)
;; replace whole element? ;; replace whole element?
@ -154,10 +154,10 @@
"url(" "url("
(u-proxy-url 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 (curry u
(λ (v) (λ (v)
(and strict-proxy? (and (config-true? 'strict_proxy)
(eq? element-type 'a) (eq? element-type 'a)
(has-class? "image-thumbnail" v))) (has-class? "image-thumbnail" v)))
(λ (v) (attribute-maybe-update 'href u-proxy-url v))) (λ (v) (attribute-maybe-update 'href u-proxy-url v)))
@ -183,7 +183,9 @@
children))])) children))]))
tree)) tree))
(module+ test (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 that wikilinks are changed to be local
(check-equal? (get-attribute 'href (bits->attributes (check-equal? (get-attribute 'href (bits->attributes
((query-selector ((query-selector
@ -249,7 +251,7 @@
(next-dispatcher) (next-dispatcher)
(response-handler (response-handler
(define body (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 redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body)))
(define headers (if redirect-msg (define headers (if redirect-msg
(let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))] (let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))]