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
(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")))

View file

@ -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<?
#: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>")
"<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
(λ (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))))]