Compare commits
1 commit
main
...
referrer-p
Author | SHA1 | Date | |
---|---|---|---|
5a59545963 |
4 changed files with 22 additions and 13 deletions
|
@ -9,6 +9,8 @@
|
||||||
"url-utils.rkt")
|
"url-utils.rkt")
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
|
; header to not send referers to fandom
|
||||||
|
referrer-policy
|
||||||
; timeout durations for http-easy requests
|
; timeout durations for http-easy requests
|
||||||
timeouts
|
timeouts
|
||||||
; generates a consistent footer
|
; generates a consistent footer
|
||||||
|
@ -22,6 +24,7 @@
|
||||||
(require rackunit
|
(require rackunit
|
||||||
html-writing))
|
html-writing))
|
||||||
|
|
||||||
|
(define referrer-policy (header #"Referrer-Policy" #"no-referrer"))
|
||||||
(define timeouts (easy:make-timeout-config #:lease 5 #:connect 5))
|
(define timeouts (easy:make-timeout-config #:lease 5 #:connect 5))
|
||||||
|
|
||||||
(define (application-footer source-url #:license [license-in #f])
|
(define (application-footer source-url #:license [license-in #f])
|
||||||
|
|
|
@ -113,6 +113,7 @@
|
||||||
(xexp->html body))
|
(xexp->html body))
|
||||||
(response/output
|
(response/output
|
||||||
#:code 200
|
#:code 200
|
||||||
|
#:headers (list referrer-policy)
|
||||||
(λ (out)
|
(λ (out)
|
||||||
(write-html body out))))))
|
(write-html body out))))))
|
||||||
(module+ test
|
(module+ test
|
||||||
|
|
|
@ -81,6 +81,7 @@
|
||||||
(xexp->html body))
|
(xexp->html body))
|
||||||
(response/output
|
(response/output
|
||||||
#:code 200
|
#:code 200
|
||||||
|
#:headers (list referrer-policy)
|
||||||
(λ (out)
|
(λ (out)
|
||||||
(write-html body out))))))
|
(write-html body out))))))
|
||||||
(module+ test
|
(module+ test
|
||||||
|
|
|
@ -152,15 +152,17 @@
|
||||||
(λ (v) (dict-update v 'rel (λ (s)
|
(λ (v) (dict-update v 'rel (λ (s)
|
||||||
(list (string-append (car s) " noreferrer")))
|
(list (string-append (car s) " noreferrer")))
|
||||||
'(""))))
|
'(""))))
|
||||||
; proxy images from inline styles
|
; proxy images from inline styles, if strict_proxy is set
|
||||||
(curry attribute-maybe-update 'style
|
(curry u
|
||||||
|
(λ (v) (config-true? 'strict_proxy))
|
||||||
|
(λ (v) (attribute-maybe-update 'style
|
||||||
(λ (style)
|
(λ (style)
|
||||||
(regexp-replace #rx"url\\(['\"]?(.*?)['\"]?\\)" style
|
(regexp-replace #rx"url\\(['\"]?(.*?)['\"]?\\)" style
|
||||||
(λ (whole url)
|
(λ (whole url)
|
||||||
(string-append
|
(string-append
|
||||||
"url("
|
"url("
|
||||||
(u-proxy-url url)
|
(u-proxy-url url)
|
||||||
")")))))
|
")")))) v)))
|
||||||
; and also their links, if strict_proxy is set
|
; and also their links, if strict_proxy is set
|
||||||
(curry u
|
(curry u
|
||||||
(λ (v)
|
(λ (v)
|
||||||
|
@ -168,8 +170,10 @@
|
||||||
(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)))
|
||||||
; proxy images from src attributes
|
; proxy images from src attributes, if strict_proxy is set
|
||||||
(curry attribute-maybe-update 'src u-proxy-url)
|
(curry u
|
||||||
|
(λ (v) (config-true? 'strict_proxy))
|
||||||
|
(λ (v) (attribute-maybe-update 'src u-proxy-url v)))
|
||||||
; don't lazyload images
|
; don't lazyload images
|
||||||
(curry u
|
(curry u
|
||||||
(λ (v) (dict-has-key? v 'data-src))
|
(λ (v) (dict-has-key? v 'data-src))
|
||||||
|
@ -276,8 +280,8 @@
|
||||||
(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))))]
|
||||||
[value (bytes-append #"0;url=" (string->bytes/utf-8 dest))])
|
[value (bytes-append #"0;url=" (string->bytes/utf-8 dest))])
|
||||||
(list (header #"Refresh" value)))
|
(list (header #"Refresh" value) referrer-policy))
|
||||||
(list)))
|
(list referrer-policy)))
|
||||||
(when (config-true? 'debug)
|
(when (config-true? 'debug)
|
||||||
; used for its side effects
|
; used for its side effects
|
||||||
; convert to string with error checking, error will be raised if xexp is invalid
|
; convert to string with error checking, error will be raised if xexp is invalid
|
||||||
|
|
Loading…
Reference in a new issue