Allowing more flexibility with SSL key paths

svn: r15234

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)]
+ If @scheme[ssl-key] and @scheme[ssl-cert] are not false, then the server runs in HTTPS mode with @scheme[ssl-cert]
- and @scheme[(cdr ssl-keys)] as paths to the certificate and private key.    
+ and @scheme[ssl-key] as paths to the certificate and private key.    
 }
               
 }

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-root-path>/server-cert.pem}
+ If @scheme[ssl-cert] and @scheme[ssl-key] are not false, then the server runs in HTTPS mode with @scheme[ssl-cert]
- and @filepath{<server-root-path>/private-key.pem} as the certificates and private keys.
+ 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

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-cert
-         [ssl-keys #f])
+         [ssl-cert #f]
-  (define ssl? (pair? ssl-keys))
+         #: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@)

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]
+         [the-port 8000]         
-         #:ssl?
-         [ssl? #f]
 
          #: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
+   #:ssl-cert ssl-cert
-   (if ssl?
+   #:ssl-key ssl-key))
-       (cons (build-path server-root-path "server-cert.pem")
-             (build-path server-root-path "private-key.pem"))
-       #f)))

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 ...)