summaryrefslogtreecommitdiff
path: root/header-parsers.scm
diff options
context:
space:
mode:
Diffstat (limited to 'header-parsers.scm')
-rw-r--r--header-parsers.scm60
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)))))