From ddf895c5cfc0b7916fa6bb77de2d6fa1c424c4a0 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Mon, 22 Jun 2009 19:59:10 +0000 Subject: [PATCH] Allowing more flexibility with SSL key paths svn: r15234 --- .../scribblings/servlet-env-int.scrbl | 7 ++++--- .../web-server/scribblings/servlet-env.scrbl | 9 ++++++--- collects/web-server/servlet-dispatch.ss | 13 +++++++----- collects/web-server/servlet-env.ss | 20 +++++++++++-------- collects/web-server/templates.ss | 6 ------ 5 files changed, 30 insertions(+), 25 deletions(-) diff --git a/collects/web-server/scribblings/servlet-env-int.scrbl b/collects/web-server/scribblings/servlet-env-int.scrbl index 1980a85370..4de5445070 100644 --- a/collects/web-server/scribblings/servlet-env-int.scrbl +++ b/collects/web-server/scribblings/servlet-env-int.scrbl @@ -50,7 +50,8 @@ These functions optimize the construction of dispatchers and launching of server [#:banner? banner? boolean? #f] [#:listen-ip listen-ip (or/c false/c string?) "127.0.0.1"] [#:port port number? 8000] - [#:ssl-keys ssl-keys (or/c false/c (cons/c path-string? path-string?)) #f]) + [#:ssl-cert ssl-cert (or/c false/c path-string?) #f] + [#:ssl-key ssl-key (or/c false/c path-string?) #f]) void]{ The other interesting part of @scheme[serve/servlet] is its ability to start up a server and immediately launch a browser at it. This is provided by @scheme[serve/launch/wait]. @@ -64,8 +65,8 @@ These functions optimize the construction of dispatchers and launching of server The server listens on @scheme[listen-ip] and port @scheme[port]. - If @scheme[ssl-keys] is not false, then the server runs in HTTPS mode with @scheme[(car ssl-keys)] - and @scheme[(cdr ssl-keys)] as paths to the certificate and private key. + If @scheme[ssl-key] and @scheme[ssl-cert] are not false, then the server runs in HTTPS mode with @scheme[ssl-cert] + and @scheme[ssl-key] as paths to the certificate and private key. } } diff --git a/collects/web-server/scribblings/servlet-env.scrbl b/collects/web-server/scribblings/servlet-env.scrbl index ca3e325f24..37bc889d8e 100644 --- a/collects/web-server/scribblings/servlet-env.scrbl +++ b/collects/web-server/scribblings/servlet-env.scrbl @@ -110,7 +110,6 @@ and if @scheme[serve/servlet] is run in another module. [#:banner? banner? boolean? (not command-line?)] [#:listen-ip listen-ip (or/c false/c string?) "127.0.0.1"] [#:port port number? 8000] - [#:ssl? ssl? boolean? #f] [#:servlet-path servlet-path string? "/servlets/standalone.ss"] [#:servlet-regexp servlet-regexp regexp? @@ -135,6 +134,10 @@ and if @scheme[serve/servlet] is run in another module. "not-found.html"))] [#:mime-types-path mime-types-path path-string? ....] + [#:ssl? ssl? boolean? #f] + [#:ssl-cert ssl-cert (or/c false/c path-string?) (and ssl? (build-path server-root-path "server-cert.pem"))] + [#:ssl-key ssl-key (or/c false/c path-string?) (and ssl? (build-path server-root-path "private-key.pem"))] + [#:log-file log-file (or/c false/c path-string?) #f] [#:log-format log-format log-format/c 'apache-default]) void]{ @@ -154,8 +157,8 @@ and if @scheme[serve/servlet] is run in another module. The server listens on @scheme[listen-ip] and port @scheme[port]. - If @scheme[ssl?] is true, then the server runs in HTTPS mode with @filepath{/server-cert.pem} - and @filepath{/private-key.pem} as the certificates and private keys. + If @scheme[ssl-cert] and @scheme[ssl-key] are not false, then the server runs in HTTPS mode with @scheme[ssl-cert] + and @scheme[ssl-key] as the certificates and private keys. The servlet is loaded with @scheme[manager] as its continuation manager. (The default manager limits the amount of memory to 64 MB and diff --git a/collects/web-server/servlet-dispatch.ss b/collects/web-server/servlet-dispatch.ss index f95ec93519..1b9c036755 100644 --- a/collects/web-server/servlet-dispatch.ss +++ b/collects/web-server/servlet-dispatch.ss @@ -37,7 +37,8 @@ #:banner? boolean? #:listen-ip (or/c false/c string?) #:port number? - #:ssl-keys (or/c false/c (cons/c path-string? path-string?))) + #:ssl-cert (or/c false/c path-string?) + #:ssl-key (or/c false/c path-string?)) . ->* . void)]) @@ -92,9 +93,11 @@ [listen-ip "127.0.0.1"] #:port [port 8000] - #:ssl-keys - [ssl-keys #f]) - (define ssl? (pair? ssl-keys)) + #:ssl-cert + [ssl-cert #f] + #:ssl-key + [ssl-key #f]) + (define ssl? (and ssl-cert ssl-key)) (define server-url (string-append (if ssl? "https" "http") "://localhost" @@ -109,7 +112,7 @@ (let () (define-unit-binding ssl-tcp@ (make-ssl-tcp@ - (car ssl-keys) (cdr ssl-keys) + ssl-cert ssl-key #f #f #f #f #f) (import) (export tcp^)) ssl-tcp@) diff --git a/collects/web-server/servlet-env.ss b/collects/web-server/servlet-env.ss index 084bbd2301..299af248f1 100644 --- a/collects/web-server/servlet-env.ss +++ b/collects/web-server/servlet-env.ss @@ -45,6 +45,8 @@ #:listen-ip (or/c false/c string?) #:port number? #:ssl? boolean? + #:ssl-cert (or/c false/c path-string?) + #:ssl-key (or/c false/c path-string?) #:manager manager? #:servlet-namespace (listof module-path?) #:server-root-path path-string? @@ -84,9 +86,7 @@ #:listen-ip [listen-ip "127.0.0.1"] #:port - [the-port 8000] - #:ssl? - [ssl? #f] + [the-port 8000] #:manager [manager @@ -124,6 +124,13 @@ (if (file-exists? p) p (build-path default-web-root "mime.types")))] + + #:ssl? + [ssl? #f] + #:ssl-cert + [ssl-cert (and ssl? (build-path server-root-path "server-cert.pem"))] + #:ssl-key + [ssl-key (and ssl? (build-path server-root-path "private-key.pem"))] #:log-file [log-file #f] @@ -169,8 +176,5 @@ #:banner? banner? #:listen-ip listen-ip #:port the-port - #:ssl-keys - (if ssl? - (cons (build-path server-root-path "server-cert.pem") - (build-path server-root-path "private-key.pem")) - #f))) + #:ssl-cert ssl-cert + #:ssl-key ssl-key)) diff --git a/collects/web-server/templates.ss b/collects/web-server/templates.ss index 75a4bde825..fc1d8cae35 100644 --- a/collects/web-server/templates.ss +++ b/collects/web-server/templates.ss @@ -15,12 +15,6 @@ [(_ p) (string->xexpr (include-template p))])) -(define (string->xexpr s) - (with-input-from-string - s - (lambda () - (xml->xexpr (document-element (read-xml)))))) - (define-syntax in (syntax-rules () [(_ x xs e ...)