diff options
Diffstat (limited to 'header-parsers.scm')
-rw-r--r-- | header-parsers.scm | 60 |
1 files changed, 52 insertions, 8 deletions
diff --git a/header-parsers.scm b/header-parsers.scm index 89edeae..ac41a09 100644 --- a/header-parsers.scm +++ b/header-parsers.scm @@ -376,18 +376,42 @@ (cons (substring/shared contents 0 idx) version) (cons contents #f)))) -;; bytes <start>-<end>/<total> +;; Try getting a submatch from an irregex match and parse it, or return #f +(define (try-parse-submatch match group-name parser) + (and-let* ((value (irregex-match-substring match group-name))) + (parser value))) + +;; bytes=<start>-<end> +;; bytes=<start>- +;; bytes=-<end> (define range-subparser (let ((range-regex + (irregex '(seq "bytes=" + (=> start (* digit)) "-" (=> end (* digit)))))) + (lambda (s) + (and-let* ((m (irregex-match range-regex s))) + (let ((start (try-parse-submatch m 'start string->number)) + (end (try-parse-submatch m 'end string->number))) + (if (or start end) + (list start end) + #f)))))) + +;; bytes <start>-<end>/<total> +;; bytes <start>-<end>/* +;; bytes */<total> +(define content-range-subparser + (let ((content-range-regex (irregex '(seq "bytes" (+ space) - (=> start (+ digit)) "-" (=> end (+ digit)) - "/" (=> total (+ digit)))))) + (or (seq "*/" (=> total (+ digit))) + (seq (=> start (+ digit)) "-" (=> end (+ digit)) + "/" (or "*" + (=> total (+ digit))))))))) (lambda (s) - (and-let* ((m (irregex-match range-regex s)) - (start (string->number (irregex-match-substring m 'start))) - (end (string->number (irregex-match-substring m 'end))) - (total (string->number (irregex-match-substring m 'total)))) - (list start end total))))) + (and-let* ((m (irregex-match content-range-regex s))) + (let ((start (try-parse-submatch m 'start string->number)) + (end (try-parse-submatch m 'end string->number)) + (total (try-parse-submatch m 'total string->number))) + (list start end total)))))) ;; Accept *just* a filename, not a full path (simply strips directories) ;; This matches the content-disposition recommendation in RFC2616, 19.5.1: @@ -724,6 +748,23 @@ (if (eq? 'weak (car etag)) "W/" "") (quote-string (cdr etag)))) ;; Etags are _always_ quoted +(define (unparse-content-range content-range) + ; False values are used to represent wildcards "*" + (let ((content-range-value-unparser (lambda (value) + (if value + (number->string value) + "*")))) + (string-append "bytes " + ; If the start and end are wildcards, use only one + (if (not (or (car content-range) (cadr content-range))) + "*" + (string-append + (content-range-value-unparser (car content-range)) + "-" + (content-range-value-unparser (cadr content-range)))) + "/" + (content-range-value-unparser (caddr content-range))))) + ;; There's no need to make a specific header unparser for every header type. ;; Usually, the Scheme value representing a header can unambiguously be ;; unparsed into a header just by checking its type. @@ -772,6 +813,9 @@ (read-date . ,rfc1123-time->string)) value-unparser: unparser))))) +(define (content-range-unparser header-contents) + (list (unparse-content-range (get-value (car header-contents))))) + (define (etag-unparser header-contents) (list (unparse-etag (get-value (car header-contents))))) |