diff --git a/collects/net/cookie-sig.ss b/collects/net/cookie-sig.ss index 390f5be3d6..5c492cdaee 100644 --- a/collects/net/cookie-sig.ss +++ b/collects/net/cookie-sig.ss @@ -1,5 +1,7 @@ #lang scheme/signature +cookie-name? +cookie-value? cookie? valid-domain? set-cookie diff --git a/collects/net/cookie-unit.ss b/collects/net/cookie-unit.ss index b3d3b5c21a..f7f19e914e 100644 --- a/collects/net/cookie-unit.ss +++ b/collects/net/cookie-unit.ss @@ -294,13 +294,14 @@ ;; ;; Returns whether this is a valid string to use as the value or the ;; name (depending on value?) of an HTTP cookie. -(define (cookie-string? s [value? #t]) - (unless (string? s) - (error* "string expected, received: ~a" s)) - (if value? - (rfc2109:value? s) - ;; name: token - (rfc2068:token? s))) +(define (cookie-value? s) + (and (string? s) + (rfc2109:value? s))) + +(define (cookie-name? s) + (and (string? s) + ;; name: token + (rfc2068:token? s))) ;; Host names as per RFC 1123 and RFC952, more or less, anyway. :-) (define char-set:hostname diff --git a/collects/net/scribblings/cookie.scrbl b/collects/net/scribblings/cookie.scrbl index 75cbff2afc..ef983332ae 100644 --- a/collects/net/scribblings/cookie.scrbl +++ b/collects/net/scribblings/cookie.scrbl @@ -25,7 +25,15 @@ otherwise.} Returns @scheme[#t] if @scheme[v] represents a valid domain, @scheme[#f] otherwise. } -@defproc[(set-cookie [name string?] [value string?]) cookie?]{ +@defproc[(cookie-name? [v any/c]) boolean?]{ + Returns @scheme[#t] if @scheme[v] is a valid cookie name string, @scheme[#f] otherwise. +} + +@defproc[(cookie-value? [v any/c]) boolean?]{ + Returns @scheme[#t] if @scheme[v] is a valid cookie value string, @scheme[#f] otherwise. +} + +@defproc[(set-cookie [name cookie-name?] [value cookie-value?]) cookie?]{ Creates a new cookie, with default values for required fields.} @@ -74,7 +82,7 @@ Prints @scheme[cookie] to a string. Empty fields do not appear in the output except when there is a required default.} -@defproc[(get-cookie [name string?] [cookies string?]) (listof string?)]{ +@defproc[(get-cookie [name cookie-name?] [cookies string?]) (listof cookie-value?)]{ Returns a list with all the values (strings) associated with @scheme[name]. @@ -86,7 +94,7 @@ initial-request structure, etc. The @scheme[get-cookie] and from a @scheme["Cookie"] field value.} -@defproc[(get-cookie/single [name string?] [cookies string?]) (or/c string? false/c)]{ +@defproc[(get-cookie/single [name cookie-name?] [cookies string?]) (or/c cookie-value? false/c)]{ Like @scheme[get-cookie], but returns the just first value string associated to @scheme[name], or #f if no association is found.} diff --git a/collects/web-server/http/cookie.ss b/collects/web-server/http/cookie.ss index f6cc9c953e..8a6e3d3c47 100644 --- a/collects/web-server/http/cookie.ss +++ b/collects/web-server/http/cookie.ss @@ -7,7 +7,7 @@ scheme/contract) (provide/contract - [make-cookie ((string? string?) (#:comment (or/c false/c string?) + [make-cookie ((cookie-name? cookie-value?) (#:comment (or/c false/c string?) #:domain (or/c false/c valid-domain?) #:max-age (or/c false/c exact-nonnegative-integer?) #:path (or/c false/c string?) diff --git a/collects/web-server/scribblings/http.scrbl b/collects/web-server/scribblings/http.scrbl index 06619ef2c1..d242ea5c00 100644 --- a/collects/web-server/scribblings/http.scrbl +++ b/collects/web-server/scribblings/http.scrbl @@ -271,7 +271,7 @@ transmission that the server @bold{will not catch}.} @defmodule[web-server/http/cookie]{ This module provides functions to create cookies and responses that set them. - @defproc[(make-cookie [name string?] [value string?] + @defproc[(make-cookie [name cookie-name?] [value cookie-value?] [#:comment comment (or/c false/c string?) #f] [#:domain domain (or/c false/c valid-domain?) #f] [#:max-age max-age (or/c false/c exact-nonnegative-integer?) #f]