diff --git a/info.rkt b/info.rkt index 46512df..74152ef 100644 --- a/info.rkt +++ b/info.rkt @@ -1,3 +1,3 @@ #lang info -(define build-deps '("rackunit-lib" "web-server-lib" "http-easy-lib" "html-parsing" "html-writing" "json-pointer" "ini-lib" "memo")) +(define build-deps '("rackunit-lib" "web-server-lib" "http-easy-lib" "html-parsing" "html-writing" "json-pointer" "ini-lib")) diff --git a/src/application-globals.rkt b/src/application-globals.rkt index 7f16bee..9a21592 100644 --- a/src/application-globals.rkt +++ b/src/application-globals.rkt @@ -9,8 +9,8 @@ "url-utils.rkt") (provide - ; headers to always send on all http responses - always-headers + ; header to not send referers to fandom + referrer-policy ; timeout durations for http-easy requests timeouts ; generates a consistent footer @@ -24,8 +24,7 @@ (require rackunit html-writing)) -(define always-headers - (list (header #"Referrer-Policy" #"same-origin"))) ; header to not send referers to fandom +(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]) @@ -52,8 +51,8 @@ ,(if source-url `(div (p "This page displays proxied content from " (a (@ (href ,source-url) (rel "noreferrer")) ,source-url) - ,(format ". Text content is available under the ~a license, " (license^-text license)) - (a (@ (href ,(license^-url license))) "see license info.") + ,(format ". Text content is available under the ~a license, " (license-text license)) + (a (@ (href ,(license-url license))) "see license info.") " Media files may have different copying restrictions.") (p ,(format "Fandom is a trademark of Fandom, Inc. ~a is not affiliated with Fandom." (config-get 'application_name)))) `(div (p "Text content on wikis run by Fandom is available under the Creative Commons Attribution-Share Alike License 3.0 (Unported), " @@ -67,8 +66,7 @@ #:wikiname wikiname #:title title #:body-class [body-class-in #f] - #:siteinfo [siteinfo-in #f]) - (define siteinfo (or siteinfo-in siteinfo-default)) + #:license [license #f]) (define body-class (if (not body-class-in) "skin-fandomdesktop" body-class-in)) @@ -87,10 +85,7 @@ `(html (head (meta (@ (name "viewport") (content "width=device-width, initial-scale=1"))) - (title ,(format "~a | ~a+~a" - title - (regexp-replace #rx" ?Wiki$" (siteinfo^-sitename siteinfo) "") - (config-get 'application_name))) + (title ,(format "~a | ~a" title (config-get 'application_name))) ,@(map (λ (url) `(link (@ (rel "stylesheet") (type "text/css") (href ,url)))) (required-styles (format "https://~a.fandom.com" wikiname))) @@ -109,7 +104,7 @@ (div (@ (id "content") #;(class "page-content")) (div (@ (id "mw-content-text")) ,content)) - ,(application-footer source-url #:license (siteinfo^-license siteinfo)))))))) + ,(application-footer source-url #:license license))))))) (module+ test (define page (parameterize ([(config-parameter 'strict_proxy) "true"]) diff --git a/src/data.rkt b/src/data.rkt index 6673e4c..8eb0cd6 100644 --- a/src/data.rkt +++ b/src/data.rkt @@ -1,36 +1,33 @@ #lang racket/base -(require racket/list - (prefix-in easy: net/http-easy) - memo +(require (prefix-in easy: net/http-easy) "url-utils.rkt" "xexpr-utils.rkt") (provide - (struct-out siteinfo^) - (struct-out license^) - siteinfo-fetch - siteinfo-default - license-default) + (struct-out license) + license-default + license-auto) -(struct siteinfo^ (sitename basepage license) #:transparent) -(struct license^ (text url) #:transparent) - -(define license-default (license^ "CC-BY-SA" "https://www.fandom.com/licensing")) -(define siteinfo-default (siteinfo^ "Test Wiki" "Main_Page" license-default)) - -(define/memoize (siteinfo-fetch wikiname) #:hash hash +(struct license (text url) #:transparent) +(define license-default (license "CC-BY-SA" "https://www.fandom.com/licensing")) +(define license-hash (make-hash)) +(define (license-fetch wikiname) (define dest-url (format "https://~a.fandom.com/api.php?~a" wikiname (params->query '(("action" . "query") ("meta" . "siteinfo") - ("siprop" . "general|rightsinfo") + ("siprop" . "rightsinfo") ("format" . "json") ("formatversion" . "2"))))) (log-outgoing dest-url) (define res (easy:get dest-url)) (define data (easy:response-json res)) - (siteinfo^ (jp "/query/general/sitename" data) - (second (regexp-match #rx"/wiki/(.*)" (jp "/query/general/base" data))) - (license^ (jp "/query/rightsinfo/text" data) - (jp "/query/rightsinfo/url" data)))) + (license (jp "/query/rightsinfo/text" data) + (jp "/query/rightsinfo/url" data))) +(define (license-auto wikiname) + (if (hash-has-key? license-hash wikiname) + (hash-ref license-hash wikiname) + (let ([result (license-fetch wikiname)]) + (hash-set! license-hash wikiname result) + result))) diff --git a/src/page-category.rkt b/src/page-category.rkt index 6c0a733..c9c3ec2 100644 --- a/src/page-category.rkt +++ b/src/page-category.rkt @@ -35,14 +35,14 @@ #:members-data members-data #:page page #:body-class [body-class #f] - #:siteinfo [siteinfo #f]) + #:license [license #f]) (define members (jp "/query/categorymembers" members-data)) (generate-wiki-page #:source-url source-url #:wikiname wikiname #:title title #:body-class body-class - #:siteinfo siteinfo + #:license license `(div ,(update-tree-wiki page wikiname) (hr) @@ -89,7 +89,7 @@ (log-outgoing dest-url) (define dest-res (easy:get dest-url #:timeouts timeouts)) (easy:response-json dest-res)] - [siteinfo (siteinfo-fetch wikiname)]) + [license (license-auto wikiname)]) (define title (preprocess-html-wiki (jp "/parse/title" page-data prefixed-category))) (define page-html (preprocess-html-wiki (jp "/parse/text" page-data ""))) @@ -105,7 +105,7 @@ #:members-data members-data #:page page #:body-class body-class - #:siteinfo siteinfo)) + #:license license)) (when (config-true? 'debug) ; used for its side effects @@ -113,7 +113,7 @@ (xexp->html body)) (response/output #:code 200 - #:headers (build-headers always-headers) + #:headers (list referrer-policy) (λ (out) (write-html body out)))))) (module+ test diff --git a/src/page-file.rkt b/src/page-file.rkt index ee27749..7635eb4 100644 --- a/src/page-file.rkt +++ b/src/page-file.rkt @@ -57,7 +57,7 @@ #:title title #:media-detail media-detail #:image-content-type image-content-type - #:siteinfo [siteinfo #f]) + #:license [license #f]) (define video-embed-code (jp "/videoEmbedCode" media-detail "")) (define raw-image-url (jp "/rawImageUrl" media-detail)) (define image-url (jp "/imageUrl" media-detail raw-image-url)) @@ -72,7 +72,7 @@ #:source-url source-url #:wikiname wikiname #:title title - #:siteinfo siteinfo + #:license license `(div ,(if (non-empty-string? video-embed-code) (update-tree-wiki (html->xexp (preprocess-html-wiki video-embed-code)) wikiname) (get-media-html image-url image-content-type)) @@ -113,7 +113,7 @@ (log-outgoing dest-url) (define dest-res (easy:get dest-url #:timeouts timeouts)) (easy:response-json dest-res)] - [siteinfo (siteinfo-fetch wikiname)]) + [license (license-auto wikiname)]) (if (not (jp "/exists" media-detail #f)) (next-dispatcher) (response-handler @@ -130,7 +130,7 @@ #:title title #:media-detail media-detail #:image-content-type image-content-type - #:siteinfo siteinfo)) + #:license license)) (when (config-true? 'debug) ; used for its side effects ; convert to string with error checking, error will be raised if xexp is invalid diff --git a/src/page-home.rkt b/src/page-home.rkt index b16f66a..7c7aaa1 100644 --- a/src/page-home.rkt +++ b/src/page-home.rkt @@ -4,7 +4,6 @@ html-writing web-server/http "application-globals.rkt" - "url-utils.rkt" "xexpr-utils.rkt" "config.rkt") @@ -82,7 +81,6 @@ (define (page-home req) (response/output #:code 200 - #:headers (build-headers always-headers) (λ (out) (write-html body out)))) diff --git a/src/page-proxy.rkt b/src/page-proxy.rkt index 3c22e1e..8dbf0f9 100644 --- a/src/page-proxy.rkt +++ b/src/page-proxy.rkt @@ -8,7 +8,6 @@ net/url web-server/http (only-in web-server/dispatchers/dispatch next-dispatcher) - "application-globals.rkt" "url-utils.rkt" "xexpr-utils.rkt") @@ -27,7 +26,6 @@ (response/output #:code (easy:response-status-code dest-r) #:mime-type (easy:response-headers-ref dest-r 'content-type) - #:headers (build-headers always-headers) (λ (out) (copy-port (easy:response-output dest-r) out) (easy:response-close! dest-r)))))) diff --git a/src/page-redirect-wiki-home.rkt b/src/page-redirect-wiki-home.rkt index c8e6dde..b0c3df3 100644 --- a/src/page-redirect-wiki-home.rkt +++ b/src/page-redirect-wiki-home.rkt @@ -2,7 +2,6 @@ (require net/url web-server/http "application-globals.rkt" - "data.rkt" "url-utils.rkt" "xexpr-utils.rkt") @@ -12,6 +11,5 @@ (define (redirect-wiki-home req) (response-handler (define wikiname (path/param-path (car (url-path (request-uri req))))) - (define siteinfo (siteinfo-fetch wikiname)) - (define dest (format "/~a/wiki/~a" wikiname (or (siteinfo^-basepage siteinfo) "Main_Page"))) + (define dest (format "/~a/wiki/Main_Page" wikiname)) (generate-redirect dest))) diff --git a/src/page-search.rkt b/src/page-search.rkt index 81a88b2..d42fce9 100644 --- a/src/page-search.rkt +++ b/src/page-search.rkt @@ -25,13 +25,13 @@ (define search-json-data '#hasheq((batchcomplete . #t) (query . #hasheq((search . (#hasheq((ns . 0) (pageid . 219) (size . 1482) (snippet . "") (timestamp . "2022-08-21T08:54:23Z") (title . "Gacha Capsule") (wordcount . 214)) #hasheq((ns . 0) (pageid . 201) (size . 1198) (snippet . "") (timestamp . "2022-07-11T17:52:47Z") (title . "Badges") (wordcount . 181))))))))) -(define (generate-results-page dest-url wikiname query data #:siteinfo [siteinfo #f]) +(define (generate-results-page dest-url wikiname query data #:license [license #f]) (define search-results (jp "/query/search" data)) (generate-wiki-page #:source-url dest-url #:wikiname wikiname #:title "Search Results" - #:siteinfo siteinfo + #:license license `(div (@ (class "mw-parser-output")) (p ,(format "~a results found for " (length search-results)) (strong ,query)) @@ -70,18 +70,18 @@ (thread-let ([dest-res (log-outgoing dest-url) (easy:get dest-url #:timeouts timeouts)] - [siteinfo (siteinfo-fetch wikiname)]) + [license (license-auto wikiname)]) (define data (easy:response-json dest-res)) - (define body (generate-results-page dest-url wikiname query data #:siteinfo siteinfo)) + (define body (generate-results-page dest-url wikiname query data #:license license)) (when (config-true? 'debug) ; used for its side effects ; convert to string with error checking, error will be raised if xexp is invalid (xexp->html body)) (response/output #:code 200 - #:headers (build-headers always-headers) + #:headers (list referrer-policy) (λ (out) (write-html body out)))))) (module+ test diff --git a/src/page-wiki.rkt b/src/page-wiki.rkt index effa40a..be24af8 100644 --- a/src/page-wiki.rkt +++ b/src/page-wiki.rkt @@ -252,7 +252,7 @@ ("format" . "json"))))) (log-outgoing dest-url) (easy:get dest-url #:timeouts timeouts)] - [siteinfo (siteinfo-fetch wikiname)]) + [license (license-auto wikiname)]) (cond [(eq? 200 (easy:response-status-code dest-res)) @@ -275,15 +275,13 @@ #:wikiname wikiname #:title title #:body-class body-class - #:siteinfo siteinfo)) + #:license license)) (define redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body))) - (define headers - (build-headers - always-headers - (when 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))]) - (header #"Refresh" value))))) + (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) 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 diff --git a/src/url-utils.rkt b/src/url-utils.rkt index 10df089..62f7cc2 100644 --- a/src/url-utils.rkt +++ b/src/url-utils.rkt @@ -2,8 +2,6 @@ (require racket/string "config.rkt" "pure-utils.rkt") -(require/typed web-server/http/request-structs - [#:opaque Header header?]) (provide ; regex to match wiki names @@ -15,9 +13,7 @@ ; check whether a url is on a domain controlled by fandom is-fandom-url? ; prints "out: " - log-outgoing - ; pass in a header, headers, or something useless. they'll all combine into a list - build-headers) + log-outgoing) (module+ test (require "typed-rackunit.rkt")) @@ -85,16 +81,3 @@ (define (log-outgoing url-string) (when (config-true? 'log_outgoing) (printf "out: ~a~n" url-string))) - -(: build-headers ((U Header (Listof Header) False Void) * -> (Listof Header))) -(define (build-headers . fs) - (apply - append - (map (λ ([f : (U Header (Listof Header) False Void)]) - (cond - [(not f) null] - [(void? f) null] - [(null? f) null] - [(header? f) (list f)] - [(pair? f) f])) - fs)))