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
+ #:key car))))
diff --git a/src/page-wiki.rkt b/src/page-wiki.rkt
index c770abc..65771a8 100644
--- a/src/page-wiki.rkt
+++ b/src/page-wiki.rkt
@@ -64,7 +64,7 @@
(check-equal? (preprocess-html-wiki "")
""))
-(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))))]