make installer: option to set address & port where server listened

Client SSH connections now create remote port forwarding port back
to the server, so that making the server listen only on "localhost"
provides an easy improvement for security (except that remote port
forwarding seems not to work with freeSSHd on Windows).

INSTALL.txt

@@ -229,11 +229,11 @@ configuration for a client #t instead of #f.
 A configuration file can specify the packages to include, host address
 of the server, distribution name, installer directory, and
 documentation search URL, but defaults can be provided as `make'
-arguments via `PKGS', `SERVER', `DIST_NAME', `DIST_BASE', and
+arguments via `PKGS', `SERVER' plus `SERVER_PORT` plus `SERVER_HOSTS`,
-`DIST_DIR', `DOC_SEARCH', respectively. The site configuration's
+`DIST_NAME', `DIST_BASE', and `DIST_DIR', `DOC_SEARCH',
-top-level options for packages and documentation search URL are used
+respectively. The site configuration's top-level options for packages
-to configure the set of packages that are available to client
+and documentation search URL are used to configure the set of packages
-machines to include in installers.
+that are available to client machines to include in installers.
 
 For each installer written to "build/installers", the installer's name
 is

Makefile

@@ -12,7 +12,7 @@
 #  base = build in "racket" only (i.e., first step of `in-place')
 #
 #  server = build base, build packages listed in $(PKGS) or specified
-#           via $(CONFIG), start server at port 9440
+#           via $(CONFIG), start server at port $(SERVER_PORT)
 #
 #  client = build base, create an installer with $(PKGS) with the help
 #           of $(SERVER); result is recorded in "bundle/installer.txt"
@@ -118,6 +118,12 @@ DOC_SEARCH =
 # Server for built packages (i.e., the host where you'll run the
 # server):
 SERVER = localhost
+SERVER_PORT = 9440
+# Set `SERVER_HOSTS` to a comma-delimited set of server addresses
+# that determine the interfaces on which the server listens; for
+# example, set SERVER_HOSTS to "localhost" to listen only on the
+# loopback device:
+SERVER_HOSTS = 
 
 # Set to "--release" to create release-mode installers (as opposed to
 # snapshot installers):
@@ -193,6 +199,8 @@ DISTRO_BUILD_PKGS = distro-build
 # instead of from an installed package:
 DISTBLD = pkgs/distro-build
 
+SVR_PRT = $(SERVER):$(SERVER_PORT)
+
 # Helper macros:
 USER_CONFIG = -G build/user/config -A build/user
 RACKET = racket/bin/racket $(USER_CONFIG)
@@ -203,8 +211,8 @@ X_AUTO_OPTIONS = --skip-installed --deps search-auto --pkgs $(JOB_OPTIONS)
 USER_AUTO_OPTIONS = --scope user $(X_AUTO_OPTIONS)
 LOCAL_USER_AUTO = --catalog build/local/catalog $(USER_AUTO_OPTIONS)
 SOURCE_USER_AUTO_q = --catalog "$(SRC_CATALOG)" $(USER_AUTO_OPTIONS)
-REMOTE_USER_AUTO = --catalog http://$(SERVER):9440/ $(USER_AUTO_OPTIONS)
+REMOTE_USER_AUTO = --catalog http://$(SVR_PRT)/ $(USER_AUTO_OPTIONS)
-REMOTE_INST_AUTO = --catalog http://$(SERVER):9440/ --scope installation $(X_AUTO_OPTIONS)
+REMOTE_INST_AUTO = --catalog http://$(SVR_PRT)/ --scope installation $(X_AUTO_OPTIONS)
 CONFIG_MODE_q = "$(CONFIG)" "$(CONFIG_MODE)"
 BUNDLE_CONFIG = bundle/racket/etc/config.rktd
 
@@ -341,7 +349,7 @@ built-catalog:
 # as the copy of the server's "collects" tree:
 built-catalog-server:
 	if [ -d ".git" ]; then git update-server-info ; fi
-	$(RACKET) -l distro-build/serve-catalog $(SERVE_DURING_CMD_qq)
+	$(RACKET) -l distro-build/serve-catalog $(CONFIG_MODE_q) "$(SERVER_HOSTS)" $(SERVER_PORT) $(SERVE_DURING_CMD_qq)
 
 # Demonstrate how a catalog server for binary packages works,
 # which involves creating package archives in "binary" mode
@@ -349,7 +357,7 @@ built-catalog-server:
 binary-catalog:
 	$(RACKET) -l- distro-build/pack-built --mode binary
 binary-catalog-server:
-	$(RACKET) -l- distro-build/serve-catalog --mode binary
+	$(RACKET) -l- distro-build/serve-catalog --mode binary $(CONFIG_MODE_q) "$(SERVER_HOSTS)" $(SERVER_PORT)
 
 # ------------------------------------------------------------
 # On each supported platform (for an installer build):
@@ -362,7 +370,8 @@ binary-catalog-server:
 # keep the "build/user" directory on the grounds that the
 # client is the same as the server.
 
-COPY_ARGS = SERVER=$(SERVER) PKGS="$(PKGS)" BUILD_STAMP="$(BUILD_STAMP)" \
+COPY_ARGS = SERVER=$(SERVER) SERVER_PORT=$(SERVER_PORT) SERVER_HOSTS="$(SERVER_HOSTS)" \
+            PKGS="$(PKGS)" BUILD_STAMP="$(BUILD_STAMP)" \
 	    RELEASE_MODE=$(RELEASE_MODE) SOURCE_MODE=$(SOURCE_MODE) \
             PKG_SOURCE_MODE="$(PKG_SOURCE_MODE)" INSTALL_NAME="$(INSTALL_NAME)"\
             DIST_NAME="$(DIST_NAME)" DIST_BASE=$(DIST_BASE) \
@@ -401,14 +410,14 @@ bundle-from-server:
 	rm -rf bundle
 	mkdir -p bundle/racket
 	$(RACKET) -l setup/unixstyle-install bundle racket bundle/racket
-	$(RACKET) -l distro-build/unpack-collects http://$(SERVER):9440/
+	$(RACKET) -l distro-build/unpack-collects http://$(SVR_PRT)/
 	bundle/racket/bin/raco pkg install $(REMOTE_INST_AUTO) $(PKG_SOURCE_MODE) $(PKGS) $(REQUIRED_PKGS)
 	$(RACKET) -l setup/unixstyle-install post-adjust "$(SOURCE_MODE)" "$(PKG_SOURCE_MODE)" racket bundle/racket
 
 bundle-config:
 	$(RACKET) -l distro-build/set-config $(SET_BUNDLE_CONFIG_q)
 
-UPLOAD_q = --readme http://$(SERVER):9440/$(README) --upload http://$(SERVER):9440/ --desc "$(DIST_DESC)"
+UPLOAD_q = --readme http://$(SVR_PRT)/$(README) --upload http://$(SVR_PRT)/ --desc "$(DIST_DESC)"
 DIST_ARGS_q = $(UPLOAD_q) $(RELEASE_MODE) $(SOURCE_MODE) "$(DIST_NAME)" $(DIST_BASE) $(DIST_DIR) "$(DIST_SUFFIX)"
 
 # Create an installer from the build (with installed packages) that's
@@ -428,7 +437,7 @@ win32-bundle:
 
 win32-bundle-from-server:
 	$(MAKE) win32-bundle $(COPY_ARGS)
-	$(WIN32_RACKET) -l distro-build/unpack-collects http://$(SERVER):9440/
+	$(WIN32_RACKET) -l distro-build/unpack-collects http://$(SVR_PRT)/
 	bundle\racket\raco pkg install $(REMOTE_INST_AUTO) $(PKG_SOURCE_MODE) $(REQUIRED_PKGS)
 	bundle\racket\raco pkg install $(REMOTE_INST_AUTO) $(PKG_SOURCE_MODE) $(PKGS)
 
@@ -439,7 +448,8 @@ win32-installer-from-bundle:
 # Drive installer build across server and clients:
 
 DRIVE_ARGS_q = $(RELEASE_MODE) $(SOURCE_MODE) $(CLEAN_MODE) "$(CONFIG)" "$(CONFIG_MODE)" \
-               $(SERVER) "$(PKGS)" "$(DOC_SEARCH)" "$(DIST_NAME)" $(DIST_BASE) $(DIST_DIR)
+               $(SERVER) $(SERVER_PORT) "$(SERVER_HOSTS)" \
+               "$(PKGS)" "$(DOC_SEARCH)" "$(DIST_NAME)" $(DIST_BASE) $(DIST_DIR)
 DRIVE_CMD_q = $(RACKET) -l- distro-build/drive-clients $(DRIVE_ARGS_q)
 
 # Full server build and clients drive, based on `CONFIG':

pkgs/distro-build/config.rkt

@@ -124,6 +124,8 @@
     [(#:build-stamp) (string? val)]
     [(#:max-vm) (real? val)]
     [(#:server) (simple-string? val)]
+    [(#:server-port) (and (exact-integer? val) (<= 1 val 65535))]
+    [(#:server-hosts) (and (list? val) (andmap simple-string? val))]
     [(#:host) (simple-string? val)]
     [(#:user) (or (not val) (simple-string? val))]
     [(#:port) (and (exact-integer? val) (<= 1 val 65535))]

pkgs/distro-build/doc.txt

@@ -26,7 +26,7 @@ locally.
 
 Each client is normally built by running commands via `ssh', where
 the client's host, `#:host' (with and optional `#:port' and/or
-`#:user') indicate the ssh target. Each client machine must be set
+`#:user') indicate the SSH target. Each client machine must be set
 up with a public-key authentication, because a direct `ssh' is
 expected to work without a password prompt. An exception is when
 the host is "localhost" and user is #f, in which case a shell is
@@ -54,7 +54,7 @@ Normally, the client directory is a git clone:
     that the server and client are in sync), which means that the
     server's directory must be a git clone.
 
-Note that neither ssh nor git turn out to be needed when the host
+Note that neither SSH nor git turn out to be needed when the host
 is "localhost", the user is #f, and the directory is not specified
 (which corresponds to the defaults in all cases).
 
@@ -79,13 +79,13 @@ Machine Requirements
 
 Each Unix or Mac OS X client needs the following available:
 
-  * ssh server with public-key authentication (except "localhost")
+  * SSH server with public-key authentication (except "localhost")
   * git (unless the working directory is ready)
   * gcc, make, etc.
 
 Each Windows client needs the following:
 
-  * ssh server with public-key authentication
+  * SSH server with public-key authentication
   * git (unless the working directory is ready)
   * Microsoft Visual Studio 9.0 (2008), installed in the
     default folder:
@@ -111,9 +111,9 @@ Site-configuration keywords (where <string*> means no spaces, etc.):
 
   #:host <string*> --- defaults to "localhost"
 
-  #:port <integer> --- ssh port for the client; defaults to 22
+  #:port <integer> --- SSH port for the client; defaults to 22
 
-  #:user <string*/false> --- ssh user for the client; defaults to #f,
+  #:user <string*/false> --- SSH user for the client; defaults to #f,
     which means the current user
 
   #:dir <path-string> --- defaults to "build/plt" or "build\\plt", or
@@ -121,7 +121,20 @@ Site-configuration keywords (where <string*> means no spaces, etc.):
     is #f
 
   #:server <string*> --- the address of the server as accessed by the
-    client; defaults to the `SERVER' makefile variable
+    client; when ssh remote tunneling works, then "localhost" should
+    always work to reach the server; defaults to the `SERVER' makefile
+    variable, which in turn defaults to "localhost"
+
+  #:server-port <integer> --- the port of the server as accessed by
+    the client, and a port used on clients to tunnel back to the
+    server; defaults to the `SERVER_PORT' makefile variable, which in
+    turn defaults to 9440
+
+  #:server-hosts <list-of-string*> --- addresses that determine the
+    interfaces on which the server listens; an empty list means all of
+    the server's interface, while '("localhost") would listen only on
+    the loopback device; defaults to the `SERVER_HOSTS` makefile
+    variable split on comma, which in turn defaults to the empty list
 
   #:repo <string> --- the git repository for Racket; defaults to
     "http://<server>:9440/.git"

pkgs/distro-build/drive-clients.rkt

@@ -25,7 +25,8 @@
 (define snapshot-install-name "snapshot")
 
 (define-values (config-file config-mode
-                            default-server default-pkgs default-doc-search
+                            default-server default-server-port default-server-hosts
+                            default-pkgs default-doc-search
                             default-dist-name default-dist-base default-dist-dir)
   (command-line
    #:once-each
@@ -34,10 +35,10 @@
    [("--clean") "Erase client directories before building"
     (set! default-clean? #t)]
    #:args (config-file config-mode 
-                       server pkgs doc-search
+                       server server-port server-hosts pkgs doc-search
                        dist-name dist-base dist-dir)
    (values config-file config-mode
-           server pkgs doc-search
+           server server-port server-hosts pkgs doc-search
            dist-name dist-base dist-dir)))
 
 (define config (parameterize ([current-mode config-mode])
@@ -192,7 +193,7 @@
 (define scp (find-executable-path "scp"))
 (define ssh (find-executable-path "ssh"))
 
-(define (ssh-script host port user kind . cmds)
+(define (ssh-script host port user server-port kind . cmds)
   (for/and ([cmd (in-list cmds)])
     (when cmd (display-time))
     (or (not cmd)
@@ -201,6 +202,8 @@
             (apply system*/show cmd)
             (apply system*/show ssh 
                    "-p" (~a port)
+                   ;; create tunnel to connect back to server:
+                   "-R" (~a server-port ":localhost:" server-port)
                    (if user 
                        (~a user "@" host)
                        host)
@@ -237,7 +240,7 @@
                           "\\\"")))
                    "\"")]))
 
-(define (client-args c server kind readme)
+(define (client-args c server server-port kind readme)
   (define desc (client-name c))
   (define pkgs (let ([l (get-opt c '#:pkgs)])
                  (if l
@@ -263,6 +266,7 @@
                                                     ""
                                                     (current-stamp))))
   (~a " SERVER=" server
+      " SERVER_PORT=" server-port
       " PKGS=" (q pkgs)
       " DOC_SEARCH=" (q doc-search)
       " DIST_DESC=" (q desc)
@@ -280,13 +284,14 @@
                               (q ""))
       " README=" (q (file-name-from-path readme))))
 
-(define (unix-build c host port user server repo clean? pull? readme)
+(define (unix-build c host port user server server-port repo clean? pull? readme)
   (define dir (get-path-opt c '#:dir "build/plt" #:localhost (current-directory)))
   (define (sh . args)
     (list "/bin/sh" "-c" (apply ~a args)))
   (define j (or (get-opt c '#:j) 1))
   (ssh-script
    host port user
+   server-port
    'unix
    (and clean?
         (sh "rm -rf  " (q dir)))
@@ -298,11 +303,11 @@
             "git pull"))
    (sh "cd " (q dir) " ; "
        "make -j " j " client"
-       (client-args c server 'unix readme)
+       (client-args c server server-port 'unix readme)
        " JOB_OPTIONS=\"-j " j "\""
        " CONFIGURE_ARGS_qq=" (qq (get-opt c '#:configure null) 'unix))))
 
-(define (windows-build c host port user server repo clean? pull? readme)
+(define (windows-build c host port user server server-port repo clean? pull? readme)
   (define dir (get-path-opt c '#:dir "build\\plt" #:localhost (current-directory)))
   (define bits (or (get-opt c '#:bits) 64))
   (define vc (or (get-opt c '#:vc)
@@ -314,6 +319,7 @@
     (list "cmd" "/c" (apply ~a args)))
   (ssh-script
    host port user
+   server-port
    'windows
    (and clean?
         (cmd "IF EXIST " (q dir) " rmdir /S /Q " (q dir)))
@@ -326,7 +332,7 @@
         " " vc
         " && nmake win32-client" 
        " JOB_OPTIONS=\"-j " j "\""
-        (client-args c server 'windows readme))))
+        (client-args c server server-port 'windows readme))))
 
 (define (client-build c)
   (define host (or (get-opt c '#:host)
@@ -336,8 +342,10 @@
   (define user (get-opt c '#:user))
   (define server (or (get-opt c '#:server)
                      default-server))
+  (define server-port (or (get-opt c '#:server-port)
+                          default-server-port))
   (define repo (or (get-opt c '#:repo)
-                   (~a "http://" server ":9440/.git")))
+                   (~a "http://" server ":" server-port "/.git")))
   (define clean? (get-opt c '#:clean? default-clean? #:localhost #f))
   (define pull? (get-opt c '#:pull? #t #:localhost #f))
 
@@ -372,7 +380,7 @@
    ((case (or (get-opt c '#:platform) (system-type))
       [(unix macosx) unix-build]
       [else windows-build])
-    c host port user server repo clean? pull? readme)
+    c host port user server server-port repo clean? pull? readme)
 
    (delete-file readme)))
 

pkgs/distro-build/serve-catalog.rkt

@@ -8,19 +8,35 @@
          racket/cmdline
          racket/file
          racket/path
+         racket/string
+         racket/tcp
+         racket/port
          racket/system
+         (only-in "config.rkt" extract-options)
          "readme.rkt")
 
 (define from-dir "built")
 
-(define during-cmd-line
+(define-values (config-file config-mode 
+                            default-server-hosts default-server-port 
+                            during-cmd-line)
   (command-line
    #:once-each
    [("--mode") dir "Serve package archives from <dir> subdirectory"
     (set! from-dir dir)]
-   #:args during-cmd
+   #:args (config-file config-mode server-hosts server-port . during-cmd)
-   during-cmd))
+   (values config-file config-mode 
+           server-hosts (string->number server-port)
+           during-cmd)))
 
+(define server-hosts
+  (hash-ref (extract-options config-file config-mode)
+            '#:server-hosts
+            (string-split default-server-hosts ",")))
+(define server-port
+  (hash-ref (extract-options config-file config-mode)
+            '#:server-port
+            default-server-port))
 
 (define build-dir (path->complete-path "build"))
 (define built-dir (build-path build-dir from-dir))
@@ -111,11 +127,33 @@
    [("pkg" (string-arg)) write-info]
    [("upload" (string-arg)) #:method "put" receive-file]))
 
+;; Tunnel extra hosts to first one:
+(when (and (pair? server-hosts)
+           (pair? (cdr server-hosts)))
+  (for ([host (in-list (cdr server-hosts))])
+    (thread
+     (lambda ()
+       (define l (tcp-listen server-port 5 #t host))
+       (let loop ()
+         (define-values (i o) (tcp-accept l))
+         (define-values (i2 o2) (tcp-connect (car server-hosts) server-port))
+         (thread (lambda () 
+                   (copy-port i o2)
+                   (close-input-port i)
+                   (close-output-port o2)))
+         (thread (lambda () 
+                   (copy-port i2 o)
+                   (close-input-port i2)
+                   (close-output-port o)))
+         (loop))))))
+
 (define (go)
   (serve/servlet
    dispatch
    #:command-line? #t
-   #:listen-ip #f
+   #:listen-ip (if (null? server-hosts)
+                   #f
+                   (car server-hosts))
    #:extra-files-paths
    (append
     (list (build-path build-dir "origin"))
@@ -125,7 +163,7 @@
     ;; for ".git":
     (list (current-directory)))
    #:servlet-regexp #rx""
-   #:port 9440))
+   #:port server-port))
 
 (define readmes-dir (build-path build-dir "readmes"))
 (make-directory* readmes-dir)