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.

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

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

src/page-wiki.rkt

@@ -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))))]