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

Getting it working after the crash

Browse Source
This commit is contained in:
Jay McCarthy 2011-08-08 10:07:51 -06:00
parent 22ac1f8c54
commit a11734d990
7 changed files with 739 additions and 618 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/meta/drdr/INSTALL Normal file
View File

@ -0,0 +1,47 @@
0. Copy source to /opt/plt/drdr
1. Create
/opt/plt
/opt/plt/plt (Racket install)
/opt/plt/builds
/opt/plt/future-builds
/opt/plt/logs
/opt/plt/builds/<N> (for the first build)
2. Install stuff
sudo apt-get install xorg fluxbox python-software-properties gcc libcairo2 libpango1.0-0 libgtk2.0-0 texlive lib32gmp3 libreadline5 libpcre3-dev libgmp3-dev
sudo add-apt-repository ppa:git-core/ppa
sudo apt-get update
sudo apt-get install git-core
3. Setup git
cd /opt/plt
git clone http://git.racket-lang.org/plt.git repo
4. Setup firewall
sudo ufw allow 22
sudo ufw enable
sudo vim /etc/ufw/before.rules
*nat
:PREROUTING ACCEPT [0:0]
-A PREROUTING -p tcp --dport 80 -j REDIRECT --to-port 9000
COMMIT
sudo ufw allow 80
sudo ufw allow 9000
sudo service ufw restart
5.
setuid on /usr/bin/Xorg
6.
sudo apt-get install postfix
# Use the Internet site setup

39
collects/meta/drdr/analyze.rkt
View File

@ -61,11 +61,14 @@
(for ([pp (in-list (lc->list lc))]) (for ([pp (in-list (lc->list lc))])
(define p (bytes->string/utf-8 pp)) (define p (bytes->string/utf-8 pp))
(define bp (base-path p)) (define bp (base-path p))
(for ([responsible (in-list (rendering-responsibles (log-rendering p)))]) (for ([responsible
(hash-update! (hash-ref! responsible->problems responsible make-hasheq) (in-list
id (rendering-responsibles (log-rendering p)))])
(curry list* bp) (hash-update!
empty)))) (hash-ref! responsible->problems responsible make-hasheq)
id
(curry list* bp)
empty))))
responsible->problems)) responsible->problems))
@ -118,10 +121,19 @@
(map lc->number (map lc->number
(list timeout unclean stderr changes))) (list timeout unclean stderr changes)))
(define totals (define totals
(apply format "(timeout ~a) (unclean ~a) (stderr ~a) (changes ~a)" (map number->string nums))) (apply
format
"(timeout ~a) (unclean ~a) (stderr ~a) (changes ~a)"
(map number->string nums)))
(define (path->url pth) (define (path->url pth)
(format "http://drdr.racket-lang.org/~a~a" cur-rev pth)) (format "http://drdr.racket-lang.org/~a~a" cur-rev pth))
(define responsible-ht (statuses->responsible-ht cur-rev timeout unclean stderr changes)) (define responsible-ht
(statuses->responsible-ht
cur-rev
timeout
unclean
stderr
changes))
(define responsibles (define responsibles
(for/list ([(responsible ht) (in-hash responsible-ht)] (for/list ([(responsible ht) (in-hash responsible-ht)]
#:when (ormap (curry hash-has-key? ht) #:when (ormap (curry hash-has-key? ht)
@ -142,14 +154,15 @@
; There is a condition ; There is a condition
(not (empty? responsibles)) (not (empty? responsibles))
; It is different from before ; It is different from before
diff (hash? diff)
(for*/or ([(r ht) (in-hash diff)] (for*/or ([(r ht) (in-hash diff)]
[(id ps) (in-hash ht)]) [(id ps) (in-hash ht)])
(and (for/or ([p (in-list ps)]) (and
; XXX This squelch should be disabled if the committer changed this file (for/or ([p (in-list ps)])
; XXX But even then it can lead to problems ; XXX This squelch should be disabled if the committer changed this file
(not (path-random? (build-path (revision-trunk-dir cur-rev) (substring (path->string* p) 1))))) ; XXX But even then it can lead to problems
(not (symbol=? id 'changes)))))) (not (path-random? (build-path (revision-trunk-dir cur-rev) (substring (path->string* p) 1)))))
(not (symbol=? id 'changes))))))
(define mail-recipients (define mail-recipients
(append (if include-committer? (append (if include-committer?
(list committer) (list committer)

2
collects/meta/drdr/copy.sh
View File

@ -1,3 +1,3 @@
#!/bin/sh #!/bin/sh
rsync -avz . drdr:/opt/svn/drdr/ --exclude=compiled --delete --exclude=data rsync -avz . ${1}drdr:/opt/svn/drdr/ --exclude=compiled --delete --exclude=data

8
collects/meta/drdr/main.rkt
View File

@ -49,7 +49,8 @@
(path->string (path->string
(build-path (plt-directory) "plt" "bin" "racket")) (build-path (plt-directory) "plt" "bin" "racket"))
"-t" "-t"
(path->string (build-path (drdr-directory) "make-archive.rkt")) (path->string
(build-path (drdr-directory) "make-archive.rkt"))
"--" "--"
"--many" (number->string 100)))))) "--many" (number->string 100))))))
@ -60,8 +61,9 @@
cur-rev cur-rev
(lambda (newer) (lambda (newer)
(for ([rev (in-list newer)]) (for ([rev (in-list newer)])
(write-cache! (future-record-path rev) (write-cache!
(get-scm-commit-msg rev (plt-repository))))) (future-record-path rev)
(get-scm-commit-msg rev (plt-repository)))))
(lambda (prev-rev cur-rev) (lambda (prev-rev cur-rev)
(handle-revision prev-rev cur-rev) (handle-revision prev-rev cur-rev)

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

@ -60,7 +60,8 @@
(build-path log-dir "src" "build" "make") (build-path log-dir "src" "build" "make")
(make-path) (make-path)
(list "-j" (number->string (number-of-cpus)))) (list "-j" (number->string (number-of-cpus))))
(with-env (["PLT_SETUP_OPTIONS" (format "-j ~a" (number-of-cpus))]) (with-env
(["PLT_SETUP_OPTIONS" (format "-j ~a" (number-of-cpus))])
(run/collect/wait/log (run/collect/wait/log
#:timeout (current-make-install-timeout-seconds) #:timeout (current-make-install-timeout-seconds)
#:env (current-env) #:env (current-env)
@ -82,11 +83,17 @@
(call-with-temporary-directory (lambda () e))) (call-with-temporary-directory (lambda () e)))
(define (call-with-temporary-home-directory thunk) (define (call-with-temporary-home-directory thunk)
(define new-dir (make-temporary-file "home~a" 'directory (current-temporary-directory))) (define new-dir
(make-temporary-file
"home~a"
'directory
(current-temporary-directory)))
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
(with-handlers ([exn:fail? void]) (with-handlers ([exn:fail? void])
(copy-directory/files (hash-ref (current-env) "HOME") new-dir))) (copy-directory/files
(hash-ref (current-env) "HOME")
new-dir)))
(lambda () (lambda ()
(with-env (["HOME" (path->string new-dir)]) (with-env (["HOME" (path->string new-dir)])
(thunk))) (thunk)))
@ -169,86 +176,101 @@
(define test-workers (make-job-queue (number-of-cpus))) (define test-workers (make-job-queue (number-of-cpus)))
(define (test-directory dir-pth upper-sema) (define (test-directory dir-pth upper-sema)
(define dir-log (build-path (trunk->log dir-pth) ".index.test")) (define dir-log (build-path (trunk->log dir-pth) ".index.test"))
(if (read-cache* dir-log) (cond
(semaphore-post upper-sema) [(read-cache* dir-log)
(let () (semaphore-post upper-sema)]
(notify! "Testing in ~S" dir-pth) [else
(define files/unsorted (directory-list* dir-pth)) (notify! "Testing in ~S" dir-pth)
(define dir-sema (make-semaphore 0)) (define files/unsorted (directory-list* dir-pth))
(define files (define dir-sema (make-semaphore 0))
(sort files/unsorted < (define files
#:key (λ (p) (sort files/unsorted <
(if (bytes=? #"tests" (path->bytes p)) #:key (λ (p)
0 (if (bytes=? #"tests" (path->bytes p))
1)) 0
#:cache-keys? #t)) 1))
(for ([sub-pth (in-list files)]) #:cache-keys? #t))
(define pth (build-path dir-pth sub-pth)) (for ([sub-pth (in-list files)])
(define directory? (directory-exists? pth)) (define pth (build-path dir-pth sub-pth))
(if directory? (define directory? (directory-exists? pth))
(test-directory pth dir-sema) (cond
(let () [directory?
(define log-pth (trunk->log pth)) (test-directory pth dir-sema)]
(if (file-exists? log-pth) [else
(semaphore-post dir-sema) (define log-pth (trunk->log pth))
(let () (cond
(define pth-timeout [(file-exists? log-pth)
(or (path-timeout pth) (semaphore-post dir-sema)]
(current-subprocess-timeout-seconds))) [else
(define pth-cmd/general (path-command-line pth)) (define pth-timeout
(define pth-cmd (or (path-timeout pth)
(match pth-cmd/general (current-subprocess-timeout-seconds)))
[#f (define pth-cmd/general
#f] (path-command-line pth))
[(list-rest (or 'mzscheme 'racket) rst) (define pth-cmd
(lambda (k) (k (list* racket-path rst)))] (match pth-cmd/general
[(list-rest 'mzc rst) [#f
(lambda (k) (k (list* mzc-path rst)))] #f]
[(list-rest 'raco rst) [(list-rest (or 'mzscheme 'racket) rst)
(lambda (k) (k (list* raco-path rst)))] (lambda (k)
[(list-rest (or 'mred 'mred-text (k (list* racket-path rst)))]
'gracket 'gracket-text) [(list-rest 'mzc rst)
rst) (lambda (k) (k (list* mzc-path rst)))]
(if (on-unix?) [(list-rest 'raco rst)
(lambda (k) (lambda (k) (k (list* raco-path rst)))]
(call-with-semaphore [(list-rest (or 'mred 'mred-text
gui-lock 'gracket 'gracket-text)
(λ () rst)
(k (if (on-unix?)
(list* gracket-path (lambda (k)
"-display" (call-with-semaphore
(format ":~a" (cpu->child (current-worker))) gui-lock
rst))))) (λ ()
#f)] (k
[_ (list* gracket-path
#f])) "-display"
(if pth-cmd (format
(submit-job! ":~a"
test-workers (cpu->child
(lambda () (current-worker)))
(dynamic-wind rst)))))
void #f)]
(λ () [_
(pth-cmd #f]))
(λ (l) (cond
(with-env (["DISPLAY" (format ":~a" (cpu->child (current-worker)))]) [pth-cmd
(with-temporary-home-directory (submit-job!
(with-temporary-directory test-workers
(run/collect/wait/log log-pth (lambda ()
#:timeout pth-timeout (dynamic-wind
#:env (current-env) void
(first l) (λ ()
(rest l)))))))) (pth-cmd
(λ () (λ (l)
(semaphore-post dir-sema))))) (with-env
(semaphore-post dir-sema))))))) (["DISPLAY"
(thread (format ":~a"
(lambda () (cpu->child
(define how-many (length files)) (current-worker)))])
(semaphore-wait* dir-sema how-many) (with-temporary-home-directory
(notify! "Done with dir: ~a" dir-pth) (with-temporary-directory
(write-cache! dir-log (current-seconds)) (run/collect/wait/log
(semaphore-post upper-sema)))))) log-pth
#:timeout pth-timeout
#:env (current-env)
(first l)
(rest l))))))))
(λ ()
(semaphore-post dir-sema)))))]
[else
(semaphore-post dir-sema)])])]))
(thread
(lambda ()
(define how-many (length files))
(semaphore-wait* dir-sema how-many)
(notify! "Done with dir: ~a" dir-pth)
(write-cache! dir-log (current-seconds))
(semaphore-post upper-sema)))]))
; Some setup ; Some setup
(for ([pp (in-list (planet-packages))]) (for ([pp (in-list (planet-packages))])
(match pp (match pp
@ -267,7 +289,9 @@
#:env (current-env) #:env (current-env)
(build-path log-dir "src" "build" "set-browser.rkt") (build-path log-dir "src" "build" "set-browser.rkt")
racket-path racket-path
(list "-t" (path->string* (build-path (drdr-directory) "set-browser.rkt")))) (list "-t"
(path->string*
(build-path (drdr-directory) "set-browser.rkt"))))
; And go ; And go
(define top-sema (make-semaphore 0)) (define top-sema (make-semaphore 0))
(notify! "Starting testing") (notify! "Starting testing")
@ -292,9 +316,12 @@
(define (remove-X-locks tmp-dir i) (define (remove-X-locks tmp-dir i)
(for ([dir (in-list (list "/tmp" tmp-dir))]) (for ([dir (in-list (list "/tmp" tmp-dir))])
(safely-delete-directory (build-path dir (format ".X~a-lock" i))) (safely-delete-directory
(safely-delete-directory (build-path dir ".X11-unix" (format ".X~a-lock" i))) (build-path dir (format ".X~a-lock" i)))
(safely-delete-directory (build-path dir (format ".tX~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 (integrate-revision rev)
(define test-dir (define test-dir
@ -323,7 +350,8 @@
["TMPDIR" (path->string tmp-dir)] ["TMPDIR" (path->string tmp-dir)]
["PATH" ["PATH"
(format "~a:~a" (format "~a:~a"
(path->string (build-path trunk-dir "bin")) (path->string
(build-path trunk-dir "bin"))
(getenv "PATH"))] (getenv "PATH"))]
["PLTPLANETDIR" (path->string planet-dir)] ["PLTPLANETDIR" (path->string planet-dir)]
["HOME" (path->string home-dir)]) ["HOME" (path->string home-dir)])
@ -339,14 +367,20 @@
(with-running-program (with-running-program
"/usr/bin/Xorg" (list (format ":~a" i)) "/usr/bin/Xorg" (list (format ":~a" i))
(lambda () (lambda ()
(sleep 1) (sleep 2)
(notify! "Starting fluxbox #~a" i)
(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/pltdrdr/.fluxbox/init")
inner)))) inner))))
(start-x-server (start-x-server
ROOTX ROOTX
(lambda () (lambda ()
(sleep 2)
(notify! "Starting test of rev ~a" rev)
(test-revision rev))))) (test-revision rev)))))
; Remove the test directory ; Remove the test directory
(safely-delete-directory test-dir)))) (safely-delete-directory test-dir))))

990
collects/meta/drdr/render.rkt
View File

File diff suppressed because it is too large Load Diff

3
collects/meta/drdr/static/robots.txt Normal file
View File

@ -0,0 +1,3 @@
# go away
User-agent: *
Disallow: /