commit 90b23a7af9eb51c72c0c8b19ae97abb8fcffeeb9 parent d82ef5762d8efc1923f9737ac5ee817173b2b2d4 Author: Natasha Kerensikova <natgh@instinctive.eu> Date: Thu, 28 May 2026 18:24:48 +0000 URL parser is refactored into global variables Diffstat:
| M | src/cgi.scm | | | 76 | +++++++++++++++++++++++++++++++++++++++++----------------------------------- |
1 file changed, 41 insertions(+), 35 deletions(-)
diff --git a/src/cgi.scm b/src/cgi.scm @@ -107,42 +107,48 @@ END-OF-CSS (let ((ct (get-environment-variable "CONTENT_LENGTH"))) (if ct (string->number ct) 0))) (define input-text (read-string content-length)) +(define url-hdigit + (any-of (preceded-by (is #\0) (result 0)) + (preceded-by (is #\1) (result 1)) + (preceded-by (is #\2) (result 2)) + (preceded-by (is #\3) (result 3)) + (preceded-by (is #\4) (result 4)) + (preceded-by (is #\5) (result 5)) + (preceded-by (is #\6) (result 6)) + (preceded-by (is #\7) (result 7)) + (preceded-by (is #\8) (result 8)) + (preceded-by (is #\9) (result 9)) + (preceded-by (is #\a) (result 10)) + (preceded-by (is #\A) (result 10)) + (preceded-by (is #\b) (result 11)) + (preceded-by (is #\B) (result 11)) + (preceded-by (is #\c) (result 12)) + (preceded-by (is #\C) (result 12)) + (preceded-by (is #\d) (result 13)) + (preceded-by (is #\D) (result 13)) + (preceded-by (is #\e) (result 14)) + (preceded-by (is #\E) (result 14)) + (preceded-by (is #\f) (result 15)) + (preceded-by (is #\F) (result 15)))) +(define url-percent-escape + (sequence* ((_ (is #\%)) + (h url-hdigit) + (l url-hdigit)) + (result (integer->char (+ (* 16 h) l))))) +(define url-value + (as-string (repeated (any-of url-percent-escape item) until: (is #\&))) +(define url-key + (as-string (repeated item until: (is #\=)))) +(define url-kv-pair + (sequence* ((k url-key) + (_ (is #\=)) + (v url-value) + (_ (is #\&))) + (result (list k (string-translate v "\r"))))) +(define url-kv-pairs + (zero-or-more url-kv-pair)) (define input-list - (let* ((hdigit* (any-of (preceded-by (is #\0) (result 0)) - (preceded-by (is #\1) (result 1)) - (preceded-by (is #\2) (result 2)) - (preceded-by (is #\3) (result 3)) - (preceded-by (is #\4) (result 4)) - (preceded-by (is #\5) (result 5)) - (preceded-by (is #\6) (result 6)) - (preceded-by (is #\7) (result 7)) - (preceded-by (is #\8) (result 8)) - (preceded-by (is #\9) (result 9)) - (preceded-by (is #\a) (result 10)) - (preceded-by (is #\A) (result 10)) - (preceded-by (is #\b) (result 11)) - (preceded-by (is #\B) (result 11)) - (preceded-by (is #\c) (result 12)) - (preceded-by (is #\C) (result 12)) - (preceded-by (is #\d) (result 13)) - (preceded-by (is #\D) (result 13)) - (preceded-by (is #\e) (result 14)) - (preceded-by (is #\E) (result 14)) - (preceded-by (is #\f) (result 15)) - (preceded-by (is #\F) (result 15)))) - (pct* (sequence* ((_ (is #\%)) - (h hdigit*) - (l hdigit*)) - (result (integer->char (+ (* 16 h) l))))) - (value* (as-string (repeated (any-of pct* item) until: (is #\&)))) - (name* (as-string (repeated item until: (is #\=)))) - (pair* (sequence* ((n name*) - (_ (is #\=)) - (v value*) - (_ (is #\&))) - (result (list n (string-translate v "\r"))))) - (parser (zero-or-more pair*))) - (parse parser (string-append input-text "&")))) + (parse url-kv-pairs (string-append input-text "&"))) (define (input-var name) (let loop ((rest input-list)) (cond ((null? rest) #f)