Darcs Cvs Sync

Using darcs to work offline with a CVS repository and making scsh do the tedious synchronization work

Consider the following situation: Some project is managed using a remote CVS repository. One of the developer is on the road to a some no-wlan-in-reach-country, however, he has lots of time to do some hacking. Committing the patches to the CVS repository is not possible, because there is no Internet access available. Committing one big patch after returning is rather unattractive because this mingles several independent patches together.

That's pretty much the situation Martin and I found ourselves during the IFL in Dublin. No access to Commander S's CVS repository but time to hack. So here is what we did: We took the latest CVS checkout of Commander S, sat up a darcs repository, and committed our patches to this repository. However, committing the patches stored in the darcs repository manually back into CVS seemed is quite time-consuming: Check out a patch from the darcs repository (using darcs diff), apply it to a CVS working copy, and finally committing the change to CVS (don't forget to copy the darcs log message...). Annoying.

Not if crucial parts of this work are done using a scsh script. Here's the code I used:

  ;; ,open srfi-23

  (define make-patch-info cons)
  (define patch-info-name car)
  (define patch-info-user/date cdr)

  (define (quote-patch-name name)
    (let ((s1 (regexp-substitute/global #f (rx "(") name
                                        'pre "\\(" 'post)))
      (regexp-substitute/global #f (rx ")") s1
                                'pre "\\)" 'post)))

  (define (read-darcs-changelog port)
    (let lp ((line (read-line port)) (patch-names '()))
      (cond
       ((eof-object? line)
        patch-names)
       ((read-date/user-line line)
        => (lambda (maybe-date/user)
             (write (list 'maybe-date/user maybe-date/user))
             (newline)
             (let ((next-line (read-line port)))
               (cond
                ((read-patch-name-line next-line)
                 => (lambda (patch-name)
                      (write (list 'patch-name patch-name))
                      (newline)
                      (lp (read-line port)
                          (cons (make-patch-info patch-name maybe-date/user)
                                patch-names))))
                (else
                 (error "error reading ChangeLog file" port))))))
       (else
        (lp (read-line port) patch-names)))))

  (define (read-patch-name-line line)
    (if-match 
     (regexp-search (rx (: "  * " (submatch (+ (~ #\newline)))))
                    line)
     (whole patch-name)
     patch-name
     #f))

  (define (read-date/user-line line)
    (if-match
     (regexp-search (rx (: bos (submatch alphabetic (+ (~ #\newline)))))
                    line)
     (whole date/user)
     date/user
     #f))

  (define (get-list-of-patch-infos dir)
    (with-cwd dir
      (receive (port proc)
          (run/port+proc ("darcs" "changes"))
        (let ((patches (read-darcs-changelog port)))
          (cond 
           ((zero? (wait proc))
            (close-input-port port)
            patches)
           (else 
            (error "error getting list of patches")))))))

  (define (extract-patch patch-info rep-dir)
    (let ((patch-name (patch-info-name patch-info)))
      (with-cwd rep-dir
        (receive (port proc)
            (run/port+proc ("darcs" "diff" "-u" "-p" 
                            ,(quote-patch-name patch-name)))
          (let ((string (port->string port))
                (status (wait proc)))
            (close-input-port port)
            (if (zero? status)
                string
                (error "error extracting patch")))))))

  (define (apply-patch patch dest-dir)
    (with-cwd dest-dir
      (or (zero? (run ("patch" "-p1") (<< ,patch)))
          (error "error applying patch"))))

  (define (extract-and-apply-patch patch rep-dir dest-dir)
    (apply-patch (extract-patch patch rep-dir) dest-dir))

  (define (cvs-commit-patch patch-info dest-dir)
    (let ((message (prepare-commit-message patch-info)))
      (with-cwd dest-dir
        (or (zero? (run ("cvs" "commit" "-m" ,message)))
            (error "error committing patch to CVS")))))

  (define (prepare-commit-message patch-info)
    (string-append 
     (patch-info-name patch-info)
     "\n\n"
     "part of darcs patch " (patch-info-user/date patch-info)))

  (define (apply-and-commit-patches patch-infos rep-dir dest-dir)
    (let ((i 0))
      (for-each 
       (lambda (patch-info)
         (let ((patch (extract-patch patch-info rep-dir)))
           (write (list "Extracted patch #" i))
           (newline)
           (apply-patch patch dest-dir)
           (write (list "Applied patch #" i))
           (newline)
           (cvs-commit-patch patch-info dest-dir))
         (set! i (+ i 1)))
       patch-infos)))

In this code get-list-of-patch-infos reads the output of darcs changes to get a list of all patches in the repository. (I discovered the option that makes darcs export the list of patches as XML a bit too late...) The information is returned is called a patch-info. Extract-patch runs darcs diff to extract the patch identified by a patch-info. This patch may be applied to the CVS repository using apply-patch and committed using cvs-commit-patch.

However, this code has some shortcomings: it assumes that the patches do not add or remove files to the repository, but only change existing files. I think it's easy to solve the problems because darcs diff --summary lists all files that have been added, removed or modified. This is a note for myself: Eric, next time you have to sync a CVS repository with a darcs repository, add this feature first!

-Eric

DarcsCvsSync - raw wiki source | code snippets archive