From 89f3c566257a4001c690997293e9bf32181d0f29 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 9 Dec 2010 13:41:01 -0700
Subject: [PATCH] Trying xnest inside of real root

---
 collects/meta/drdr/config.rkt    |  2 +-
 collects/meta/drdr/good-init.sh  |  2 +-
 collects/meta/drdr/plt-build.rkt | 44 ++++++++++++++++++++------------
 3 files changed, 29 insertions(+), 19 deletions(-)

diff --git a/collects/meta/drdr/config.rkt b/collects/meta/drdr/config.rkt
index 2eb8c9b221..f198fc7539 100644
--- a/collects/meta/drdr/config.rkt
+++ b/collects/meta/drdr/config.rkt
@@ -8,7 +8,7 @@
 (plt-directory "/opt/plt")
 (drdr-directory "/opt/svn/drdr")
 (git-path "/usr/bin/git")
-(Xvfb-path "/usr/bin/Xorg")
+(Xvfb-path "/usr/bin/Xnest")
 (fluxbox-path "/usr/bin/fluxbox")
 (vncviewer-path "/usr/bin/vncviewer")
 (current-make-install-timeout-seconds (* 90 60))
diff --git a/collects/meta/drdr/good-init.sh b/collects/meta/drdr/good-init.sh
index 8f383d4fdc..2cbc5c170c 100755
--- a/collects/meta/drdr/good-init.sh
+++ b/collects/meta/drdr/good-init.sh
@@ -9,7 +9,7 @@ cd "$DRDR"
 
 kill_all() {
   cat "$LOGS/"*.pid > /tmp/leave-pids-$$
-  KILL=`pgrep '^(Xorg|Xvfb|Xvnc|fluxbox|racket|gracket(-text)?)$' | grep -w -v -f /tmp/leave-pids-$$`
+  KILL=`pgrep '^(Xorg|Xnest|Xvfb|Xvnc|fluxbox|racket|gracket(-text)?)$' | grep -w -v -f /tmp/leave-pids-$$`
   rm /tmp/leave-pids-$$
   kill -15 $KILL
   sleep 2
diff --git a/collects/meta/drdr/plt-build.rkt b/collects/meta/drdr/plt-build.rkt
index d2be187286..f834c3eeda 100644
--- a/collects/meta/drdr/plt-build.rkt
+++ b/collects/meta/drdr/plt-build.rkt
@@ -103,12 +103,12 @@
            #:env (current-env)
            command args))
         (define-values
-          (the-process stdout stdin stderr)
+          (the-process _stdout stdin _stderr)
           (parameterize ([subprocess-group-enabled #t])
             (apply subprocess
-                   #f #;(current-error-port) 
+                   (current-error-port) 
                    #f
-                   #f #;(current-error-port)
+                   (current-error-port)
                    new-command new-args)))
         ; Die if this program does
         (define parent
@@ -129,8 +129,8 @@
          thunk
          (λ ()
            ; Close the output ports
-           (close-input-port stdout)
-           (close-input-port stderr)
+           #;(close-input-port stdout)
+           #;(close-input-port stderr)
            
            ; Kill the guard
            (kill-thread waiter)
@@ -277,8 +277,15 @@
                     (recur-many (sub1 i) r f)))))
 
 (define XSERVER-OFFSET 20)
+(define ROOTX XSERVER-OFFSET)
 (define (cpu->child cpu-i)
-  (+ XSERVER-OFFSET cpu-i))
+  (+ XSERVER-OFFSET cpu-i 1))
+
+(define (remove-X-locks tmp-dir i)
+  (for ([dir (in-list (list "/tmp" tmp-dir))])
+    (safely-delete-directory (build-path dir (format ".X~a-lock" i)))
+    (safely-delete-directory (build-path dir ".X11-unix" (format ".X~a-lock" i)))
+    (safely-delete-directory (build-path dir (format ".tX~a-lock" i)))))
 
 (define (integrate-revision rev)
   (define test-dir
@@ -319,24 +326,27 @@
          
          (define (start-x-server i 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)))
+           (remove-X-locks tmp-dir i)
            (with-running-program
-               (Xvfb-path) (list (format ":~a" i))
+               (Xvfb-path) (list (format ":~a" i) "-display" (format ":~a" ROOTX))
              (lambda ()
                (sleep 1)
                (with-running-program
                    (fluxbox-path) (list "-display" (format ":~a" i) "-rc" "/home/jay/.fluxbox/init")
                  inner))))
          
-         (recur-many (number-of-cpus)
-                     (lambda (cpu-i inner)
-                       (define child (cpu->child cpu-i))
-                       (start-x-server child inner))
-                     (lambda ()
-                       (test-revision rev)))))
+         (notify! "Starting root X server #~a" ROOTX)
+         (remove-X-locks tmp-dir ROOTX)
+         (with-running-program
+             "/usr/bin/Xorg" (list (format ":~a" ROOTX))
+           (lambda ()
+             (sleep 10)
+             (recur-many (number-of-cpus)
+                         (lambda (cpu-i inner)
+                           (define child (cpu->child cpu-i))
+                           (start-x-server child inner))
+                         (lambda ()
+                           (test-revision rev)))))))
      ; Remove the test directory
      (safely-delete-directory test-dir))))