Redirect /wikiname to its homepage

This commit is contained in:
Cadence Ember 2022-09-09 15:42:20 +12:00
parent 0a27f6d87f
commit 7a4bfe4180
Signed by: cadence
GPG key ID: BC1C2C61CF521B17
7 changed files with 47 additions and 21 deletions

View file

@ -13,6 +13,7 @@
(require-reloadable "src/page-home.rkt" page-home) (require-reloadable "src/page-home.rkt" page-home)
(require-reloadable "src/page-not-found.rkt" page-not-found) (require-reloadable "src/page-not-found.rkt" page-not-found)
(require-reloadable "src/page-proxy.rkt" page-proxy) (require-reloadable "src/page-proxy.rkt" page-proxy)
(require-reloadable "src/page-redirect-wiki-home.rkt" redirect-wiki-home)
(require-reloadable "src/page-search.rkt" page-search) (require-reloadable "src/page-search.rkt" page-search)
(require-reloadable "src/page-static.rkt" static-dispatcher) (require-reloadable "src/page-static.rkt" static-dispatcher)
(require-reloadable "src/page-subdomain.rkt" subdomain-dispatcher) (require-reloadable "src/page-subdomain.rkt" subdomain-dispatcher)
@ -35,6 +36,7 @@
page-proxy page-proxy
page-search page-search
page-wiki page-wiki
redirect-wiki-home
static-dispatcher static-dispatcher
subdomain-dispatcher)))) subdomain-dispatcher))))
(define server-t (thread start)) (define server-t (thread start))

View file

@ -1,6 +1,8 @@
#lang racket/base #lang racket/base
(require racket/string (require racket/string
net/http-easy (prefix-in easy: net/http-easy)
html-writing
web-server/http
"config.rkt" "config.rkt"
"xexpr-utils.rkt" "xexpr-utils.rkt"
"url-utils.rkt") "url-utils.rkt")
@ -11,13 +13,15 @@
; generates a consistent footer ; generates a consistent footer
application-footer application-footer
; generates a consistent template for wiki page content to sit in ; generates a consistent template for wiki page content to sit in
generate-wiki-page) generate-wiki-page
; generates a minimal but complete redirect to another page
generate-redirect)
(module+ test (module+ test
(require rackunit (require rackunit
html-writing)) html-writing))
(define timeouts (make-timeout-config #:lease 5 #:connect 5)) (define timeouts (easy:make-timeout-config #:lease 5 #:connect 5))
(define (application-footer source-url) (define (application-footer source-url)
`(footer (@ (class "custom-footer")) `(footer (@ (class "custom-footer"))
@ -102,3 +106,19 @@
(λ (t a c) (eq? t 'link)) (λ (t a c) (eq? t 'link))
page)))) page))))
"/proxy?dest=https%3A%2F%2Ftest.fandom.com"))) "/proxy?dest=https%3A%2F%2Ftest.fandom.com")))
(define (generate-redirect dest)
(define dest-bytes (string->bytes/utf-8 dest))
(response/output
#:code 302
#:headers (list (header #"Location" dest-bytes))
(λ (out)
(write-html
`(html
(head
(title "Redirecting..."))
(body
"Redirecting to "
(a (@ (href ,dest)) ,dest)
"..."))
out))))

View file

@ -67,5 +67,6 @@
(filter:make #rx"^/[a-z-]+/wiki/Category:.+$" (lift:make (hash-ref ds 'page-category))) (filter:make #rx"^/[a-z-]+/wiki/Category:.+$" (lift:make (hash-ref ds 'page-category)))
(filter:make #rx"^/[a-z-]+/wiki/.+$" (lift:make (hash-ref ds 'page-wiki))) (filter:make #rx"^/[a-z-]+/wiki/.+$" (lift:make (hash-ref ds 'page-wiki)))
(filter:make #rx"^/[a-z-]+/search$" (lift:make (hash-ref ds 'page-search))) (filter:make #rx"^/[a-z-]+/search$" (lift:make (hash-ref ds 'page-search)))
(filter:make #rx"^/[a-z-]+(/(wiki(/)?)?)?$" (lift:make (hash-ref ds 'redirect-wiki-home)))
(hash-ref ds 'static-dispatcher) (hash-ref ds 'static-dispatcher)
(lift:make (hash-ref ds 'page-not-found))))))) (lift:make (hash-ref ds 'page-not-found)))))))

View file

@ -37,6 +37,7 @@
,(apply format "~a: ~a" x)))) ,(apply format "~a: ~a" x))))
examples)) examples))
(h2 "Testimonials") (h2 "Testimonials")
(p (@ (class "testimonial")) ">So glad to never have to touch fandom's garbage platform directly ever again —RNL")
(p (@ (class "testimonial")) ">you are so right that fandom still sucks even with adblock somehow. even zapping all the stupid padding it still sucks —Minimus") (p (@ (class "testimonial")) ">you are so right that fandom still sucks even with adblock somehow. even zapping all the stupid padding it still sucks —Minimus")
(p (@ (class "testimonial")) ">attempting to go to a wiki's forum page with breezewiki doesn't work, which is based honestly —Tom Skeleton") (p (@ (class "testimonial")) ">attempting to go to a wiki's forum page with breezewiki doesn't work, which is based honestly —Tom Skeleton")
(p (@ (class "testimonial")) ">Fandom pages crashing and closing, taking forever to load and locking up as they load the ads on the site... they are causing the site to crash because they are trying to load video ads both at the top and bottom of the site as well as two or three banner ads, then a massive top of site ad and eventually my anti-virus shuts the whole site down because it's literally pulling more resources than WoW in ultra settings... —Anonymous") (p (@ (class "testimonial")) ">Fandom pages crashing and closing, taking forever to load and locking up as they load the ads on the site... they are causing the site to crash because they are trying to load video ads both at the top and bottom of the site as well as two or three banner ads, then a massive top of site ad and eventually my anti-virus shuts the whole site down because it's literally pulling more resources than WoW in ultra settings... —Anonymous")

View file

@ -0,0 +1,15 @@
#lang racket/base
(require net/url
web-server/http
"application-globals.rkt"
"url-utils.rkt"
"xexpr-utils.rkt")
(provide
redirect-wiki-home)
(define (redirect-wiki-home req)
(response-handler
(define wikiname (path/param-path (car (url-path (request-uri req)))))
(define dest (format "~a/wiki/Main_Page" wikiname))
(generate-redirect dest)))

View file

@ -3,9 +3,8 @@
racket/string racket/string
net/url net/url
web-server/http web-server/http
web-server/servlet-dispatch
html-writing
(prefix-in lift: web-server/dispatchers/dispatch-lift) (prefix-in lift: web-server/dispatchers/dispatch-lift)
"application-globals.rkt"
"config.rkt" "config.rkt"
"xexpr-utils.rkt") "xexpr-utils.rkt")
@ -20,17 +19,4 @@
(define path (url-path uri)) (define path (url-path uri))
(define path-string (string-join (map (λ (p) (path/param-path p)) path) "/")) (define path-string (string-join (map (λ (p) (path/param-path p)) path) "/"))
(define dest (format "~a/~a/~a" (config-get 'canonical_origin) subdomain path-string)) (define dest (format "~a/~a/~a" (config-get 'canonical_origin) subdomain path-string))
(define dest-bytes (string->bytes/utf-8 dest)) (generate-redirect dest)))))
(response/output
#:code 302
#:headers (list (header #"Location" dest-bytes))
(λ (out)
(write-html
`(html
(head
(title "Redirecting..."))
(body
"Redirecting to "
(a (@ (href ,dest)) ,dest)
"..."))
out)))))))

View file

@ -197,6 +197,7 @@
(λ (out) (λ (out)
(for ([port (list (current-error-port) out)]) (for ([port (list (current-error-port) out)])
(parameterize ([current-error-port port]) (parameterize ([current-error-port port])
(with-handlers ([exn:fail? (λ (e) (void))])
(displayln "Exception raised in Racket code at response generation time:" (current-error-port)) (displayln "Exception raised in Racket code at response generation time:" (current-error-port))
((error-display-handler) (exn-message e) e))))))]) ((error-display-handler) (exn-message e) e)))))))])
body ...)) body ...))