diff --git a/collects/meta/drdr/analyze.rkt b/collects/meta/drdr/analyze.rkt index 552739fd66..ddcb709789 100644 --- a/collects/meta/drdr/analyze.rkt +++ b/collects/meta/drdr/analyze.rkt @@ -234,7 +234,8 @@ (define (trunk-path pth) (define rev (current-rev)) - ((rebase-path (revision-log-dir rev) (revision-trunk-dir rev)) pth)) + ((rebase-path (revision-log-dir rev) (revision-trunk-dir rev)) + pth)) (define (analyze-path pth dir?) (define rev (current-rev)) diff --git a/collects/meta/drdr/copy.sh b/collects/meta/drdr/copy.sh index 48589b8479..62c2898bfc 100755 --- a/collects/meta/drdr/copy.sh +++ b/collects/meta/drdr/copy.sh @@ -1,3 +1,3 @@ #!/bin/sh -rsync -avz . ${1}drdr:/opt/svn/drdr/ --exclude=compiled --delete --exclude=data +rsync -avz . ${1}drdr:/opt/svn/drdr/ --exclude=compiled --delete --exclude=data --exclude=builds diff --git a/collects/meta/drdr/dirstruct.rkt b/collects/meta/drdr/dirstruct.rkt index 6b3531170b..8c827c9dda 100644 --- a/collects/meta/drdr/dirstruct.rkt +++ b/collects/meta/drdr/dirstruct.rkt @@ -24,6 +24,8 @@ (define make-path (make-parameter "/usr/bin/make")) +(define tar-path + (make-parameter "/bin/tar")) (define Xvfb-path (make-parameter "/usr/bin/Xvfb")) @@ -60,6 +62,8 @@ (define (revision-trunk-dir rev) (build-path (revision-dir rev) "trunk")) +(define (revision-trunk.tgz rev) + (build-path (revision-dir rev) "trunk.tgz")) (define (revision-commit-msg rev) (build-path (revision-dir rev) "commit-msg")) @@ -101,6 +105,7 @@ [plt-data-directory (-> path?)] [plt-future-build-directory (-> path?)] [drdr-directory (parameter/c path-string?)] + [tar-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?))] [vncviewer-path (parameter/c (or/c false/c string?))] @@ -120,5 +125,6 @@ [revision-log-dir (exact-nonnegative-integer? . -> . path?)] [revision-analyze-dir (exact-nonnegative-integer? . -> . path-string?)] [revision-trunk-dir (exact-nonnegative-integer? . -> . path?)] + [revision-trunk.tgz (exact-nonnegative-integer? . -> . path?)] [revision-archive (exact-nonnegative-integer? . -> . path?)] [path->revision (path-string? . -> . exact-nonnegative-integer?)]) diff --git a/collects/meta/drdr/make-archive.rkt b/collects/meta/drdr/make-archive.rkt index 47b0dea408..0edca37bc6 100644 --- a/collects/meta/drdr/make-archive.rkt +++ b/collects/meta/drdr/make-archive.rkt @@ -23,7 +23,8 @@ (create-archive tmp-path (revision-dir rev)) (rename-file-or-directory tmp-path archive-path) (archive-directory (revision-log-dir rev)) - (archive-directory (revision-analyze-dir rev))))) + (archive-directory (revision-analyze-dir rev)) + (safely-delete-directory (revision-trunk.tgz rev))))) (define mode (make-parameter 'single)) diff --git a/collects/meta/drdr/plt-build.rkt b/collects/meta/drdr/plt-build.rkt index 06c2a9d333..9cc49bacd7 100644 --- a/collects/meta/drdr/plt-build.rkt +++ b/collects/meta/drdr/plt-build.rkt @@ -67,7 +67,15 @@ #:env (current-env) (build-path log-dir "src" "build" "make-install") (make-path) - (list "-j" (number->string (number-of-cpus)) "install"))))) + (list "-j" (number->string (number-of-cpus)) "install")))) + (run/collect/wait/log + #:timeout (current-make-install-timeout-seconds) + #:env (current-env) + (build-path log-dir "src" "build" "archive") + (tar-path) + (list "-czvf" + (path->string (revision-trunk.tgz rev)) + (path->string trunk-dir)))) (define (call-with-temporary-directory thunk) (define tempdir (symbol->string (gensym 'tmpdir))) diff --git a/collects/meta/drdr/render.rkt b/collects/meta/drdr/render.rkt index c2a207affd..e274bd4daf 100644 --- a/collects/meta/drdr/render.rkt +++ b/collects/meta/drdr/render.rkt @@ -137,6 +137,15 @@ (tr ([class "author"]) (td "Author:") (td ,author)) (tr ([class "date"]) (td "Build Start:") (td ,bdate/s)) (tr ([class "date"]) (td "Build End:") (td ,bdate/e)) + ,@(if (file-exists? (revision-trunk.tgz (current-rev))) + `((tr ([class "date"]) + (td "Archive") + (td (a + ([href + ,(format "/builds/~a/trunk.tgz" + (current-rev))]) + "trunk.tgz")))) + `()) (tr ([class "hash"]) (td "Diff:") (td (a ([href ,(log->url gp)]) @@ -200,46 +209,57 @@ (define url (format "http://svn.racket-lang.org/view?view=rev&revision=~a" num)) (define cg-id (symbol->string (gensym 'changes))) (define ccss-id (symbol->string (gensym 'changes))) - `(table ([class "data"]) - (tr ([class "author"]) (td "Author:") (td ,author)) - (tr ([class "date"]) - (td "Build Start:") - (td ,bdate/s)) - (tr ([class "date"]) (td "Build End:") (td ,bdate/e)) - (tr ([class "rev"]) - (td "Commit:") - (td (a ([href ,url]) ,(number->string num)))) - (tr ([class "date"]) - (td "Date:") - (td ,(svn-date->nice-date date))) - (tr ([class "msg"]) (td "Log:") (td (pre ,msg))) - (tr ([class "changes"]) - (td - (a ([href ,(format "javascript:TocviewToggle(\"~a\",\"~a\");" cg-id ccss-id)]) - (span ([id ,cg-id]) 9658) "Changes:")) - (td - (div ([id ,ccss-id] - [style "display: none;"]) - ,@(map (match-lambda - [(struct svn-change (action path)) - `(p ([class "output"]) - ,(symbol->string action) " " - ,(if (regexp-match #rx"^/trunk/collects" path) - (local [(define path-w/o-trunk - (apply build-path (list-tail (explode-path path) 2))) - (define html-path - (if (looks-like-directory? path) - (format "~a/" path-w/o-trunk) - path-w/o-trunk)) - (define path-url - (path->string* html-path)) - (define path-tested? - #t)] - (if path-tested? - `(a ([href ,path-url]) ,path) - path)) - path))]) - changes)))))] + `(table + ([class "data"]) + (tr ([class "author"]) (td "Author:") (td ,author)) + (tr ([class "date"]) + (td "Build Start:") + (td ,bdate/s)) + (tr ([class "date"]) (td "Build End:") (td ,bdate/e)) + (tr ([class "rev"]) + (td "Commit:") + (td (a ([href ,url]) ,(number->string num)))) + (tr ([class "date"]) + (td "Date:") + (td ,(svn-date->nice-date date))) + (tr ([class "msg"]) (td "Log:") (td (pre ,msg))) + (tr ([class "changes"]) + (td + (a ([href + ,(format + "javascript:TocviewToggle(\"~a\",\"~a\");" + cg-id ccss-id)]) + (span ([id ,cg-id]) 9658) "Changes:")) + (td + (div + ([id ,ccss-id] + [style "display: none;"]) + ,@(map + (match-lambda + [(struct svn-change (action path)) + `(p ([class "output"]) + ,(symbol->string action) " " + ,(if (regexp-match + #rx"^/trunk/collects" + path) + (local + [(define path-w/o-trunk + (apply build-path + (list-tail + (explode-path path) 2))) + (define html-path + (if (looks-like-directory? path) + (format "~a/" path-w/o-trunk) + path-w/o-trunk)) + (define path-url + (path->string* html-path)) + (define path-tested? + #t)] + (if path-tested? + `(a ([href ,path-url]) ,path) + path)) + path))]) + changes)))))] [else '" "]))