From fd6dfdbbc450e499994f564e352c7daf0f14b1c3 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 11 Nov 2008 23:31:26 +0000 Subject: [PATCH] Better SSL support svn: r12396 --- collects/tests/web-server/test-ssl.sh | 6 ++ collects/web-server/private/launch.ss | 36 +++++++-- collects/web-server/scribblings/faq.scrbl | 71 +++-------------- collects/web-server/scribblings/running.scrbl | 12 +-- .../scribblings/tutorial/continue.scrbl | 79 ++----------------- collects/web-server/web-server.ss | 8 +- 6 files changed, 68 insertions(+), 144 deletions(-) create mode 100644 collects/tests/web-server/test-ssl.sh diff --git a/collects/tests/web-server/test-ssl.sh b/collects/tests/web-server/test-ssl.sh new file mode 100644 index 0000000000..76b4d6400e --- /dev/null +++ b/collects/tests/web-server/test-ssl.sh @@ -0,0 +1,6 @@ +#!/bin/sh + +openssl genrsa -des3 -out private-key.pem 1024 +openssl rsa -in private-key.pem -out private-key.pem +chmod 400 private-key.pem +openssl req -new -x509 -nodes -sha1 -days 365 -key private-key.pem > server-cert.pem diff --git a/collects/web-server/private/launch.ss b/collects/web-server/private/launch.ss index 3f911f7226..c24473910c 100644 --- a/collects/web-server/private/launch.ss +++ b/collects/web-server/private/launch.ss @@ -1,6 +1,10 @@ -#lang scheme/base -(require mzlib/cmdline - mzlib/pregexp) +#lang scheme +(require scheme/cmdline + scheme/unit + mzlib/pregexp + net/tcp-sig + net/tcp-unit + net/ssl-tcp-unit) (require "../configuration/configuration-table.ss" (except-in "../web-server.ss" serve) "../web-config-unit.ss") @@ -13,11 +17,19 @@ (cdr x) default))) +(define ssl (make-parameter #f)) +(define port (make-parameter 80)) + (define configuration@ (parse-command-line "plt-web-server" (current-command-line-arguments) `((once-each + [("--ssl") + ,(lambda (flag) + (port 443) + (ssl #t)) + ("Run with SSL using server-cert.pem and private-key.pem in the current directory, with 443 as the default port.")] [("-f" "--configuration-table") ,(lambda (flag file-name) (cond @@ -28,8 +40,8 @@ [else (cons 'config (string->path file-name))])) ("Use an alternate configuration table" "file-name")] [("-p" "--port") - ,(lambda (flag port) - (cons 'port (string->number port))) + ,(lambda (flag the-port) + (port (string->number the-port))) ("Use an alternate network port." "port")] [("-a" "--ip-address") ,(lambda (flag ip-address) @@ -46,11 +58,21 @@ (lambda (flags) (configuration-table->web-config@ (extract-flag 'config flags default-configuration-table-path) - #:port (extract-flag 'port flags #f) + #:port (port) #:listen-ip (extract-flag 'ip-address flags #f))) '())) (define (serve) - (serve/web-config@ configuration@)) + (serve/web-config@ + configuration@ + #:tcp@ (if (ssl) + (let () + (define-unit-binding ssl-tcp@ + (make-ssl-tcp@ (build-path (current-directory) "server-cert.pem") + (build-path (current-directory) "private-key.pem") + #f #f #f #f #f) + (import) (export tcp^)) + ssl-tcp@) + tcp@))) (provide serve) diff --git a/collects/web-server/scribblings/faq.scrbl b/collects/web-server/scribblings/faq.scrbl index 742a24577c..e6a28ff224 100644 --- a/collects/web-server/scribblings/faq.scrbl +++ b/collects/web-server/scribblings/faq.scrbl @@ -67,70 +67,25 @@ Second, if you want to make your own Scheme start-up script, you can write: @section[#:tag "faq:https"]{How do I set up the server to use HTTPS?} -The essence of the solution to this problem is to use an SSL TCP implementation as provided by @schememodname[net/ssl-tcp-unit]. Many of the functions that start the Web Server are parameterized by a @scheme[tcp@] unit. If you pass an SSL unit, then the server will be serving HTTPS. However, to do this, you must write your own start up script. Here's a simple example: +This requires an SSL certificate and private key. This is very platform specific, but we will provide +the details for using OpenSSL on UNIX: -@(require (for-label scheme/unit) - (for-label net/ssl-tcp-unit) - (for-label net/tcp-sig) - (for-label net/tcp-unit) - (for-label web-server/web-server) - (for-label web-server/web-server-unit) - (for-label web-server/web-server-sig) - (for-label web-server/web-config-sig) - (for-label web-server/web-config-unit) - (for-label web-server/configuration/namespace)) +@commandline{openssl genrsa -des3 -out private-key.pem 1024} -@schememod[ -scheme +This will generate a new private key, but it will have a passphrase on it. You can remove this via: -@code:comment{Load the appropriate libraries to reimplement server} -(require scheme/unit - net/ssl-tcp-unit - net/tcp-sig - net/tcp-unit - (only-in web-server/web-server do-not-return) - web-server/web-server-unit - web-server/web-server-sig - web-server/web-config-sig - web-server/web-config-unit - web-server/configuration/namespace) +@commandline{openssl rsa -in private-key.pem -out private-key.pem} +@commandline{chmod 400 private-key.pem} -@code:comment{Define the necessary parameters.} -(define port-no 8443) -(define SSL-path (find-system-path 'home-dir)) +Now, we generate a self-signed certificate: -@code:comment{Load the standard configuration file, but augment the port.} -(define configuration - (configuration-table->web-config@ - (build-path (collection-path "web-server") - "default-web-root" - "configuration-table.ss") - #:port port-no)) +@commandline{openssl req -new -x509 -nodes -sha1 -days 365 -key private-key.pem > server-cert.pem} -@code:comment{The configuration is a unit and this lets us treat it as one.} -(define-unit-binding config@ configuration - (import) (export web-config^)) +(Each certificate authority has different instructions for generating certificate signing requests.) -@code:comment{This loads the SSL TCP interface with the appropriate keys.} -(define-unit-binding ssl-tcp@ - (make-ssl-tcp@ (build-path SSL-path "server-cert.pem") - (build-path SSL-path "private-key.pem") - #f #f #f #f #f) - (import) (export tcp^)) +We can now start the server with: -@code:comment{Combine the configuration with the TCP interface to get a server!} -(define-compound-unit/infer ssl-server@ - (import) - (link ssl-tcp@ config@ web-server@) - (export web-server^)) +@commandline{plt-web-server --ssl} -@code:comment{Invoke the server to get at what it provides.} -(define-values/invoke-unit/infer ssl-server@) - -@code:comment{Run the server.} -(serve) -(do-not-return) -] - -Running this script, rather than @exec{plt-web-server}, runs the server using SSL on port @scheme[port-no]. -The certificate and private key are located in the @scheme[SSL-path] directory. \ No newline at end of file +The Web Server will start on port 443 (which can be overridden with the @exec{-p} option) using the +@filepath{private-key.pem} and @filepath{server-cert.pem} we've created. diff --git a/collects/web-server/scribblings/running.scrbl b/collects/web-server/scribblings/running.scrbl index 7c567b7ca4..5dc58db836 100644 --- a/collects/web-server/scribblings/running.scrbl +++ b/collects/web-server/scribblings/running.scrbl @@ -55,14 +55,16 @@ The following API is provided to customize the server instance: One command-line utility is provided with the @|web-server|: -@commandline{plt-web-server [-f -p -a ]} +@commandline{plt-web-server [-f -p -a --ssl]} The optional file-name argument specifies the path to a @scheme[configuration-table] S-expression (see @secref["configuration-table.ss"].) If this is not provided, the default configuration shipped with the server is used. The optional port and ip-address arguments override the corresponding portions of -the @scheme[configuration-table]. +the @scheme[configuration-table]. If the SSL option is provided, then +the server uses HTTPS with @filepath{server-cert.pem} and @filepath{private-key.pem} +in the current directory, with 443 as the default port. The @scheme[configuration-table] is given to @scheme[configuration-table->web-config@] and used to construct a @@ -139,7 +141,8 @@ from a given path: a function that shuts down all of the server instances. } -@defproc[(serve/web-config@ [config@ web-config^]) +@defproc[(serve/web-config@ [config@ web-config^] + [#:tcp@ tcp@ tcp-unit^ raw:tcp@]) (-> void)]{ Starts the @web-server with the settings defined by the given @scheme[web-config^] unit. @@ -148,8 +151,7 @@ from a given path: @schemeblock[ (serve/web-config@ (configuration-table->web-config@ - default-configuration-table-path)) - (do-not-return)] + default-configuration-table-path))] } @defproc[(do-not-return) void]{ diff --git a/collects/web-server/scribblings/tutorial/continue.scrbl b/collects/web-server/scribblings/tutorial/continue.scrbl index a8e89c45a0..789b0609ee 100644 --- a/collects/web-server/scribblings/tutorial/continue.scrbl +++ b/collects/web-server/scribblings/tutorial/continue.scrbl @@ -1183,88 +1183,25 @@ This final task that we'll cover is using the server in HTTPS mode. This requires an SSL certificate and private key. This is very platform specific, but we will provide the details for using OpenSSL on UNIX: -@commandline{openssl genrsa -des3 -out host.key 1024} +@commandline{openssl genrsa -des3 -out private-key.pem 1024} This will generate a new private key, but it will have a passphrase on it. You can remove this via: -@commandline{openssl rsa -in host.key -out host.key} -@commandline{chmod 400 host.key} +@commandline{openssl rsa -in private-key.pem -out private-key.pem} +@commandline{chmod 400 private-key.pem} Now, we generate a self-signed certificate: -@commandline{openssl req -new -x509 -nodes -sha1 -days 365 -key host.key > host.cert} +@commandline{openssl req -new -x509 -nodes -sha1 -days 365 -key private-key.pem > server-cert.pem} (Each certificate authority has different instructions for generating certificate signing requests.) -If we move these files into our home directory: -@commandline{mv host.key host.cert ~/} +We can now start the server with: -We can now start the server with the following incantation: +@commandline{plt-web-server --ssl} -@(require (for-label scheme/unit) - (for-label net/ssl-tcp-unit) - (for-label net/tcp-sig) - (for-label net/tcp-unit) - (for-label web-server/web-server) - (for-label web-server/web-server-unit) - (for-label web-server/web-server-sig) - (for-label web-server/web-config-sig) - (for-label web-server/web-config-unit) - (for-label web-server/configuration/namespace)) - -@schememod[ -scheme - -@code:comment{Load the appropriate libraries to reimplement server} -(require scheme/unit - net/ssl-tcp-unit - net/tcp-sig - net/tcp-unit - (only-in web-server/web-server do-not-return) - web-server/web-server-unit - web-server/web-server-sig - web-server/web-config-sig - web-server/web-config-unit - web-server/configuration/namespace) - -@code:comment{Define the necessary parameters.} -(define port-no 8443) -(define SSL-path (find-system-path 'home-dir)) - -@code:comment{Load the standard configuration file, but augment the port.} -(define configuration - (configuration-table->web-config@ - (build-path (collection-path "web-server") - "default-web-root" - "configuration-table.ss") - #:port port-no)) - -@code:comment{The configuration is a unit and this lets us treat it as one.} -(define-unit-binding config@ configuration - (import) (export web-config^)) - -@code:comment{This loads the SSL TCP interface with the appropriate keys.} -(define-unit-binding ssl-tcp@ - (make-ssl-tcp@ (build-path SSL-path "host.cert") - (build-path SSL-path "host.key") - #f #f #f #f #f) - (import) (export tcp^)) - -@code:comment{Combine the configuration with the TCP interface to get a server!} -(define-compound-unit/infer ssl-server@ - (import) - (link ssl-tcp@ config@ web-server@) - (export web-server^)) - -@code:comment{Invoke the server to get at what it provides.} -(define-values/invoke-unit/infer ssl-server@) - -@code:comment{Run the server.} -(serve) -(do-not-return) -] - -This is, admittedly, not the simplest imaginable way of setting up a server, but it gets the job done. +The Web Server will start on port 443 (which can be overridden with the @exec{-p} option) using the +@filepath{private-key.pem} and @filepath{server-cert.pem} we've created. @section{Moving Forward} diff --git a/collects/web-server/web-server.ss b/collects/web-server/web-server.ss index 4c16478bf1..666992e137 100644 --- a/collects/web-server/web-server.ss +++ b/collects/web-server/web-server.ss @@ -36,7 +36,7 @@ #:initial-connection-timeout number?) (-> void))] [do-not-return (-> void)] - [serve/web-config@ (unit? . -> . (-> void?))]) + [serve/web-config@ ((unit?) (#:tcp@ unit?) . ->* . (-> void?))]) (define (do-not-return) (semaphore-wait (make-semaphore 0))) @@ -101,7 +101,9 @@ (for-each apply shutdowns))) ; serve/config@ : configuration -> (-> void) -(define (serve/web-config@ config@) +(define (serve/web-config@ config@ #:tcp@ [tcp@ raw:tcp@]) + (define-unit-binding a-tcp@ + tcp@ (import) (export tcp^)) (define-unit m@ (import web-server^) (export) (init-depend web-server^) (serve)) @@ -109,5 +111,5 @@ (invoke-unit (compound-unit/infer (import) - (link raw:tcp@ c@ web-server@ m@) + (link a-tcp@ c@ web-server@ m@) (export))))