suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Horrible Xvnc trick

Browse Source
This commit is contained in:
Jay McCarthy 2010-11-12 15:03:31 -07:00
parent 7dcd0d408c
commit 578fadb3a9
3 changed files with 34 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/meta/drdr/config.rkt
View File

@ -10,6 +10,7 @@
(git-path "/usr/bin/git") (git-path "/usr/bin/git")
(Xvfb-path "/usr/bin/Xvnc") (Xvfb-path "/usr/bin/Xvnc")
(fluxbox-path "/usr/bin/fluxbox") (fluxbox-path "/usr/bin/fluxbox")
(vncviewer-path "/usr/bin/vncviewer")
(current-make-install-timeout-seconds (* 90 60)) (current-make-install-timeout-seconds (* 90 60))
(current-make-timeout-seconds (* 90 60)) (current-make-timeout-seconds (* 90 60))
(current-subprocess-timeout-seconds 90) (current-subprocess-timeout-seconds 90)

4
collects/meta/drdr/dirstruct.rkt
View File

@ -31,6 +31,9 @@
(define fluxbox-path (define fluxbox-path
(make-parameter "/usr/bin/fluxbox")) (make-parameter "/usr/bin/fluxbox"))
(define vncviewer-path
(make-parameter "/usr/bin/vncviewer"))
(define (plt-repository) (define (plt-repository)
(build-path (plt-directory) "repo")) (build-path (plt-directory) "repo"))
@ -100,6 +103,7 @@
[drdr-directory (parameter/c path-string?)] [drdr-directory (parameter/c path-string?)]
[make-path (parameter/c (or/c false/c string?))] [make-path (parameter/c (or/c false/c string?))]
[Xvfb-path (parameter/c (or/c false/c string?))] [Xvfb-path (parameter/c (or/c false/c string?))]
[vncviewer-path (parameter/c (or/c false/c string?))]
[fluxbox-path (parameter/c (or/c false/c string?))] [fluxbox-path (parameter/c (or/c false/c string?))]
[build? (parameter/c boolean?)] [build? (parameter/c boolean?)]
[on-unix? (-> boolean?)] [on-unix? (-> boolean?)]

44
collects/meta/drdr/plt-build.rkt
View File

@ -277,6 +277,7 @@
(recur-many (sub1 i) r f))))) (recur-many (sub1 i) r f)))))
(define XSERVER-OFFSET 20) (define XSERVER-OFFSET 20)
(define PARENT-X-SERVER 19)
(define (integrate-revision rev) (define (integrate-revision rev)
(define test-dir (define test-dir
@ -314,22 +315,35 @@
(get-scm-commit-msg rev (plt-repository)))) (get-scm-commit-msg rev (plt-repository))))
(when (build?) (when (build?)
(build-revision rev)) (build-revision rev))
(recur-many (number-of-cpus)
(lambda (j inner) (define (start-x-server i parent inner)
(define i (+ j XSERVER-OFFSET)) (notify! "Starting X server #~a" i)
(notify! "Starting X server #~a" i) (safely-delete-directory (format "/tmp/.X~a-lock" i))
(safely-delete-directory (format "/tmp/.X~a-lock" i)) (safely-delete-directory (build-path tmp-dir (format ".X~a-lock" i)))
(safely-delete-directory (build-path tmp-dir (format ".X~a-lock" i))) (safely-delete-directory (format "/tmp/.tX~a-lock" i))
(safely-delete-directory (format "/tmp/.tX~a-lock" i)) (safely-delete-directory (build-path tmp-dir (format ".tX~a-lock" i)))
(safely-delete-directory (build-path tmp-dir (format ".tX~a-lock" i))) (with-running-program
(with-running-program (Xvfb-path) (list (format ":~a" i) "-ac" "-rfbauth" "/home/jay/.vnc/passwd")
(Xvfb-path) (list (format ":~a" i) "-ac" "-rfbauth" "/home/jay/.vnc/passwd") (lambda ()
(lambda () (with-running-program
(with-running-program (fluxbox-path) (list "-display" (format ":~a" i) "-rc" "/home/jay/.fluxbox/init")
(fluxbox-path) (list "-display" (format ":~a" i) "-rc" "/home/jay/.fluxbox/init") (if parent
inner))))
(lambda () (lambda ()
(test-revision rev))))) (with-running-program
(vncviewer-path) (list "-display" (format ":~a" parent) (format ":~a" i)
"-passwd" "/home/jay/.vnc/passwd")
inner))
inner)))))
(start-x-server
PARENT-X-SERVER #f
(λ ()
(recur-many (number-of-cpus)
(lambda (j inner)
(define i (+ j XSERVER-OFFSET))
(start-x-server i PARENT-X-SERVER inner))
(lambda ()
(test-revision rev)))))))
; Remove the test directory ; Remove the test directory
(safely-delete-directory test-dir)))) (safely-delete-directory test-dir))))