Expose private key format options

web-server-doc/web-server/scribblings/launch.scrbl

@@ -188,12 +188,16 @@ A default implementation of the dispatch server's connection-conversion abstract
 
 
 @defproc[(make-ssl-connect@ [server-cert-file path-string?]
-                            [server-key-file path-string?])
+                            [server-key-file path-string?]
+                            [#:key-rsa? key-rsa? boolean? #t]
+                            [#:key-asn1? key-asn1? boolean? #f])
          (unit/c (import) (export dispatch-server-connect^))]{
 
 Constructs an implementation of the dispatch server's connection-conversion abstraction for OpenSSL.
 
-@history[#:added "1.1"]}
+@history[#:changed "8.16"
+         @elem{Added the @racket[#:key-rsa?] and @racket[#:key-asn1?] arguments.}
+         #:added "1.1"]}
 
 
 @defproc[(do-not-return) none/c]{

web-server-doc/web-server/scribblings/servlet-env-int.scrbl

@@ -66,6 +66,8 @@ These functions optimize the construction of dispatchers and launching of server
           [#:port port number? 8000]
           [#:ssl-cert ssl-cert (or/c #f path-string?) #f]
           [#:ssl-key ssl-key (or/c #f path-string?) #f]
+          [#:ssl-key-rsa? ssl-key-rsa? boolean? #t]
+          [#:ssl-key-asn1? ssl-key-asn1? boolean? #f]
           [#:max-waiting max-waiting exact-nonnegative-integer? 511]
           [#:safety-limits safety-limits safety-limits?
            (make-safety-limits #:max-waiting max-waiting)])
@@ -86,7 +88,8 @@ These functions optimize the construction of dispatchers and launching of server
  For example, providing @racket["127.0.0.1"] (the default) as @racket[listen-ip] creates a server that accepts only connections to @racket["127.0.0.1"] (the loopback interface) from the local machine.
 
  If @racket[ssl-key] and @racket[ssl-cert] are not false, then the server runs in HTTPS mode with @racket[ssl-cert]
- and @racket[ssl-key] as paths to the certificate and private key.    
+ and @racket[ssl-key] as paths to the certificate and private key. 
+ The @racket[ssl-key-rsa?] and @racket[ssl-key-asn1?] arguments specify the format of the private key file.   
 
  If @racket[connection-close?] is @racket[#t], then every connection is closed after one
  request. Otherwise, the client decides based on what HTTP version it uses.
@@ -101,7 +104,9 @@ These functions optimize the construction of dispatchers and launching of server
   If neither @racket[max-waiting] nor @racket[safety-limits] are given,
   the default @tech{safety limits} value is equivalent to @racket[(make-safety-limits)].
 
-  @history[#:changed "1.6"
+  @history[#:changed "8.16"
+           @elem{Added the @racket[#:key-rsa?] and @racket[#:key-asn1?] arguments.}
+           #:changed "1.6"
            @elem{Added the @racket[safety-limits] argument:
               see @elemref["safety-limits-porting"]{compatability note}.}]
 }

web-server-doc/web-server/scribblings/servlet-env.scrbl

@@ -176,7 +176,8 @@ Like always, you don't even need to save the file.
                         [#:ssl? ssl? boolean? #f]
                         [#:ssl-cert ssl-cert (or/c #f path-string?) (and ssl? (build-path server-root-path "server-cert.pem"))]
                         [#:ssl-key ssl-key (or/c #f path-string?) (and ssl? (build-path server-root-path "private-key.pem"))]
-
+                        [#:ssl-key-rsa? ssl-key-rsa? boolean? #t]
+                        [#:ssl-key-asn1? ssl-key-asn1? boolean? #f]
                         [#:log-file log-file (or/c #f path-string? output-port?) #f]
                         [#:log-format log-format (or/c log-format/c format-reqresp/c) 'apache-default])
                        any]{
@@ -208,6 +209,7 @@ customizations do not, which the rest of this section describes.
 
  If @racket[ssl-cert] and @racket[ssl-key] are not false, then the server runs in HTTPS mode with @racket[ssl-cert]
  and @racket[ssl-key] as the certificates and private keys.
+ The @racket[ssl-key-rsa?] and @racket[ssl-key-asn1?] arguments specify the format of the private key file. 
 
  The servlet is loaded with @racket[manager]
  as its continuation manager. (The default manager limits the amount of memory to 64 MB and
@@ -242,7 +244,9 @@ order they appear in the list.
  If @racket[connection-close?] is @racket[#t], then every connection is closed after one
  request. Otherwise, the client decides based on what HTTP version it uses.
 
- @history[#:changed "1.6"
+ @history[#:changed "8.16"
+          @elem{Added the @racket[#:ssl-key-rsa?] and @racket[#:ssl-key-asn1?] arguments.}
+          #:changed "1.6"
           @elem{Added the @racket[safety-limits] argument as with @racket[serve/launch/wait]:
             see @elemref["safety-limits-porting"]{compatability note}.}
           #:changed "1.3"

web-server-lib/web-server/servlet-dispatch.rkt

@@ -47,7 +47,9 @@
                       #:max-waiting timeout/c
                       #:safety-limits safety-limits?
                       #:ssl-cert (or/c #f path-string?)
-                      #:ssl-key (or/c #f path-string?))
+                      #:ssl-key (or/c #f path-string?)
+                      #:ssl-key-rsa? boolean?
+                      #:ssl-key-asn1? boolean?)
                      . ->* .
                      any)])
 
@@ -86,8 +88,8 @@
                  (parameterize ([current-custodian (make-custodian)]
                                 [current-namespace namespace-now])
                    (if stateless?
-                     (make-stateless.servlet servlet-current-directory stuffer manager start)
-                     (make-v2.servlet servlet-current-directory manager start)))])
+                       (make-stateless.servlet servlet-current-directory stuffer manager start)
+                       (make-v2.servlet servlet-current-directory manager start)))])
             (set-box! servlet-box servlet)
             servlet))))))
 
@@ -105,14 +107,18 @@
          [listen-ip "127.0.0.1"]
          #:port
          [port-arg 8000]
-         
+
          #:max-waiting [_max-waiting 511]
          #:safety-limits [limits (make-safety-limits #:max-waiting _max-waiting)]
-         
+
          #:ssl-cert
          [ssl-cert #f]
          #:ssl-key
-         [ssl-key #f])
+         [ssl-key #f]
+         #:ssl-key-rsa?
+         [ssl-key-rsa? #t]
+         #:ssl-key-asn1?
+         [ssl-key-asn1? #f])
   (define ssl? (and ssl-cert ssl-key))
   (define sema (make-semaphore 0))
   (define confirm-ch (make-async-channel 1))
@@ -124,38 +130,38 @@
            #:port port-arg
            #:safety-limits limits
            #:dispatch-server-connect@ (if ssl?
-                                        (make-ssl-connect@ ssl-cert ssl-key)
-                                        raw:dispatch-server-connect@)))
+                                          (make-ssl-connect@ ssl-cert ssl-key #:key-rsa? ssl-key-rsa? #:key-asn1? ssl-key-asn1?)
+                                          raw:dispatch-server-connect@)))
   (define serve-res (async-channel-get confirm-ch))
   (if (exn? serve-res)
-    (begin
-      (when banner? (eprintf "There was an error starting the Web server.\n"))
-      (match serve-res
-        [(app exn-message (regexp "tcp-listen: listen on .+ failed \\(Address already in use; errno=.+\\)" (list _)))
-         (when banner? (eprintf "\tThe TCP port (~a) is already in use.\n" port-arg))]
-        [_
-         (void)]))
-    (local [(define port serve-res)
-            (define server-url
-              (string-append (if ssl? "https" "http")
-                             "://localhost"
-                             (if (and (not ssl?) (= port 80))
-                               "" (format ":~a" port))))]
-      (when launch-path
-        ((send-url) (string-append server-url launch-path) #t))
-      (when banner?
-        (printf "Your Web application is running at ~a.\n"
-                (if launch-path
-                  (string-append server-url launch-path)
-                  server-url))
-        (printf "Stop this program at any time to terminate the Web Server.\n")
-        (flush-output))
-      (let ([bye (lambda ()
-                   (when banner? (printf "\nWeb Server stopped.\n"))
-                   (shutdown-server))])
-        (with-handlers ([exn:break? (lambda (exn) (bye))])
-          (semaphore-wait/enable-break sema)
-          ; Give the final response time to get there
-          (sleep 2)
-          ;; We can get here if a /quit url is visited
-          (bye))))))
+      (begin
+        (when banner? (eprintf "There was an error starting the Web server.\n"))
+        (match serve-res
+          [(app exn-message (regexp "tcp-listen: listen on .+ failed \\(Address already in use; errno=.+\\)" (list _)))
+           (when banner? (eprintf "\tThe TCP port (~a) is already in use.\n" port-arg))]
+          [_
+           (void)]))
+      (local [(define port serve-res)
+              (define server-url
+                (string-append (if ssl? "https" "http")
+                               "://localhost"
+                               (if (and (not ssl?) (= port 80))
+                                   "" (format ":~a" port))))]
+        (when launch-path
+          ((send-url) (string-append server-url launch-path) #t))
+        (when banner?
+          (printf "Your Web application is running at ~a.\n"
+                  (if launch-path
+                      (string-append server-url launch-path)
+                      server-url))
+          (printf "Stop this program at any time to terminate the Web Server.\n")
+          (flush-output))
+        (let ([bye (lambda ()
+                     (when banner? (printf "\nWeb Server stopped.\n"))
+                     (shutdown-server))])
+          (with-handlers ([exn:break? (lambda (exn) (bye))])
+            (semaphore-wait/enable-break sema)
+            ; Give the final response time to get there
+            (sleep 2)
+            ;; We can get here if a /quit url is visited
+            (bye))))))

web-server-lib/web-server/servlet-env.rkt

@@ -54,6 +54,8 @@
                   #:ssl? boolean?
                   #:ssl-cert (or/c #f path-string?)
                   #:ssl-key (or/c #f path-string?)
+                  #:ssl-key-rsa? boolean?
+                  #:ssl-key-asn1? boolean?
                   #:manager manager?
                   #:servlet-namespace (listof module-path?)
                   #:server-root-path path-string?
@@ -142,16 +144,19 @@
          #:mime-types-path
          [mime-types-path (let ([p (build-path server-root-path "mime.types")])
                             (if (file-exists? p)
-                              p
-                              (build-path default-web-root "mime.types")))]
+                                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"))]
-
+         #:ssl-key-rsa?
+         [ssl-key-rsa? #t]
+         #:ssl-key-asn1?
+         [ssl-key-asn1? #f]
          #:log-file
          [log-file #f]
          #:log-format
@@ -210,4 +215,6 @@
    #:port the-port
    #:safety-limits limits
    #:ssl-cert ssl-cert
-   #:ssl-key ssl-key))
+   #:ssl-key ssl-key
+   #:ssl-key-rsa? ssl-key-rsa?
+   #:ssl-key-asn1? ssl-key-asn1?))

web-server-lib/web-server/web-server.rkt

@@ -60,8 +60,9 @@
        (-> any/c))]
  [raw:dispatch-server-connect@ (unit/c (import) (export dispatch-server-connect^))]
  [make-ssl-connect@
-  (-> path-string? path-string?
-      (unit/c (import) (export dispatch-server-connect^)))]
+  (->* (path-string? path-string?)
+       (#:key-rsa? boolean? #:key-asn1? boolean?)
+       (unit/c (import) (export dispatch-server-connect^)))]
  [do-not-return (-> none/c)]
  [serve/web-config@
   (->*
@@ -70,11 +71,11 @@
     #:tcp@ (unit/c (import) (export tcp^)))
    (-> any/c))])
 
-(define (make-ssl-connect@ server-cert-file server-key-file)
+(define (make-ssl-connect@ server-cert-file server-key-file #:key-rsa? [key-rsa? #t] #:key-asn1? [key-asn1? #f])
   (define the-ctxt
     (ssl-make-server-context))
   (ssl-load-certificate-chain! the-ctxt server-cert-file)
-  (ssl-load-private-key! the-ctxt server-key-file)
+  (ssl-load-private-key! the-ctxt server-key-file key-rsa? key-asn1?)
   (define-unit ssl:dispatch-server-connect@
     (import) (export dispatch-server-connect^)
     (define (port->real-ports ip op)