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

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

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))
-  (do-not-return)]
+    default-configuration-table-path))]
 }
 
 @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{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}
 

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