From 578fadb3a971c593dea3a3b11a5d23483668aa9b Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 12 Nov 2010 15:03:31 -0700 Subject: [PATCH] Horrible Xvnc trick --- collects/meta/drdr/config.rkt | 1 + collects/meta/drdr/dirstruct.rkt | 4 +++ collects/meta/drdr/plt-build.rkt | 44 +++++++++++++++++++++----------- 3 files changed, 34 insertions(+), 15 deletions(-) diff --git a/collects/meta/drdr/config.rkt b/collects/meta/drdr/config.rkt index 074ea8198e..534844d9eb 100644 --- a/collects/meta/drdr/config.rkt +++ b/collects/meta/drdr/config.rkt @@ -10,6 +10,7 @@ (git-path "/usr/bin/git") (Xvfb-path "/usr/bin/Xvnc") (fluxbox-path "/usr/bin/fluxbox") +(vncviewer-path "/usr/bin/vncviewer") (current-make-install-timeout-seconds (* 90 60)) (current-make-timeout-seconds (* 90 60)) (current-subprocess-timeout-seconds 90) diff --git a/collects/meta/drdr/dirstruct.rkt b/collects/meta/drdr/dirstruct.rkt index 3d182947f4..c31642fb54 100644 --- a/collects/meta/drdr/dirstruct.rkt +++ b/collects/meta/drdr/dirstruct.rkt @@ -31,6 +31,9 @@ (define fluxbox-path (make-parameter "/usr/bin/fluxbox")) +(define vncviewer-path + (make-parameter "/usr/bin/vncviewer")) + (define (plt-repository) (build-path (plt-directory) "repo")) @@ -100,6 +103,7 @@ [drdr-directory (parameter/c path-string?)] [make-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?))] [build? (parameter/c boolean?)] [on-unix? (-> boolean?)] diff --git a/collects/meta/drdr/plt-build.rkt b/collects/meta/drdr/plt-build.rkt index 08848cbccb..7aeec592c5 100644 --- a/collects/meta/drdr/plt-build.rkt +++ b/collects/meta/drdr/plt-build.rkt @@ -277,6 +277,7 @@ (recur-many (sub1 i) r f))))) (define XSERVER-OFFSET 20) +(define PARENT-X-SERVER 19) (define (integrate-revision rev) (define test-dir @@ -314,22 +315,35 @@ (get-scm-commit-msg rev (plt-repository)))) (when (build?) (build-revision rev)) - (recur-many (number-of-cpus) - (lambda (j inner) - (define i (+ j XSERVER-OFFSET)) - (notify! "Starting X server #~a" 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 (format "/tmp/.tX~a-lock" i)) - (safely-delete-directory (build-path tmp-dir (format ".tX~a-lock" i))) - (with-running-program - (Xvfb-path) (list (format ":~a" i) "-ac" "-rfbauth" "/home/jay/.vnc/passwd") - (lambda () - (with-running-program - (fluxbox-path) (list "-display" (format ":~a" i) "-rc" "/home/jay/.fluxbox/init") - inner)))) + + (define (start-x-server i parent inner) + (notify! "Starting X server #~a" 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 (format "/tmp/.tX~a-lock" i)) + (safely-delete-directory (build-path tmp-dir (format ".tX~a-lock" i))) + (with-running-program + (Xvfb-path) (list (format ":~a" i) "-ac" "-rfbauth" "/home/jay/.vnc/passwd") + (lambda () + (with-running-program + (fluxbox-path) (list "-display" (format ":~a" i) "-rc" "/home/jay/.fluxbox/init") + (if parent (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 (safely-delete-directory test-dir))))