CVS snapshot script with diffs

[Maciej Stachowiak <mstachow@mit.edu>]

Here's a version of the cvs snapshot script posted recently to
scwm-discuss, with the following enhancements: uses cvs rdiff to
generate the diffs, which is more efficient than checking out two
versions and diffing the result; and has all the configuration options
as defines right at the top of the file, so it should be easy to adapt
to other maintaners' snapshot needs. I'm also uploading a copy to the
contrib archive on ftp.red-bean.com, but I don't know when it will
appear there. I considered making the adjustable parameters be
command-line arguments, but there's so many that it didn't seem
worthwhile.

---------------------
#!/usr/local/bin/guile -s
!#

;;;; adjustable settings:

;; timestamp to be checked out of the repo by the snapshot script;
;; reccomended to be the cron job time or shortly thereafter.
(define snapshot-time "03:00:00")
;; repository root
(define repository "/u1/repository")
;; ftp directory
(define ftpdir "/home/ftp/pub/scwm")
;; temp directory to use
(define tmpdir "/tmp")
;; modules to make snapshots of
(define snap-modules '("scwm" "scwm-icons"))
;; modules to make diffs of
(define diff-modules '("scwm"))
;; max number of snapshots to keep around
(define snap-max-number 1)
;; max number of diffs to keep around
(define diff-max-number 7)

;; create a YYYYMMDD string
(define (stamp-tar timestamp)
  (strftime "%Y%m%d" (localtime timestamp)))

;; arbitrary cvs time stamp, choose a meaningful (should be between
;; hack sessions generally)
(define (stamp-cvs timestamp)
  (string-append (strftime "%Y-%m-%d " (localtime timestamp))
	snapshot-time))

(define (days-before timestamp number)
  (- timestamp (* number 24 60 60)))

;; create a NAME-YYYYMMDD string
(define (snap-name name timestamp)
  (string-append name "-" (stamp-tar timestamp)))

;; export a module from the repository
(define (cvsexport cvsroot name date)
  (let* ((rep-spec (string-append "-d " cvsroot))
	 (date-spec (string-append "-D " "'" date "'")))
    (system (string-append "cvs " rep-spec " export " date-spec " " name))))

;; build a NAME-YYYYMMDD directory
(define (cvssnapshot cvsroot name timestamp)
  (let* ((dirname (snap-name name timestamp)))
    (cvsexport cvsroot name (stamp-cvs timestamp))
    (system (string-append "mv " name " " dirname))))

;; build a package-YYYYMMDD.tgz from a NAME-YYYYMMDD directory
(define (buildtgz name timestamp)
  (let* ((dirname (snap-name name timestamp)))
  (system (string-append "tar czf " dirname ".tar.gz " dirname))))

;; rdiff a module from the repository
(define (cvsrdiff cvsroot name date-1 date-2 target)
  (let* ((rep-spec (string-append "-d " cvsroot))
	 (date-1-spec (string-append "-D " "'" date-1 "'"))
	 (date-2-spec (string-append "-D " "'" date-2 "'")))
    (system (string-append "cvs " rep-spec " rdiff " date-1-spec " "
			   date-2-spec " " name " >" target))))

(define (cvssnapdiff cvsroot name timestamp-1 timestamp-2)
  (let* ((diffname (string-append (snap-name name timestamp-2) ".diff")))
    (cvsrdiff cvsroot name (stamp-cvs timestamp-1) (stamp-cvs timestamp-2)
	      diffname)
    (system (string-append "gzip -9 " diffname))))

(let*
    ((now (current-time))
     (cvsroot repository)

     (yesterday (days-before now 1))
     (snap-delete-age (days-before now snap-max-number))
     (diff-delete-age (days-before now diff-max-number))

     ;; make it a bit more random later..
     (lockdir "make-snap-TMP"))

  (chdir tmpdir)

  ;; remove possibly old files
  (system (string-append "rm -rvf " lockdir))

  (mkdir lockdir)
  ;; race, check result
  (chdir lockdir)

  ;; create the current snapshots
  (map (lambda (module)
	 (cvssnapshot cvsroot module now)
	 (buildtgz module now))
       snap-modules)

  ;; create the diff files
  (map (lambda (module)
	 (cvssnapdiff cvsroot module yesterday now))
       diff-modules)
  
  ;; move snaps over
  (map (lambda (module)
	 (system (string-append "mv -f " (snap-name module now) ".tar.gz " 
				ftpdir)))
       snap-modules)
  
  ;; move diffs over
  (map (lambda (module)
	 (system (string-append "mv -f " (snap-name module now) ".diff.gz " 
				ftpdir)))
       diff-modules)

  ;; clean up old files
  (chdir ftpdir)

  ;; reposition symlinks with -f
  (map (lambda (module) 
	 (system (string-append
		  "ln -sf "
		  (snap-name module now) ".tar.gz " module "-snap.tar.gz")))
       snap-modules)

  ;; delete last snapshot files
  (map (lambda (module)
	 (catch #t (lambda ()
		     (system (string-append "rm -f"
	   " " (snap-name module snap-delete-age) ".tar.gz")))
		(lambda args args)))
       snap-modules)

  ;; delete diff older than a week
  (map (lambda (module)
	 (catch #t (lambda ()
		     (system (string-append "rm -f"
	   " " (snap-name module diff-delete-age) ".diff.gz" )))
		(lambda args args)))
       snap-modules)

  ;; clean up
  (chdir tmpdir)
  (system (string-append "rm -rf " lockdir))
  
  (exit))