commit 4caf53c03bf3abc345a6f8da8604c899533bcf13
parent f0b760ed6ccc74c8e6ad4add1b3f5e0859f18aad
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 7 Dec 2014 09:42:07 -0700
move "unix-installer.rkt" test to the new "distro-build-test" package
Diffstat:
3 files changed, 342 insertions(+), 0 deletions(-)
diff --git a/distro-build-test/LICENSE.txt b/distro-build-test/LICENSE.txt
@@ -0,0 +1,11 @@
+distro-build-test
+Copyright (c) 2010-2014 PLT Design Inc.
+
+This package is distributed under the GNU Lesser General Public
+License (LGPL). This means that you can link this package into proprietary
+applications, provided you follow the rules stated in the LGPL. You
+can also modify this package; if you distribute a modified version,
+you must distribute it under the terms of the LGPL, which in
+particular means that you must release the source code for the
+modified software. See http://www.gnu.org/copyleft/lesser.html
+for more information.
diff --git a/distro-build-test/info.rkt b/distro-build-test/info.rkt
@@ -0,0 +1,11 @@
+#lang info
+
+(define collection "distro-build")
+
+(define pkg-desc "Distribution-build tests")
+
+(define deps '("base"))
+(define build-deps '("remote-shell-lib"
+ "web-server-lib"))
+
+(define pkg-authors '(mflatt))
diff --git a/distro-build-test/tests/unix-installer.rkt b/distro-build-test/tests/unix-installer.rkt
@@ -0,0 +1,320 @@
+#lang racket
+(require remote-shell/ssh
+ remote-shell/vbox
+ net/url
+ racket/date
+ file/zip
+ pkg/lib
+ web-server/servlet-env)
+
+(module test racket/base)
+
+;; ----------------------------------------
+;; Configuration (adjust as needed)
+
+(define vbox-name "Ubuntu Server 14.04")
+(define vbox-host "192.168.56.107")
+(define vbox-user "racket")
+(define vbox-snapshot "init")
+
+(define snapshot-site "http://pre-release.racket-lang.org/")
+(define installers-site (~a snapshot-site "installers/"))
+(define catalog (~a snapshot-site "catalog/"))
+
+(define min-racket-installers
+ (list "racket-minimal-6.1.0.900-x86_64-linux-ubuntu-precise.sh"))
+
+(define racket-installers
+ (list "racket-6.1.0.900-x86_64-linux-ubuntu-precise.sh"))
+
+(define min-racket-natipkg-installers
+ (list "racket-minimal-6.1.0.900-x86_64-linux-natipkg-debian-squeeze.sh"))
+
+;; For serving packages to VM:
+(define server-port 50001)
+
+(define work-dir (find-system-path 'temp-dir))
+
+;; For disabling some tests:
+(define basic? #t)
+(define natipkg? #t)
+
+;; ----------------------------------------
+;; Get installers and "base.zip" from snapshot
+
+(define (get f #:sub [sub ""])
+ (unless (file-exists? (build-path work-dir f))
+ (printf "Getting ~a\n" f)
+ (call/input-url (string->url (string-append installers-site sub f))
+ get-pure-port
+ (lambda (i)
+ (call-with-output-file*
+ (build-path work-dir f)
+ #:exists 'truncate
+ (lambda (o)
+ (copy-port i o)))))))
+
+(for-each get min-racket-installers)
+(for-each get racket-installers)
+(for-each get min-racket-natipkg-installers)
+(get #:sub "base/" "base.zip")
+
+;; ----------------------------------------
+;; Construct a simple package
+
+(define sample-pkg-dir (build-path work-dir "sample"))
+(delete-directory/files sample-pkg-dir #:must-exist? #f)
+(make-directory* sample-pkg-dir)
+(call-with-output-file*
+ (build-path sample-pkg-dir "info.rkt")
+ (lambda (o)
+ (displayln "#lang info" o)
+ (write '(define collection "sample") o)
+ (write '(define deps '("base")) o)))
+(call-with-output-file*
+ (build-path sample-pkg-dir "main.rkt")
+ (lambda (o)
+ (displayln "#lang racket/base" o)
+ (write "sample" o)))
+
+(define sample-zip-path (build-path work-dir "sample.zip"))
+(parameterize ([current-directory work-dir])
+ (when (file-exists? "sample.zip") (delete-file "sample.zip"))
+ (zip "sample.zip" "sample" #:utc-timestamps? #t))
+
+;; ----------------------------------------
+;; Construct a simple program
+
+(define progy-path (build-path work-dir "progy.rkt"))
+(call-with-output-file*
+ progy-path
+ #:exists 'truncate
+ (lambda (o)
+ (displayln "#lang racket/base" o)
+ (write '(require sample) o)))
+
+
+;; ----------------------------------------
+;; Packages to local
+
+(define pkg-archive-dir (build-path work-dir "archive"))
+
+(when natipkg?
+ (pkg-catalog-archive pkg-archive-dir
+ (list catalog)
+ #:state-catalog (build-path work-dir "archive" "state.sqlite")
+ #:relative-sources? #t))
+
+;; ----------------------------------------
+
+(define (set-date rt)
+ (ssh rt "sudo date --set=\""
+ (parameterize ([date-display-format 'rfc2822])
+ (date->string (seconds->date (current-seconds)) #t))
+ "\""))
+
+;; ----------------------------------------
+
+(when basic?
+ (for* ([min? '(#t #f)]
+ [f (in-list (if min?
+ min-racket-installers
+ racket-installers))]
+ ;; Unix-style install?
+ [unix-style? '(#f #t)]
+ ;; Change path of "shared" to "mine-all-mine"?
+ [mv-shared? (if unix-style? '(#t #f) '(#f))]
+ ;; Install into "/usr/local"?
+ [usr-local? '(#t #f)]
+ ;; Link in-place install executables in "/usr/local/bin"?
+ [links? (if unix-style? '(#f) '(#t #f))])
+ (printf (~a "=================================================================\n"
+ "CONFIGURATION: "
+ (if min? "minimal" "full") " "
+ (if unix-style? "unix-style" "in-place") " "
+ (if mv-shared? "mine-all-mine " "")
+ (if usr-local? "/usr/local " "")
+ (if links? "linked" "")
+ "\n"))
+
+ (restore-vbox-snapshot vbox-name vbox-snapshot)
+
+ (#%app
+ dynamic-wind
+
+ (lambda ()
+ (start-vbox-vm vbox-name #:pause-seconds 0))
+
+ (lambda ()
+ (define rt (remote #:host vbox-host
+ #:user vbox-user))
+
+ (make-sure-remote-is-ready rt)
+
+ (set-date rt)
+
+ (scp rt (build-path work-dir f) (at-remote rt f))
+
+ (define script (build-path work-dir "script"))
+ (call-with-output-file*
+ script
+ #:exists 'truncate
+ (lambda (o)
+ ;; Installer interactions:
+ ;;
+ ;; Unix-style distribution?
+ ;; * yes ->
+ ;; Where to install?
+ ;; [like below]
+ ;;
+ ;; Target directories
+ ;; [e]
+ ;; ...
+ ;;
+ ;; * no ->
+ ;; Where to install?
+ ;; * 1 /usr/racket
+ ;; * 2 /usr/local/racket
+ ;; * 3 ~/racket
+ ;; * 4 ./racket
+ ;; * <anything else>
+ ;;
+ ;; Prefix for link?
+ (fprintf o "~a\n" (if unix-style? "yes" "no"))
+ (fprintf o (if usr-local?
+ "2\n"
+ "4\n"))
+ (when mv-shared?
+ (fprintf o "s\n") ; "shared" path
+ (fprintf o "~a\n" (if usr-local?
+ "/usr/local/mine-all-mine"
+ "mine-all-mine")))
+ (when links?
+ (fprintf o "/usr/local\n"))
+ (fprintf o "\n")))
+ (scp rt script (at-remote rt "script"))
+
+ (when min?
+ (scp rt (build-path work-dir "base.zip") (at-remote rt "base.zip")))
+ (scp rt sample-zip-path (at-remote rt "sample.zip"))
+ (unless min?
+ (scp rt progy-path (at-remote rt "progy.rkt")))
+
+ (define sudo? (or usr-local? links?))
+ (define sudo (if sudo? "sudo " ""))
+
+ ;; install --------------------
+ (ssh rt sudo "sh " f " < script")
+
+ (define bin-dir
+ (cond
+ [(or links? (and usr-local? unix-style?)) ""]
+ [else
+ (~a (if usr-local?
+ "/usr/local/"
+ "")
+ (if unix-style?
+ "bin/"
+ "racket/bin/"))]))
+
+ ;; check that Racket runs --------------------
+ (ssh rt (~a bin-dir "racket") " -e '(displayln \"hello\")'")
+
+ ;; check that `raco setup` is ok --------------------
+ ;; For example, there are no file-permission problems.
+ (ssh rt (~a bin-dir "raco") " setup" (if sudo?
+ " --avoid-main"
+ ""))
+
+ ;; install and use a package --------------------
+ (ssh rt (~a bin-dir "raco") " pkg install sample.zip" (if min? " base.zip" ""))
+ (ssh rt (~a bin-dir "racket") " -l sample")
+
+ ;; create a stand-alone executable ----------------------------------------
+ (unless min?
+ (ssh rt (~a bin-dir "raco") " exe progy.rkt")
+ (ssh rt "./progy")
+ (ssh rt (~a bin-dir "raco") " distribute d progy")
+ (ssh rt "d/bin/progy"))
+
+ ;; uninstall ----------------------------------------
+ (when unix-style?
+ (ssh rt sudo (~a bin-dir "racket-uninstall"))
+ (when (ssh rt (~a bin-dir "racket") #:mode 'result)
+ (error "not uninstalled")))
+
+ ;; check stand-alone executable ----------------------------------------
+ (unless min?
+ (ssh rt "d/bin/progy"))
+
+ (void))
+
+ (lambda ()
+ (stop-vbox-vm vbox-name)))))
+
+
+;; ----------------------------------------
+
+(when natipkg?
+ (printf "Starting web server\n")
+ (define server
+ (thread
+ (lambda ()
+ (serve/servlet
+ (lambda args #f)
+ #:command-line? #t
+ #:listen-ip "localhost"
+ #:extra-files-paths (list pkg-archive-dir)
+ #:servlet-regexp #rx"$." ; never match
+ #:port server-port))))
+ (sync (system-idle-evt))
+
+ (for* ([f (in-list min-racket-natipkg-installers)])
+ (printf (~a "=================================================================\n"
+ "NATIPKG: "
+ f
+ "\n"))
+
+ (restore-vbox-snapshot vbox-name vbox-snapshot)
+
+ (#%app
+ dynamic-wind
+
+ (lambda ()
+ (start-vbox-vm vbox-name #:pause-seconds 0))
+
+ (lambda ()
+ (define rt (remote #:host vbox-host
+ #:user vbox-user
+ #:remote-tunnels (list (cons server-port server-port))))
+
+ (make-sure-remote-is-ready rt)
+
+ (set-date rt)
+
+ (scp rt (build-path work-dir f) (at-remote rt f))
+
+ ;; install --------------------
+ (ssh rt "sh " f " --in-place --dest racket")
+
+ (define bin-dir "racket/bin/")
+
+ ;; check that Racket runs --------------------
+ (ssh rt (~a bin-dir "racket") " -e '(displayln \"hello\")'")
+
+ ;; check that `raco setup` is ok --------------------
+ (ssh rt (~a bin-dir "raco") " setup")
+
+ ;; install packages --------------------
+ (ssh rt (~a bin-dir "raco") " pkg install"
+ " --catalog http://localhost:" (~a server-port) "/catalog/"
+ " --auto"
+ " drracket")
+
+ ;; check that the drawing library works:
+ (ssh rt (~a bin-dir "racket") " -l racket/draw")
+
+ (void))
+
+ (lambda ()
+ (stop-vbox-vm vbox-name)))))
