Better SSL support

svn: r12396

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

collects/web-server/private/launch.ss

@@ -1,6 +1,10 @@
-#lang scheme/base
+#lang scheme
-(require mzlib/cmdline
+(require scheme/cmdline
-         mzlib/pregexp)
+         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)
+       ,(lambda (flag the-port)
-          (cons 'port (string->number 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)

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)
+@commandline{openssl genrsa -des3 -out private-key.pem 1024}
-          (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[
+This will generate a new private key, but it will have a passphrase on it. You can remove this via:
-scheme
 
-@code:comment{Load the appropriate libraries to reimplement server}
+@commandline{openssl rsa -in private-key.pem -out private-key.pem}
-(require scheme/unit
+@commandline{chmod 400 private-key.pem}
-         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.}
+Now, we generate a self-signed certificate:
-(define port-no 8443)
-(define SSL-path (find-system-path 'home-dir))
 
-@code:comment{Load the standard configuration file, but augment the port.}
+@commandline{openssl req -new -x509 -nodes -sha1 -days 365 -key private-key.pem > server-cert.pem}
-(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.}
+(Each certificate authority has different instructions for generating certificate signing requests.)
-(define-unit-binding config@ configuration
-  (import) (export web-config^))
 
-@code:comment{This loads the SSL TCP interface with the appropriate keys.}
+We can now start the server with:
-(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^))
 
-@code:comment{Combine the configuration with the TCP interface to get a server!}
+@commandline{plt-web-server --ssl}
-(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.}
+The Web Server will start on port 443 (which can be overridden with the @exec{-p} option) using the
-(define-values/invoke-unit/infer ssl-server@)
+@filepath{private-key.pem} and @filepath{server-cert.pem} we've created.
-
-@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.

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 <file-name> -p <port> -a <ip-address>]}
+@commandline{plt-web-server [-f <file-name> -p <port> -a <ip-address> --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))
+    default-configuration-table-path))]
-  (do-not-return)]
 }
 
 @defproc[(do-not-return) void]{

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{openssl rsa -in private-key.pem -out private-key.pem}
-@commandline{chmod 400 host.key}
+@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:
+We can now start the server with:
-@commandline{mv host.key host.cert ~/}
 
-We can now start the server with the following incantation:
+@commandline{plt-web-server --ssl}
 
-@(require (for-label scheme/unit)
+The Web Server will start on port 443 (which can be overridden with the @exec{-p} option) using the
-          (for-label net/ssl-tcp-unit)
+@filepath{private-key.pem} and @filepath{server-cert.pem} we've created.
-          (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. 
 
 @section{Moving Forward}
 

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