From a797de8f9db60c86e330141b7992aa99b1f7b2de Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 25 May 2010 14:57:37 -0600 Subject: [PATCH] Finalizing house call --- collects/meta/drdr/at-home.ss | 66 ------------------ collects/meta/drdr/dirstruct.ss | 4 ++ collects/meta/drdr/house-call.ss | 115 +++++++++++++++++++++++++++++++ collects/meta/drdr/plt-build.ss | 5 +- 4 files changed, 123 insertions(+), 67 deletions(-) delete mode 100644 collects/meta/drdr/at-home.ss create mode 100644 collects/meta/drdr/house-call.ss diff --git a/collects/meta/drdr/at-home.ss b/collects/meta/drdr/at-home.ss deleted file mode 100644 index ca34edc76c..0000000000 --- a/collects/meta/drdr/at-home.ss +++ /dev/null @@ -1,66 +0,0 @@ -#lang racket -(require racket/runtime-path - "scm.ss" - "cache.ss" - "metadata.ss" - "plt-build.ss" - "notify.ss" - "path-utils.ss" - "dirstruct.ss") - -(command-line #:program "drdr-at-home" - #:once-each - [("-j" "--jobs") jobs "How many processes to run simultaneously" (number-of-cpus (string->number jobs))] - ["--no-build" "Do not build, just test" (build? #f)]) - -; Find paths we need -(define (path->string^ p) - (and p (path->string p))) - -(git-path (path->string^ (find-executable-path "git"))) -(Xvfb-path #f #;(path->string^ (find-executable-path "Xvfb"))) -(fluxbox-path #f #;(path->string^ (find-executable-path "fluxbox"))) - -; Find where we are -(define-runtime-path here ".") -(drdr-directory here) -(define this-rev-dir (build-path here 'up 'up 'up)) - -; Setup directories that DrDr needs -(define tmp-plt (make-temporary-file "plt~a" 'directory)) -(plt-directory tmp-plt) -(for ([d (in-list (list "builds" "future-builds" "data"))]) - (make-directory* (build-path tmp-plt d))) - -(make-file-or-directory-link this-rev-dir (build-path tmp-plt "repo")) -(make-file-or-directory-link this-rev-dir (build-path tmp-plt "plt")) - -; Make up a revision and link it in -(define fake-rev 50) -(define fake-trunk (revision-trunk-dir fake-rev)) -(make-parent-directory fake-trunk) -(make-file-or-directory-link this-rev-dir fake-trunk) -(write-cache! (revision-commit-msg fake-rev) - (make-git-push fake-rev "you!" empty)) - -; Override the props file -(hash-set! props-cache fake-rev - (dynamic-require `(file ,(path->string (build-path this-rev-dir "collects" "meta" "props"))) - 'get-prop)) - -; Setup the logger -(void - (thread - (lambda () - (define recv (make-log-receiver (current-logger) 'info)) - (let loop () - (match-define (vector level msg val) (sync recv)) - (display msg) (newline) - (loop))))) - -; Do it! -(notify! "Starting DrDr at home") -(integrate-revision fake-rev) - -; Clean up -(delete-directory/files tmp-plt) \ No newline at end of file diff --git a/collects/meta/drdr/dirstruct.ss b/collects/meta/drdr/dirstruct.ss index fe91d0d714..a0a9ed32ca 100644 --- a/collects/meta/drdr/dirstruct.ss +++ b/collects/meta/drdr/dirstruct.ss @@ -85,6 +85,9 @@ (define build? (make-parameter #t)) +(define (on-unix?) + (symbol=? 'unix (system-type 'os))) + (provide/contract [current-subprocess-timeout-seconds (parameter/c exact-nonnegative-integer?)] [number-of-cpus (parameter/c exact-nonnegative-integer?)] @@ -99,6 +102,7 @@ [Xvfb-path (parameter/c (or/c false/c string?))] [fluxbox-path (parameter/c (or/c false/c string?))] [build? (parameter/c boolean?)] + [on-unix? (-> boolean?)] [plt-repository (-> path?)] [path-timing-log (path-string? . -> . path?)] [path-timing-png (path-string? . -> . path?)] diff --git a/collects/meta/drdr/house-call.ss b/collects/meta/drdr/house-call.ss new file mode 100644 index 0000000000..94edd93f8d --- /dev/null +++ b/collects/meta/drdr/house-call.ss @@ -0,0 +1,115 @@ +#lang racket +(require racket/runtime-path + racket/date + "list-count.ss" + "scm.ss" + "formats.ss" + "cache.ss" + "metadata.ss" + "analyze.ss" + "rendering.ss" + "plt-build.ss" + "status.ss" + "replay.ss" + "notify.ss" + "path-utils.ss" + "dirstruct.ss") + +(build? #f) + +(define show-log + (command-line #:program "house-call" + #:once-each + [("-j" "--jobs") jobs "How many processes to run simultaneously" (number-of-cpus (string->number jobs))] + ["--build" "Build the source first" (build? #t)] + #:args log-to-view + log-to-view)) + +; Find paths we need +(define (path->string^ p) + (and p (path->string p))) + +(git-path (path->string^ (find-executable-path "git"))) +(Xvfb-path (and (on-unix?) (path->string^ (find-executable-path "Xvfb")))) +(fluxbox-path (and (on-unix?) (path->string^ (find-executable-path "fluxbox")))) + +; Find where we are +(define-runtime-path here ".") +(drdr-directory here) +(define this-rev-dir (build-path here 'up 'up 'up)) + +; Setup directories that DrDr needs +(define (make-file-or-directory-link* from to) + (unless (link-exists? to) + (make-file-or-directory-link from to))) + +(define house-calls (build-path this-rev-dir "house-calls")) +(plt-directory house-calls) +(for ([d (in-list (list "builds" "future-builds" "data"))]) + (make-directory* (build-path house-calls d))) + +(make-file-or-directory-link* this-rev-dir (build-path house-calls "repo")) +(make-file-or-directory-link* this-rev-dir (build-path house-calls "plt")) + +; Make up a revision and link it in +(define fake-rev (date->julian/scalinger (current-date))) +(current-rev fake-rev) +(define fake-trunk (revision-trunk-dir fake-rev)) +(make-parent-directory fake-trunk) +(make-file-or-directory-link* this-rev-dir fake-trunk) +(write-cache! (revision-commit-msg fake-rev) + (make-git-push fake-rev "you!" empty)) + +; Override the props file +(hash-set! props-cache fake-rev + (dynamic-require `(file ,(path->string (build-path this-rev-dir "collects" "meta" "props"))) + 'get-prop)) + +; Setup the logger +(void + (thread + (lambda () + (define recv (make-log-receiver (current-logger) 'info)) + (let loop () + (match-define (vector level msg val) (sync recv)) + (display msg) (newline) + (loop))))) + +; Do it! +(notify! "DrDr is making a house call...") +(integrate-revision fake-rev) + +(define re (rebase-path (revision-log-dir fake-rev) "/")) +(define (print-lc label lc) + (define l (lc->list lc)) + (unless (empty? l) + (printf "~a:\n" label) + (for ([bs (in-list l)]) + (printf "\t~a\n" + (substring (path->string* (re (bytes->path bs))) 1))) + (newline))) + +(match (analyze-logs fake-rev) + [(struct rendering (start end duration timeout unclean stderr _ _)) + + (print-lc "Timeout" timeout) + (print-lc "Unclean Exit" unclean) + (print-lc "STDERR Output" stderr) + + (printf "Duration (Abs): ~a\n" + (format-duration-ms (- end start))) + (printf "Duration (Sum): ~a\n" + (format-duration-ms duration))] + [#f + (void)]) + +(for ([p (in-list show-log)]) + (define lp (build-path (revision-log-dir fake-rev) p)) + (match (read-cache lp) + [(? status? s) + (newline) + (printf "Replaying ~a:\n" p) + (printf "~a\n" (regexp-replace* #rx"" (apply string-append (add-between (status-command-line s) " ")) (number->string fake-rev))) + (replay-status s)] + [x + (printf "Could not get ~a's log; got: ~s\n" p x)])) \ No newline at end of file diff --git a/collects/meta/drdr/plt-build.ss b/collects/meta/drdr/plt-build.ss index ea3050ccf8..4fc5dc52bc 100644 --- a/collects/meta/drdr/plt-build.ss +++ b/collects/meta/drdr/plt-build.ss @@ -195,7 +195,10 @@ [(list-rest (or 'mred 'mred-text 'gracket 'gracket-text) rst) - (lambda () (list* gracket-text-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst))] + (if (on-unix?) + (lambda () + (list* gracket-text-path "-display" (format ":~a" (+ XSERVER-OFFSET (current-worker))) rst)) + #f)] [_ #f]))] (if pth-cmd