diff --git a/pkgs/distro-build/config.rkt b/pkgs/distro-build/config.rkt
index d147186..43b2758 100644
--- a/pkgs/distro-build/config.rkt
+++ b/pkgs/distro-build/config.rkt
@@ -164,8 +164,11 @@
;; machine starts by a `git pull' in
; set
;; to #f, for example, for a repo checkout that is
;; shared with server; the default is #t
-;; #:site-dest --- destination for completed build; the default
-;; is "build/site"
+;; #:site-dest --- destination for completed build, used
+;; by the `site' makefile target; the
+;; default is "build/site"
+;; #:max-snapshots --- number of snapshots to keep, used by
+;; the `snapshot-site' makefile target
;;
;; Machine-only keywords:
;;
@@ -217,6 +220,10 @@
;; `CONFIG_MODE' variable. The default mode is "default". The
;; interpretation of modes is completely up to the
;; site configuration file.
+;;
+;; (current-stamp) -> string?
+;; Returns a string to identifiy the current build, normally a
+;; combination of the date and a git commit hash.
;; ----------------------------------------
@@ -357,6 +364,7 @@
[(#:clean?) (boolean? val)]
[(#:pull?) (boolean? val)]
[(#:site-dest) (path-string? val)]
+ [(#:max-snapshots) (real? val)]
[else 'bad-keyword]))
(define (check-machine-keyword kw val)
diff --git a/pkgs/distro-build/download-page.rkt b/pkgs/distro-build/download-page.rkt
index 023f422..07c41ae 100644
--- a/pkgs/distro-build/download-page.rkt
+++ b/pkgs/distro-build/download-page.rkt
@@ -38,7 +38,8 @@
#:dest [dest "index.html"]
#:installers-url [installers-url "./"]
#:title [title "Racket Downloads"]
- #:git-clone [git-clone #f])
+ #:git-clone [git-clone #f]
+ #:post-content [post-content null])
(define table (call-with-input-file table-file read))
@@ -94,6 +95,7 @@
`((p
(div (span ([class "detail"]) "Repository: " (span ([class "path"]) ,origin)))
(div (span ([class "detail"]) "Commit: " (span ([class "checksum"]) ,stamp))))))
- null)))
+ null)
+ ,@post-content))
o)
(void)))))
diff --git a/pkgs/distro-build/manage-snapshots.rkt b/pkgs/distro-build/manage-snapshots.rkt
new file mode 100644
index 0000000..5b6f723
--- /dev/null
+++ b/pkgs/distro-build/manage-snapshots.rkt
@@ -0,0 +1,52 @@
+#lang racket/base
+(require racket/cmdline
+ racket/file
+ net/url
+ "download-page.rkt"
+ (only-in "config.rkt" extract-options))
+
+(define build-dir (build-path "build"))
+(define installers-dir (build-path "installers"))
+
+(define-values (config-file config-mode)
+ (command-line
+ #:args
+ (config-file config-mode)
+ (values config-file config-mode)))
+
+(define config (extract-options config-file config-mode))
+
+(define site-dir (hash-ref config
+ '#:site-dest
+ (build-path build-dir "site")))
+
+(define current-snapshot
+ (let-values ([(base name dir?) (split-path site-dir)])
+ (path-element->string name)))
+
+(define snapshots-dir (build-path site-dir 'up))
+
+(define snapshots (for/list ([p (in-list (directory-list snapshots-dir))]
+ #:when (directory-exists? (build-path snapshots-dir p)))
+ (path-element->string p)))
+
+(define n (hash-ref config '#:max-snapshots 5))
+(when (n . < . (length snapshots))
+ (define remove-snapshots (remove
+ current-snapshot
+ (list-tail (sort snapshots string>?) n)))
+ (for ([s (in-list remove-snapshots)])
+ (printf "Removing snapshot ~a\n" s)
+ (delete-directory/files (build-path snapshots-dir s))))
+
+(make-download-page (build-path site-dir
+ installers-dir
+ "table.rktd")
+ #:installers-url (string-append current-snapshot "/installers/")
+ #:dest (build-path snapshots-dir
+ "index.html")
+ #:git-clone (current-directory)
+ #:post-content `((p "Snapshot ID: "
+ (a ((href ,(string-append current-snapshot
+ "/index.html")))
+ ,current-snapshot))))