Move the semicolon fixing code again

This commit is contained in:
Cadence Ember 2023-05-27 23:37:45 +12:00
parent ca13aea547
commit 6fef9281c3
Signed by: cadence
GPG key ID: BC1C2C61CF521B17
3 changed files with 24 additions and 14 deletions

View file

@ -11,7 +11,7 @@
url-segments->guess-title) url-segments->guess-title)
(define (local-encoded-url->segments str) ; '("wiki" "Page_title") (define (local-encoded-url->segments str) ; '("wiki" "Page_title")
(map path/param-path (url-path (string->url str)))) (map path/param-path (fix-semicolons-url-path (url-path (string->url str)))))
(define (url-segments->basename segments) ; "Page_title" filename encoded, no extension or dir prefix (define (url-segments->basename segments) ; "Page_title" filename encoded, no extension or dir prefix
(define extra-encoded (map (λ (s) (bytes->string/latin-1 (percent-encode s filename-set #f))) (cdr segments))) (define extra-encoded (map (λ (s) (bytes->string/latin-1 (percent-encode s filename-set #f))) (cdr segments)))

View file

@ -1,5 +1,6 @@
#lang typed/racket/base #lang typed/racket/base
(require racket/string (require racket/string
typed/net/url-structs
"pure-utils.rkt") "pure-utils.rkt")
(require/typed web-server/http/request-structs (require/typed web-server/http/request-structs
[#:opaque Header header?]) [#:opaque Header header?])
@ -20,7 +21,10 @@
; pass in a header, headers, or something useless. they'll all combine into a list ; pass in a header, headers, or something useless. they'll all combine into a list
build-headers build-headers
; try to follow wikimedia's format for which characters should be encoded/replaced in page titles for the url ; try to follow wikimedia's format for which characters should be encoded/replaced in page titles for the url
page-title->path) page-title->path
; path/param eats semicolons into params, which need to be fixed back into semicolons
fix-semicolons-url-path
fix-semicolons-url)
(module+ test (module+ test
(require "typed-rackunit.rkt")) (require "typed-rackunit.rkt"))
@ -106,3 +110,20 @@
(: page-title->path (String -> Bytes)) (: page-title->path (String -> Bytes))
(define (page-title->path title) (define (page-title->path title)
(percent-encode (regexp-replace* " " title "_") path-set #f)) (percent-encode (regexp-replace* " " title "_") path-set #f))
(: fix-semicolons-url-path ((Listof Path/Param) -> (Listof Path/Param)))
(define (fix-semicolons-url-path pps)
(for/list ([pp pps])
(define path (path/param-path pp))
(if (or (null? (path/param-param pp))
(symbol? path))
pp
;; path/param does have params, which need to be fixed into a semicolon.
(path/param
(string-append path ";" (string-join (path/param-param pp) ";"))
null))))
(: fix-semicolons-url (URL -> URL))
(define (fix-semicolons-url orig-url)
(struct-copy url orig-url [path (fix-semicolons-url-path (url-path orig-url))]))

View file

@ -59,16 +59,5 @@
(make-semicolon-fixer-dispatcher tree)) (make-semicolon-fixer-dispatcher tree))
(define ((make-semicolon-fixer-dispatcher orig-dispatcher) conn orig-req) (define ((make-semicolon-fixer-dispatcher orig-dispatcher) conn orig-req)
(define orig-uri (request-uri orig-req)) (define new-req (struct-copy request orig-req [uri (fix-semicolons-url (request-uri orig-req))]))
(define pps (url-path orig-uri)) ; list of path/param structs
(define new-path
(for/list ([pp pps])
(if (null? (path/param-param pp))
pp
;; path/param does have params, which need to be fixed into a semicolon.
(path/param
(string-append (path/param-path pp) ";" (string-join (path/param-param pp) ";"))
null))))
(define new-uri (struct-copy url orig-uri [path new-path]))
(define new-req (struct-copy request orig-req [uri new-uri]))
(orig-dispatcher conn new-req)) (orig-dispatcher conn new-req))