diff --git a/web-server-doc/web-server/scribblings/launch.scrbl b/web-server-doc/web-server/scribblings/launch.scrbl index 066e9955..4a977fc7 100644 --- a/web-server-doc/web-server/scribblings/launch.scrbl +++ b/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]{ diff --git a/web-server-doc/web-server/scribblings/servlet-env-int.scrbl b/web-server-doc/web-server/scribblings/servlet-env-int.scrbl index bdaa030d..307603d5 100644 --- a/web-server-doc/web-server/scribblings/servlet-env-int.scrbl +++ b/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}.}] } diff --git a/web-server-doc/web-server/scribblings/servlet-env.scrbl b/web-server-doc/web-server/scribblings/servlet-env.scrbl index 1516b0a7..b0f9cf61 100644 --- a/web-server-doc/web-server/scribblings/servlet-env.scrbl +++ b/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" diff --git a/web-server-lib/web-server/servlet-dispatch.rkt b/web-server-lib/web-server/servlet-dispatch.rkt index 469de662..9d4b1d45 100644 --- a/web-server-lib/web-server/servlet-dispatch.rkt +++ b/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)))))) diff --git a/web-server-lib/web-server/servlet-env.rkt b/web-server-lib/web-server/servlet-env.rkt index 2635002e..9fe4dbdd 100644 --- a/web-server-lib/web-server/servlet-env.rkt +++ b/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,8 +144,8 @@ #: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] @@ -151,7 +153,10 @@ [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?)) diff --git a/web-server-lib/web-server/web-server.rkt b/web-server-lib/web-server/web-server.rkt index 3f012cef..23339099 100644 --- a/web-server-lib/web-server/web-server.rkt +++ b/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)