Adding tgz

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))

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

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?)])

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))
 

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)))

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,7 +209,8 @@
      (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"])
+     `(table
+       ([class "data"])
        (tr ([class "author"]) (td "Author:") (td ,author))
        (tr ([class "date"]) 
            (td "Build Start:")
@@ -215,18 +225,28 @@
        (tr ([class "msg"]) (td "Log:") (td (pre ,msg)))
        (tr ([class "changes"]) 
            (td 
-                  (a ([href ,(format "javascript:TocviewToggle(\"~a\",\"~a\");" cg-id ccss-id)])
+            (a ([href 
+                 ,(format
+                   "javascript:TocviewToggle(\"~a\",\"~a\");"
+                   cg-id ccss-id)])
                (span ([id ,cg-id]) 9658) "Changes:"))
            (td
-                  (div ([id ,ccss-id]
+            (div 
+             ([id ,ccss-id]
               [style "display: none;"])
-                       ,@(map (match-lambda
+             ,@(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)))
+                       ,(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)