make installer: make Windows work with bash-serving sshd

Makes a Windows build client work with Cygwin's opensshd.

pkgs/distro-build/config.rkt

@@ -131,7 +131,7 @@
     [(#:port) (and (exact-integer? val) (<= 1 val 65535))]
     [(#:dir) (path-string? val)]
     [(#:vbox) (string? val)]
-    [(#:platform) (memq val '(unix windows))]
+    [(#:platform) (memq val '(unix macosx windows windows/bash))]
     [(#:configure) (and (list? val) (andmap string? val))]
     [(#:bits) (or (equal? val 32) (equal? val 64))]
     [(#:vc) (or (equal? val "x86") (equal? val "x64"))]

pkgs/distro-build/doc.txt

@@ -85,7 +85,9 @@ Each Unix or Mac OS X client needs the following available:
 
 Each Windows client needs the following:
 
-  * SSH server with public-key authentication
+  * SSH server with public-key authentication, providing either a
+    Windows command line (like freeSSHd) or bash with access to
+    cmd.exe (like Cygwin's opensshd)
   * git (unless the working directory is ready)
   * Microsoft Visual Studio 9.0 (2008), installed in the
     default folder:
@@ -195,8 +197,9 @@ Site-configuration keywords (where <string*> means no spaces, etc.):
     in the Virtual Box GUI); if provided, the virtual machine is
     started and stopped on the server as needed
 
-  #:platform <symbol> --- 'windows, 'macosx, or 'unix; defaults to
+  #:platform <symbol> --- 'unix, 'macosx, 'windows, or 'windows/bash
-    `(system-type)'
+    (which means 'windows though an SSH server providing `bash', such
+    as Cygwin's); defaults to `(system-type)'
 
   #:configure '(<string> ...) --- arguments to `configure'
 

pkgs/distro-build/drive-clients.rkt

@@ -222,23 +222,39 @@
 
 (define (qq l kind)
   (case kind
-    [(unix) (~a "'"
+    [(unix macosx)
-                (apply ~a #:separator " " (map q l))
+     (~a "'"
-                "'")]
+         (apply ~a #:separator " " (map q l))
-    [(windows) (~a "\""
+         "'")]
-                   (apply 
+    [(windows windows/bash)
-                    ~a #:separator " " 
+     (~a "\""
-                    (for/list ([i (in-list l)])
+         (apply 
-                      (~a "\\\""
+          ~a #:separator " " 
-                          i
+          (for/list ([i (in-list l)])
-                          ;; A backslash is literal unless followed by a
+            (~a "\\\""
-                          ;; quote. If `i' ends in backslashes, they
+                i
-                          ;; must be doubled, because the \" added to
+                ;; A backslash is literal unless followed by a
-                          ;; the end will make them treated as escapes.
+                ;; quote. If `i' ends in backslashes, they
-                          (let ([m (regexp-match #rx"\\\\*$" i)])
+                ;; must be doubled, because the \" added to
-                            (car m))
+                ;; the end will make them treated as escapes.
-                          "\\\"")))
+                (let ([m (regexp-match #rx"\\\\*$" i)])
-                   "\"")]))
+                  (car m))
+                "\\\"")))
+         "\"")]))
+
+(define (shell-protect s kind)
+  (case kind
+    [(windows/bash)
+     ;; protect Windows arguments to go through bash, where
+     ;; backslashes must be escaped, but quotes are effectively
+     ;; preserved by the shell; also, "&&" must be quoted to
+     ;; parsing by bash
+     (regexp-replace* "&&"
+                      (regexp-replace* #rx"[\\]"
+                                       s
+                                       "\\\\\\0")
+                      "\"\\&\\&\"")]
+    [else s]))
 
 (define (client-args c server server-port kind readme)
   (define desc (client-name c))
@@ -284,7 +300,7 @@
                               (q ""))
       " README=" (q (file-name-from-path readme))))
 
-(define (unix-build c host port user server server-port repo clean? pull? readme)
+(define (unix-build c platform 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)))
@@ -307,7 +323,7 @@
        " JOB_OPTIONS=\"-j " j "\""
        " CONFIGURE_ARGS_qq=" (qq (get-opt c '#:configure null) 'unix))))
 
-(define (windows-build c host port user server server-port repo clean? pull? readme)
+(define (windows-build c platform 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)
@@ -316,11 +332,11 @@
                      "x64")))
   (define j (or (get-opt c '#:j) 1))
   (define (cmd . args) 
-    (list "cmd" "/c" (apply ~a args)))
+    (list "cmd" "/c" (shell-protect (apply ~a args) platform)))
   (ssh-script
    host port user
    server-port
-   'windows
+   platform
    (and clean?
         (cmd "IF EXIST " (q dir) " rmdir /S /Q " (q dir)))
    (cmd "IF NOT EXIST " (q dir) " git clone " (q repo) " " (q dir))
@@ -332,7 +348,7 @@
         " " vc
         " && nmake win32-client" 
        " JOB_OPTIONS=\"-j " j "\""
-        (client-args c server server-port 'windows readme))))
+        (client-args c server server-port platform readme))))
 
 (define (client-build c)
   (define host (or (get-opt c '#:host)
@@ -375,12 +391,14 @@
        ;; ensure a newline at the end:
        (newline o))))
 
+  (define platform (or (get-opt c '#:platform) (system-type)))
+
   (begin0
 
-   ((case (or (get-opt c '#:platform) (system-type))
+   ((case platform
       [(unix macosx) unix-build]
       [else windows-build])
-    c host port user server server-port repo clean? pull? readme)
+    c platform host port user server server-port repo clean? pull? readme)
 
    (delete-file readme)))