From ea591c3c231e9f8fe5770654f7977f929f19a028 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Mon, 1 Nov 2010 16:25:49 -0400
Subject: [PATCH] * Add an attempt to find the SHA1 and date from the
 ".git/HEAD" file.

* Try "/opt/local/bin/git" on OSX, since it's a common path for git, and
  when running through the Finder it will usually not be found in the
  $PATH.

* Explain the various results in a detailed comment.
---
 collects/repo-time-stamp/stamp.rkt | 86 +++++++++++++++++++++++-------
 1 file changed, 67 insertions(+), 19 deletions(-)

diff --git a/collects/repo-time-stamp/stamp.rkt b/collects/repo-time-stamp/stamp.rkt
index 32000ec195..d9bfb612ff 100644
--- a/collects/repo-time-stamp/stamp.rkt
+++ b/collects/repo-time-stamp/stamp.rkt
@@ -2,6 +2,37 @@
 
 (provide stamp)
 
+#|
+
+  This file provides a single binding, `stamp', with a string value that
+  describes the Racket version.  The format of this stamp is a date, a
+  SHA1, and a character describing how the information was retrieved:
+
+    "YYYY-MM-DD(SHA1/H)"
+
+  The description is attempted in several ways, with the `H' character
+  indicating how it was actually obtained:
+
+  * "a" -- the date and sha1 information were in the `archive-id' string
+    below, which means that it had that information at the time that
+    `git archive' created an archive out of a git repository.  This is
+    the expected value for nightly builds.
+
+  * "g" -- `archive-id' didn't have information, but we found a git
+    executable and ran it.
+
+  * "d" -- an executable was not found either, but a ".git" directory
+    was found in the usual place, with a "HEAD" file that has eventually
+    lead to a SHA1.  In this case, the time stamp is the stamp of the
+    git reference file that was used.
+
+  * "f" -- none of the above worked, so the last resort was to report
+    the date of this file (which can provide a rough idea how old the
+    tree is, but obviously this can be arbitrary).  In this case the
+    SHA1 is missing and will be "-".
+
+|#
+
 (define archive-id "$Format:%ct|%h|a$")
 ;; when exported through `git archive', the above becomes something like
 ;; "1273562690|cabd414|a"
@@ -13,25 +44,42 @@
 
 (define stamp
   (let ([rx:secs+id #rx"^([0-9]+)\\|([0-9a-f]+|-)\\|(.*?)[ \r\n]*$"])
-    (for*/or ([x (list
-                  ;; info from an archive (incl. nightly builds)
-                  (lambda () archive-id)
-                  ;; try to run git to get the current info
-                  (lambda ()
-                    (let ([exe (or (find-executable-path "git")
-                                   (find-executable-path "git.exe"))])
-                      (and exe
-                           (let ([out (open-output-string)])
-                             (parameterize ([current-output-port out]
-                                            [current-error-port out]
-                                            [current-directory this-dir])
-                               (system* exe "log" "-1"
-                                        "--pretty=format:%ct|%h|g")
-                               (get-output-string out))))))
-                  ;; fallback: get the date of this file, no id
-                  (lambda ()
-                    (format "~a|-|f"
-                            (file-or-directory-modify-seconds this-file))))])
+    ;; info from an archive (incl. nightly builds)
+    (define (from-archive-id) archive-id)
+    ;; try to run git to get the current info
+    (define (from-running-git)
+      (let ([exe (or (find-executable-path "git")
+                     (find-executable-path "git.exe")
+                     (and (eq? 'macosx (system-type))
+                          (find-executable-path "/opt/local/bin/git")))])
+        (and exe (let ([out (open-output-string)])
+                   (parameterize ([current-output-port out]
+                                  [current-error-port out]
+                                  [current-directory this-dir])
+                     (system* exe "log" "-1" "--pretty=format:%ct|%h|g")
+                     (get-output-string out))))))
+    ;; try to find a ".git" directory (can't run git, so conventional
+    ;; guess) and use the sha1 from that file and its date
+    (define (from-git-dir)
+      (define git-dir (build-path this-dir 'up 'up ".git"))
+      (let loop ([file (build-path git-dir "HEAD")])
+        (let ([l (and (file-exists? file)
+                      (call-with-input-file file read-line))])
+          (cond [(not l) #f]
+                [(regexp-match #rx"^ref: +(.*)$" l)
+                 => (lambda (m)
+                      (loop (build-path git-dir (cadr m))))]
+                [(regexp-match #px"^[[:xdigit:]]{40}$" l)
+                 (format "~a|~a|d"
+                         (file-or-directory-modify-seconds file)
+                         (substring l 0 8))]))))
+    ;; fallback: get the date of this file, no id
+    (define (from-this-file)
+      (format "~a|-|f" (file-or-directory-modify-seconds this-file)))
+    (for*/or ([x (list from-archive-id
+                       from-running-git
+                       from-git-dir
+                       from-this-file)])
       (let* ([x (x)]
              [m (and (string? x) (regexp-match rx:secs+id x))]
              [d (and m (seconds->date (string->number (cadr m))))]