unix-installer.rkt (10154B)
1 #lang racket 2 (require remote-shell/ssh 3 remote-shell/vbox 4 net/url 5 racket/date 6 file/zip 7 pkg/lib 8 web-server/servlet-env 9 racket/cmdline 10 racket/format) 11 12 (module test racket/base) 13 14 (define installer-vers (version)) 15 16 (command-line 17 #:once-each 18 [("--version") vers "Version to download and install" 19 (set! installer-vers vers)]) 20 21 ;; ---------------------------------------- 22 ;; Configuration (adjust as needed) 23 24 (define vbox-name "Ubuntu Server 14.04") 25 (define vbox-host "192.168.56.107") 26 (define vbox-user "racket") 27 (define vbox-snapshot "init") 28 29 (define snapshot-site "https://pre-release.racket-lang.org/") 30 (define installers-site (~a snapshot-site "installers/")) 31 (define catalog (~a snapshot-site "catalog/")) 32 33 (define min-racket-installers 34 (list (~a "racket-minimal-" installer-vers "-x86_64-linux-ubuntu-precise.sh"))) 35 36 (define racket-installers 37 (list (~a "racket-" installer-vers "-x86_64-linux-ubuntu-precise.sh"))) 38 39 (define min-racket-natipkg-installers 40 (list (~a "racket-minimal-" installer-vers "-x86_64-linux-natipkg-debian-squeeze.sh"))) 41 42 ;; For serving packages to VM: 43 (define server-port 50001) 44 45 (define work-dir (find-system-path 'temp-dir)) 46 47 ;; For disabling some tests: 48 (define basic? #t) 49 (define natipkg? #t) 50 51 ;; ---------------------------------------- 52 ;; Get installers and "base.zip" from snapshot 53 54 (define (get f #:sub [sub ""]) 55 (unless (file-exists? (build-path work-dir f)) 56 (printf "Getting ~a\n" f) 57 (call/input-url (string->url (string-append installers-site sub f)) 58 get-pure-port 59 (lambda (i) 60 (call-with-output-file* 61 (build-path work-dir f) 62 #:exists 'truncate 63 (lambda (o) 64 (copy-port i o))))))) 65 66 (for-each get min-racket-installers) 67 (for-each get racket-installers) 68 (for-each get min-racket-natipkg-installers) 69 (get #:sub "base/" "base.zip") 70 71 ;; ---------------------------------------- 72 ;; Construct a simple package 73 74 (define sample-pkg-dir (build-path work-dir "sample")) 75 (delete-directory/files sample-pkg-dir #:must-exist? #f) 76 (make-directory* sample-pkg-dir) 77 (call-with-output-file* 78 (build-path sample-pkg-dir "info.rkt") 79 (lambda (o) 80 (displayln "#lang info" o) 81 (write '(define collection "sample") o) 82 (write '(define deps '("base")) o))) 83 (call-with-output-file* 84 (build-path sample-pkg-dir "main.rkt") 85 (lambda (o) 86 (displayln "#lang racket/base" o) 87 (write "sample" o))) 88 89 (define sample-zip-path (build-path work-dir "sample.zip")) 90 (parameterize ([current-directory work-dir]) 91 (when (file-exists? "sample.zip") (delete-file "sample.zip")) 92 (zip "sample.zip" "sample" #:utc-timestamps? #t)) 93 94 ;; ---------------------------------------- 95 ;; Construct a simple program 96 97 (define progy-path (build-path work-dir "progy.rkt")) 98 (call-with-output-file* 99 progy-path 100 #:exists 'truncate 101 (lambda (o) 102 (displayln "#lang racket/base" o) 103 (write '(require sample) o))) 104 105 106 ;; ---------------------------------------- 107 ;; Packages to local 108 109 (define pkg-archive-dir (build-path work-dir "archive")) 110 111 (when natipkg? 112 (pkg-catalog-archive pkg-archive-dir 113 (list catalog) 114 #:state-catalog (build-path work-dir "archive" "state.sqlite") 115 #:relative-sources? #t)) 116 117 ;; ---------------------------------------- 118 119 (define (set-date rt) 120 (ssh rt "sudo date --set=\"" 121 (parameterize ([date-display-format 'rfc2822]) 122 (date->string (seconds->date (current-seconds)) #t)) 123 "\"")) 124 125 ;; ---------------------------------------- 126 127 (when basic? 128 (for* ([min? '(#t #f)] 129 [f (in-list (if min? 130 min-racket-installers 131 racket-installers))] 132 ;; Unix-style install? 133 [unix-style? '(#f #t)] 134 ;; Change path of "shared" to "mine-all-mine"? 135 [mv-shared? (if unix-style? '(#t #f) '(#f))] 136 ;; Install into "/usr/local"? 137 [usr-local? '(#t #f)] 138 ;; Link in-place install executables in "/usr/local/bin"? 139 [links? (if unix-style? '(#f) '(#t #f))]) 140 (printf (~a "=================================================================\n" 141 "CONFIGURATION: " 142 (if min? "minimal" "full") " " 143 (if unix-style? "unix-style" "in-place") " " 144 (if mv-shared? "mine-all-mine " "") 145 (if usr-local? "/usr/local " "") 146 (if links? "linked" "") 147 "\n")) 148 149 (restore-vbox-snapshot vbox-name vbox-snapshot) 150 151 (#%app 152 dynamic-wind 153 154 (lambda () 155 (start-vbox-vm vbox-name #:pause-seconds 0)) 156 157 (lambda () 158 (define rt (remote #:host vbox-host 159 #:user vbox-user)) 160 161 (make-sure-remote-is-ready rt) 162 163 (set-date rt) 164 165 (scp rt (build-path work-dir f) (at-remote rt f)) 166 167 (define script (build-path work-dir "script")) 168 (call-with-output-file* 169 script 170 #:exists 'truncate 171 (lambda (o) 172 ;; Installer interactions: 173 ;; 174 ;; Unix-style distribution? 175 ;; * yes -> 176 ;; Where to install? 177 ;; [like below] 178 ;; 179 ;; Target directories 180 ;; [e] 181 ;; ... 182 ;; 183 ;; * no -> 184 ;; Where to install? 185 ;; * 1 /usr/racket 186 ;; * 2 /usr/local/racket 187 ;; * 3 ~/racket 188 ;; * 4 ./racket 189 ;; * <anything else> 190 ;; 191 ;; Prefix for link? 192 (fprintf o "~a\n" (if unix-style? "yes" "no")) 193 (fprintf o (if usr-local? 194 "2\n" 195 "4\n")) 196 (when mv-shared? 197 (fprintf o "s\n") ; "shared" path 198 (fprintf o "~a\n" (if usr-local? 199 "/usr/local/mine-all-mine" 200 "mine-all-mine"))) 201 (when links? 202 (fprintf o "/usr/local\n")) 203 (fprintf o "\n"))) 204 (scp rt script (at-remote rt "script")) 205 206 (when min? 207 (scp rt (build-path work-dir "base.zip") (at-remote rt "base.zip"))) 208 (scp rt sample-zip-path (at-remote rt "sample.zip")) 209 (unless min? 210 (scp rt progy-path (at-remote rt "progy.rkt"))) 211 212 (define sudo? (or usr-local? links?)) 213 (define sudo (if sudo? "sudo " "")) 214 215 ;; install -------------------- 216 (ssh rt sudo "sh " f " < script") 217 218 (define bin-dir 219 (cond 220 [(or links? (and usr-local? unix-style?)) ""] 221 [else 222 (~a (if usr-local? 223 "/usr/local/" 224 "") 225 (if unix-style? 226 "bin/" 227 "racket/bin/"))])) 228 229 ;; check that Racket runs -------------------- 230 (ssh rt (~a bin-dir "racket") " -e '(displayln \"hello\")'") 231 232 ;; check that `raco setup` is ok -------------------- 233 ;; For example, there are no file-permission problems. 234 (ssh rt (~a bin-dir "raco") " setup" (if sudo? 235 " --avoid-main" 236 "")) 237 238 ;; install and use a package -------------------- 239 (ssh rt (~a bin-dir "raco") " pkg install sample.zip" (if min? " base.zip" "")) 240 (ssh rt (~a bin-dir "racket") " -l sample") 241 242 ;; create a stand-alone executable ---------------------------------------- 243 (unless min? 244 (ssh rt (~a bin-dir "raco") " exe progy.rkt") 245 (ssh rt "./progy") 246 (ssh rt (~a bin-dir "raco") " distribute d progy") 247 (ssh rt "d/bin/progy")) 248 249 ;; uninstall ---------------------------------------- 250 (when unix-style? 251 (ssh rt sudo (~a bin-dir "racket-uninstall")) 252 (when (ssh rt (~a bin-dir "racket") #:mode 'result) 253 (error "not uninstalled"))) 254 255 ;; check stand-alone executable ---------------------------------------- 256 (unless min? 257 (ssh rt "d/bin/progy")) 258 259 (void)) 260 261 (lambda () 262 (stop-vbox-vm vbox-name))))) 263 264 265 ;; ---------------------------------------- 266 267 (when natipkg? 268 (printf "Starting web server\n") 269 (define server 270 (thread 271 (lambda () 272 (serve/servlet 273 (lambda args #f) 274 #:command-line? #t 275 #:listen-ip "localhost" 276 #:extra-files-paths (list pkg-archive-dir) 277 #:servlet-regexp #rx"$." ; never match 278 #:port server-port)))) 279 (sync (system-idle-evt)) 280 281 (for* ([f (in-list min-racket-natipkg-installers)]) 282 (printf (~a "=================================================================\n" 283 "NATIPKG: " 284 f 285 "\n")) 286 287 (restore-vbox-snapshot vbox-name vbox-snapshot) 288 289 (#%app 290 dynamic-wind 291 292 (lambda () 293 (start-vbox-vm vbox-name #:pause-seconds 0)) 294 295 (lambda () 296 (define rt (remote #:host vbox-host 297 #:user vbox-user 298 #:remote-tunnels (list (cons server-port server-port)))) 299 300 (make-sure-remote-is-ready rt) 301 302 (set-date rt) 303 304 (scp rt (build-path work-dir f) (at-remote rt f)) 305 306 ;; install -------------------- 307 (ssh rt "sh " f " --in-place --dest racket") 308 309 (define bin-dir "racket/bin/") 310 311 ;; check that Racket runs -------------------- 312 (ssh rt (~a bin-dir "racket") " -e '(displayln \"hello\")'") 313 314 ;; check that `raco setup` is ok -------------------- 315 (ssh rt (~a bin-dir "raco") " setup") 316 317 ;; install packages -------------------- 318 (ssh rt (~a bin-dir "raco") " pkg install" 319 " --catalog http://localhost:" (~a server-port) "/catalog/" 320 " --auto" 321 " drracket") 322 323 ;; check that the drawing library works: 324 (ssh rt (~a bin-dir "racket") " -l racket/draw") 325 326 (void)) 327 328 (lambda () 329 (stop-vbox-vm vbox-name)))))