From adc4b47b83e7e850c242b6be854060f0908b70e4 Mon Sep 17 00:00:00 2001
From: blankie <blankie@nixnetmail.com>
Date: Sun, 9 Oct 2022 10:53:02 +0700
Subject: [PATCH] Set Referrer-Policy to no-referrer

Fandom sends a fake 404 to media if there's a Referer header that has an origin
that's not Fandom. However, we can choose not to send the header by setting
Referrer-Policy. See also:
https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Referrer-Policy
---
 src/application-globals.rkt |  3 +++
 src/page-category.rkt       |  1 +
 src/page-search.rkt         |  1 +
 src/page-wiki.rkt           | 30 +++++++++++++++++-------------
 4 files changed, 22 insertions(+), 13 deletions(-)

diff --git a/src/application-globals.rkt b/src/application-globals.rkt
index 6b5f3d9..3230b58 100644
--- a/src/application-globals.rkt
+++ b/src/application-globals.rkt
@@ -9,6 +9,8 @@
          "url-utils.rkt")
 
 (provide
+ ; header to not send referers to fandom
+ referrer-policy
  ; timeout durations for http-easy requests
  timeouts
  ; generates a consistent footer
@@ -22,6 +24,7 @@
   (require rackunit
            html-writing))
 
+(define referrer-policy (header #"Referrer-Policy" #"no-referrer"))
 (define timeouts (easy:make-timeout-config #:lease 5 #:connect 5))
 
 (define (application-footer source-url #:license [license-in #f])
diff --git a/src/page-category.rkt b/src/page-category.rkt
index bf8b982..036b59c 100644
--- a/src/page-category.rkt
+++ b/src/page-category.rkt
@@ -113,6 +113,7 @@
       (xexp->html body))
     (response/output
      #:code 200
+     #:headers (list referrer-policy)
      (λ (out)
        (write-html body out))))))
 (module+ test
diff --git a/src/page-search.rkt b/src/page-search.rkt
index 0647e57..e951749 100644
--- a/src/page-search.rkt
+++ b/src/page-search.rkt
@@ -81,6 +81,7 @@
       (xexp->html body))
     (response/output
      #:code 200
+     #:headers (list referrer-policy)
      (λ (out)
        (write-html body out))))))
 (module+ test
diff --git a/src/page-wiki.rkt b/src/page-wiki.rkt
index 41dc215..b039695 100644
--- a/src/page-wiki.rkt
+++ b/src/page-wiki.rkt
@@ -152,15 +152,17 @@
                        (λ (v) (dict-update v 'rel (λ (s)
                                                     (list (string-append (car s) " noreferrer")))
                                            '(""))))
-                ; proxy images from inline styles
-                (curry attribute-maybe-update 'style
-                       (λ (style)
-                         (regexp-replace #rx"url\\(['\"]?(.*?)['\"]?\\)" style
-                                         (λ (whole url)
-                                           (string-append
-                                            "url("
-                                            (u-proxy-url url)
-                                            ")")))))
+                ; proxy images from inline styles, if strict_proxy is set
+                (curry u
+                       (λ (v) (config-true? 'strict_proxy))
+                       (λ (v) (attribute-maybe-update 'style
+                         (λ (style)
+                           (regexp-replace #rx"url\\(['\"]?(.*?)['\"]?\\)" style
+                                           (λ (whole url)
+                                             (string-append
+                                              "url("
+                                              (u-proxy-url url)
+                                              ")")))) v)))
                 ; and also their links, if strict_proxy is set
                 (curry u
                        (λ (v)
@@ -168,8 +170,10 @@
                               (eq? element-type 'a)
                               (has-class? "image-thumbnail" v)))
                        (λ (v) (attribute-maybe-update 'href u-proxy-url v)))
-                ; proxy images from src attributes
-                (curry attribute-maybe-update 'src u-proxy-url)
+                ; proxy images from src attributes, if strict_proxy is set
+                (curry u
+                       (λ (v) (config-true? 'strict_proxy))
+                       (λ (v) (attribute-maybe-update 'src u-proxy-url v)))
                 ; don't lazyload images
                 (curry u
                        (λ (v) (dict-has-key? v 'data-src))
@@ -276,8 +280,8 @@
              (define headers (if redirect-msg
                                  (let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))]
                                         [value (bytes-append #"0;url=" (string->bytes/utf-8 dest))])
-                                   (list (header #"Refresh" value)))
-                                 (list)))
+                                   (list (header #"Refresh" value) referrer-policy))
+                                 (list referrer-policy)))
              (when (config-true? 'debug)
                ; used for its side effects
                ; convert to string with error checking, error will be raised if xexp is invalid