#!/bin/sh
#| -*- scheme -*-
exec racket "$0" "$@"
|#

#lang at-exp racket/base

(require racket/list racket/file racket/match racket/system)

(define (err fmt . args)
  (raise-user-error (format "Error: ~a" (apply format fmt args))))

(define testdir "/tmp/racket-installer-test")
(define installer
  (match (current-command-line-arguments)
    [(vector installer) installer]
    [(vector _ ...) (err "usage: test-installer <instalelr-file-name>")]))

(define (exe name [just-path? #f])
  (define path (or (find-executable-path name)
                   (err "no `~a' executable found" name)))
  (λ args (unless (apply system* path args)
            (err "`~a' signaled an error" name))))

(define expect-exe (exe "expect"))
(define sync-exe   (exe "sync"))

(unless (file-exists? installer)  (err "missing installer at: ~a" installer))
(when (directory-exists? testdir) (err "test directory exists: ~a" testdir))
(make-directory testdir)
(current-directory testdir)
;; plain interaction, identifiable prompts, safe-for-play home
(void (putenv "TERM" "dumb") (putenv "PS1" "sh> ") (putenv "HOME" testdir))

(define (transcript)
  ;; the test transcript text:
  ;; - text is matched against the process output (anchored)
  ;; - `i' is for user input to send
  ;; - `r' is for a regexp
  ;; - `s' is a nested list to be spliced in
  ;; - `N' is short for @r{(?:-?[0-9.]+)?}
  ;; - `...' makes the next match unanchored (so it's similar to a non-greedy
  ;;   ".*" regexp)
  (define (i . xs) `(i . ,xs))
  (define (r . xs) `(r . ,xs))
  (define (s . xs) `(s . ,xs))
  (define break 'break)
  (define N @r{(?:-?[0-9.]+)?})
  (define ... '...)
  (define not-recommended
    (let ([s (string-append
              "*** This is a nightly build: such a unix-style distribution"
              " is *not*\n"
              "*** recommended because it cannot be used to install multiple"
              " versions.\n")])
      (format "(?:~a)?" (regexp-quote s))))
  @list{
    @; the first few puzzling interactions are testing that we generate the
    @; right expect code -- which requires regexp and $-quoting.
    sh> @i{echo "blah"}
    blah
    sh> @i{echo 'blah'}
    blah
    sh> @i{x=123}
    sh> @i{echo "][@"}{"blah*$x*"}
    ][@"}{"blah*123*
    sh> @i{echo '[]{}blah*$x*'}
    []{}blah*$x*
    sh> @i{pwd}
    @testdir
    @; utilities
    sh> @i{LS() { ls --width=72 -mF "$@"@""@";" }}
    @; proper testing begins here
    sh> @i{sh @installer}
    This program will extract and install Racket v@|N|.
    @||
    Note: the required diskspace for this installation is @|N|M.
    @||
    Do you want a Unix-style distribution?
      In this distribution mode files go into different directories according
      to Unix conventions.  A "racket-uninstall" script will be generated
      to be used when you want to remove the installation.  If you say 'no',
      the whole Racket directory is kept in a single installation directory
      (movable and erasable), possibly with external links into it -- this is
      often more convenient, especially if you want to install multiple
      versions or keep it in your home directory.
    @r{@not-recommended}@;
    Enter yes/no (default: no) > @i{bleh}
    Enter yes/no (default: no) > @i{foo}
    Enter yes/no (default: no) > @i{}
    @||
    Where do you want to install the "racket@N" directory tree?
      1 - /usr/racket@N [default]
      2 - /usr/local/racket@N
      3 - ~/racket@N (@|testdir|/racket@N)
      4 - ./racket@N (here)
      Or enter a different "racket" directory to install in.
    > @i{4}
    @||
    Checking the integrity of the binary archive... ok.
    Unpacking into "@|testdir|/racket@N" (Ctrl+C to abort)...
    Done.
    @||
    If you want to install new system links within the "bin" and
      "man" subdirectories of a common directory prefix (for example,
      "/usr/local") then enter the prefix of an existing directory
      that you want to use.  This might overwrite existing symlinks,
      but not files.
    (default: skip links) > @i{}
    @||
    Installation complete.
    sh> @i{LS}
    racket@|N|/
    sh> @i{LS racket*}
    README, bin/, collects/, doc/, include/, lib/, man/
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{No}
    @...
    > @i{.}
    @||
    Checking the integrity of the binary archive... ok.
    "@|testdir|/racket@N" exists, delete? @i{n}
    Aborting installation.
    sh> @i{LS racket*}
    README, bin/, collects/, doc/, include/, lib/, man/
    sh> @i{chmod 000 racket*}
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{No}
    @...
    > @i{./}
    @||
    Checking the integrity of the binary archive... ok.
    "@|testdir|/racket@N" exists, delete? @i{y}
    Deleting old "@|testdir|/racket@N"... @;
      /bin/rm: cannot remove `@|testdir|/racket@N': @;
        Permission denied
    Error: could not delete "@|testdir|/racket@N".
    sh> @i{chmod 755 racket*}
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{No}
    @...
    > @i{.}
    @||
    Checking the integrity of the binary archive... ok.
    "@|testdir|/racket@N" exists, delete? @i{y}
    Deleting old "@|testdir|/racket@N"... done.
    @...
    (default: skip links) > @i{.}
    "@|testdir|/bin" does not exist, skipping.
    "@|testdir|/share/man/man1" does not exist, skipping.
    @||
    Installation complete.
    sh> @i{mkdir bin}
    sh> @i{touch R bin/gracket}
    sh> @i{export TGT=R}
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{}
    @...
    > @i{$TGT}
    @||
    Checking the integrity of the binary archive... ok.
    "R" exists (as a file), delete? @i{y}
    Deleting old "R"... done.
    Unpacking into "@|testdir|/R" (Ctrl+C to abort)...
    Done.
    @...
    (default: skip links) > @i{.}
    Installing links in "@|testdir|/bin"...
      drracket, gracket skipped (non-link exists), gracket-text, mred, @;
      mred-text, mzc, mzpp, mzscheme, mztext, pdf-slatex, planet, plt-games, @;
      plt-help, plt-r5rs, plt-r6rs, plt-web-server, racket, raco, scribble, @;
      setup-plt, slatex, slideshow, swindle
      done.
    "@|testdir|/share/man/man1" does not exist, skipping.
    @||
    Installation complete.
    sh> @i{LS .}
    R/, bin/, racket@|N|/
    sh> @i{LS R}
    README, bin/, collects/, doc/, include/, lib/, man/
    sh> @i{LS bin}
    @s|{drracket@, gracket, gracket-text@, mred@, mred-text@, mzc@, mzpp@,
        mzscheme@, mztext@, pdf-slatex@, planet@, plt-games@, plt-help@,
        plt-r5rs@, plt-r6rs@, plt-web-server@, racket@, raco@, scribble@,
        setup-plt@, slatex@, slideshow@, swindle@}|
    sh> @i{LS -l bin/ra*}
    lrwxrwxrwx. @... bin/racket -> @|testdir|/R/bin/racket*
    lrwxrwxrwx. @... bin/raco -> @|testdir|/R/bin/raco*
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{}
    @...
    > @i{$TGT`echo 1`}
    @||
    Checking the integrity of the binary archive... ok.
    Unpacking into "@|testdir|/R1" (Ctrl+C to abort)...
    @break
    Error: Aborting...
      (Removing installation files in @|testdir|/R1)
    sh> @i{LS}
    R/, bin/, racket@|N|/
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{}
    @...
    > @i{mmm}
    @...
    Unpacking into "@|testdir|/mmm" (Ctrl+C to abort)...
    Done.
    @...
    (default: skip links) > @break
    Error: Aborting...
    sh> @i{LS}
    R/, bin/, mmm/, racket@|N|/
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{}
    @...
    > @i{`pwd`}
    @...
    "@testdir" is where you ran the installer from, delete? @i{y}
    Deleting old "@testdir"... done.
    *** Note: your original directory was deleted, so you will need
    *** to 'cd' back into it when the installer is done, otherwise
    *** it will look like you have an empty directory.
    Unpacking into "@testdir" (Ctrl+C to abort)...
    Done.
    @...
    (default: skip links) > @i{/usr/local}
    "/usr/local" is not writable, skipping links.
    @||
    Installation complete.
    sh> @i{LS}
    sh> @i{cd /}
    sh> @i{cd @testdir}
    sh> @i{LS}
    README, bin/, collects/, doc/, include/, lib/, man/
    sh> @i{rm -rf [a-zR]*}
    sh> @i{LS}
    sh> @i{sh @installer}
    @...
    Do you want a Unix-style distribution?
    @...
    Enter yes/no (default: no) > @i{bleh}
    Enter yes/no (default: no) > @i{yes}
    @||
    Where do you want to base your installation of Racket v@|N|?
      (If you've done such an installation in the past, either
       enter the same directory, or run 'racket-uninstall' manually.)
      1 - /usr/... [default]
      2 - /usr/local/...
      3 - ~/... (@|testdir|/...)
      4 - ./... (here)
      Or enter a different directory prefix to install in.
    > @i{}
    Error: The entered base directory is not writable: /usr
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{y}
    @...
    > @i{2}
    Error: The entered base directory is not writable: /usr/local
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{y}
    @...
    > @i{3}
    @||
    Target Directories:
      [e] Executables   @|testdir|/bin (will be created)
      [r] Racket Code   @|testdir|/lib/racket@|N|/collects (will be created)
      [d] Core Docs     @|testdir|/share/racket@|N|/doc (will be created)
      [l] C Libraries   @|testdir|/lib (will be created)
      [h] C headers     @|testdir|/include/racket@|N| (will be created)
      [o] Extra C Objs  @|testdir|/lib/racket@|N| (will be created)
      [m] Man Pages     @|testdir|/share/man (will be created)
    Enter a letter to change an entry, or enter to continue.
    > @i{z}
    > @i{Q}
    > @i{}
    @||
    Checking the integrity of the binary archive... ok.
    Unpacking into "@|testdir|/racket@|N|-tmp-install" (Ctrl+C to abort)...
    Done.
    Moving bin -> @|testdir|/bin
    Moving collects -> @|testdir|/lib/racket@|N|/collects
    Moving doc -> @|testdir|/share/racket@|N|/doc
    Moving include -> @|testdir|/include/racket@|N|
    Moving lib -> @|testdir|/lib/racket@|N|
    Moving man -> @|testdir|/share/man
    Moving README -> @|testdir|/share/racket@|N|/doc/README
    Writing uninstaller at: @|testdir|/bin/racket-uninstall...
    Rewriting configuration file at: @|testdir|/lib/racket@|N|/@;
      collects/config/config.rkt...
    Recompiling to @|testdir|/lib/racket@|N|/@;
      collects/config/compiled/config_rkt.zo...
    @||
    Installation complete.
    sh> @i{LS}
    bin/, include/, lib/, share/
    sh> @i{LS bin}
    drracket*, gracket*, gracket-text*, mred*, mred-text*, mzc*, mzpp*,
    mzscheme*, mztext*, pdf-slatex*, planet*, plt-games*, plt-help*,
    plt-r5rs*, plt-r6rs*, plt-web-server*, racket*, racket-uninstall*,
    raco*, scribble*, setup-plt*, slatex*, slideshow*, swindle*
    sh> @i{LS include && LS lib && LS share}
    racket@|N|/
    racket@|N|/
    man/, racket@|N|/
    sh> @i{LS include/r*}
    escheme.h, ext.exp, mzconfig.h, mzscheme3m.exp, scheme.h, schemef.h,
    schemegc2.h, schemex.h, schemexm.h, schexn.h, schgc2obj.h, schthread.h,
    schvers.h, sconfig.h, stypes.h, uconfig.h
    sh> @i{LS lib/r*}
    buildinfo, collects/, mzdyn3m.o, starter*
    sh> @i{LS share/r* && LS share/r*/doc}
    doc/
    README, @|...|xrepl/
    sh> @i{LS share/man && LS share/man/man1}
    man1/
    drracket.1, gracket.1, mred.1, mzc.1, mzscheme.1, plt-help.1, racket.1,
    raco.1, setup-plt.1
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{y}
    @...
    > @i{meh}
    Base directory does not exist: meh
      should I create it? (default: yes) @i{n}
    Aborting installation.
    sh> @i{touch m}
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{y}
    @...
    > @i{4}
    @||
    Target Directories:
      [e] Executables   @|testdir|/bin (exists)
      [r] Racket Code   @|testdir|/lib/racket@|N|/collects (exists)
      [d] Core Docs     @|testdir|/share/racket@|N|/doc (exists)
      [l] C Libraries   @|testdir|/lib (exists)
      [h] C headers     @|testdir|/include/racket@|N| (exists)
      [o] Extra C Objs  @|testdir|/lib/racket@|N| (exists)
      [m] Man Pages     @|testdir|/share/man (exists)
    Enter a letter to change an entry, or enter to continue.
    > @i{m}
    New directory (absolute or relative to @testdir): @i{m}
    @||
    Target Directories:
      [e] Executables   @|testdir|/bin (exists)
      [r] Racket Code   @|testdir|/lib/racket@|N|/collects (exists)
      [d] Core Docs     @|testdir|/share/racket@|N|/doc (exists)
      [l] C Libraries   @|testdir|/lib (exists)
      [h] C headers     @|testdir|/include/racket@|N| (exists)
      [o] Extra C Objs  @|testdir|/lib/racket@|N| (exists)
      [m] Man Pages     @|testdir|/m (error: not a directory!)
    Enter a letter to change an entry, or enter to continue.
    > @i{}
    *** Please fix erroneous paths to proceed
    @...
    Enter a letter to change an entry, or enter to continue.
    > @i{m}
    New directory (absolute or relative to @testdir): @i{man}
    @||
    Target Directories:
      [e] Executables   @|testdir|/bin (exists)
      [r] Racket Code   @|testdir|/lib/racket@|N|/collects (exists)
      [d] Core Docs     @|testdir|/share/racket@|N|/doc (exists)
      [l] C Libraries   @|testdir|/lib (exists)
      [h] C headers     @|testdir|/include/racket@|N| (exists)
      [o] Extra C Objs  @|testdir|/lib/racket@|N| (exists)
      [m] Man Pages     @|testdir|/man (will be created)
    Enter a letter to change an entry, or enter to continue.
    > @i{}
    @||
    A previous Racket uninstaller is found at
      "@|testdir|/bin/racket-uninstall",
      should I run it? (default: yes) @i{}
      running uninstaller... done.
    @||
    Checking the integrity of the binary archive... ok.
    @...
    Installation complete.
    sh> @i{LS}
    bin/, include/, lib/, m, man/, share/
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{y}
    @...
    > @i{4}
    @...
    > @i{}
    @||
    A previous Racket uninstaller is found at
      "@|testdir|/bin/racket-uninstall",
      should I run it? (default: yes) @i{n}
    Aborting installation.
    sh> @i{rm -rf share}
    sh> @i{sh @installer}
    @...
    Enter yes/no (default: no) > @i{y}
    @...
    > @i{4}
    @...
      [m] Man Pages     @|testdir|/man (exists)
    Enter a letter to change an entry, or enter to continue.
    > @break
    Error: Aborting...
    sh> @i{LS}
    bin/, include/, lib/, m, man/
    sh> @i{exit}
    @||})

(define (make-expect-script)
  (printf "spawn sh\nproc abort {} { puts \"timeout!\\n\"; exit 1 }\n")
  (printf "set timeout 60\n")
  (define (tclq str)
    ;; tcl uses $ and [] for variable & function call interpolation, and "}{"
    ;; can confuse it; quote all of these
    (regexp-replace* "[][{}$]" (format "~s" str) "\\\\&"))
  (define (expect strs anchored?)
    (unless (null? strs)
      (define str (if (string? strs) strs (apply string-append strs)))
      (let ([str (regexp-replace* "\r?\n" str "\r\n")])
        (printf "expect {\n  timeout abort\n  -re ~a\n}\n"
                (tclq (if anchored? (string-append "^" str) str))))))
  (define (send strs)
    (define str (if (string? strs) strs (apply string-append strs)))
    (printf "send -- ~a\n" (tclq (string-append str "\n"))))
  (let loop ([strs '()] [xs (transcript)] [anchored? #t])
    (define (do-expect) (expect (reverse strs) anchored?))
    (if (null? xs)
      (do-expect)
      (match (car xs)
        ['... (do-expect) (loop '() (cdr xs) #f)]
        [(? string? x) (loop (cons (regexp-quote x) strs) (cdr xs) anchored?)]
        [`(s . ,sxs)   (loop strs (append sxs (cdr xs)) anchored?)]
        [`(r . ,rxs)   (loop (append (reverse rxs) strs) (cdr xs) anchored?)]
        [`(i . ,inps)  (do-expect) (send inps)
                       (loop (map regexp-quote (reverse inps)) (cdr xs) #t)]
        ['break (do-expect) (printf "send \"\\03\"\n")
                (loop '("\\^C") (cdr xs) #t)]
        [x (err "bad item in transcript: ~s" (car xs))])))
  (printf "expect eof\n"))

(with-output-to-file "/tmp/racket-installer-expect-script" make-expect-script)
(sync-exe) ; we'll shuffle a lot of bytes, be prepared
(expect-exe "/tmp/racket-installer-expect-script")

(delete-directory/files testdir)
(delete-file "/tmp/racket-installer-expect-script")

(printf "\n--> All tests passed.\n")
