GNU bug report logs - #26777
[PATCH] guix: git: Add new module.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 26777 in the body.
You can then email your comments to 26777 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <m.othacehe <at> gmail.com>
To: guix-patches <at> gnu.org
Cc: Mathieu Othacehe <m.othacehe <at> gmail.com>
Subject: [PATCH] guix: git: Add new module.
Date: Thu,  4 May 2017 16:49:44 +0200

* guix/git.scm: New file.
* configure.ac: Check for (guile git).
* Makefile.am: Build guix/git.scm if (guile git) is available.
---
 Makefile.am  |   7 +++
 configure.ac |   4 ++
 guix/git.scm | 140 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 151 insertions(+)
 create mode 100644 guix/git.scm

diff --git a/Makefile.am b/Makefile.am
index c6d8de68b..67491a11a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -197,6 +197,13 @@ MODULES +=					\
 
 endif HAVE_GUILE_SSH
 
+if HAVE_GUILE_GIT
+
+MODULES +=					\
+  guix/git.scm
+
+endif HAVE_GUILE_GIT
+
 if BUILD_DAEMON_OFFLOAD
 
 MODULES +=					\
diff --git a/configure.ac b/configure.ac
index 2b4620c44..2f6eff128 100644
--- a/configure.ac
+++ b/configure.ac
@@ -102,6 +102,10 @@ dnl Guile-JSON is used in various places.
 GUILE_MODULE_AVAILABLE([have_guile_json], [(json)])
 AM_CONDITIONAL([HAVE_GUILE_JSON], [test "x$have_guile_json" = "xyes"])
 
+dnl Check for Guile-Git.
+GUILE_MODULE_AVAILABLE([have_guile_git], [(git)])
+AM_CONDITIONAL([HAVE_GUILE_GIT], [test "x$have_guile_git" = "xyes"])
+
 dnl Make sure we have a full-fledged Guile.
 GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])
 
diff --git a/guix/git.scm b/guix/git.scm
new file mode 100644
index 000000000..b6bc00838
--- /dev/null
+++ b/guix/git.scm
@@ -0,0 +1,140 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix git)
+  #:use-module (git)
+  #:use-module (git object)
+  #:use-module (guix base32)
+  #:use-module (guix hash)
+  #:use-module (guix build utils)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (%repository-cache-path
+            latest-repository-commit))
+
+(define %repository-cache-path
+  (make-parameter "/var/cache/guix/checkouts"))
+
+(define-syntax-rule (with-libgit2 thunk ...)
+  (dynamic-wind
+    (lambda ()
+      (libgit2-init!))
+    (lambda ()
+      thunk ...)
+    (lambda ()
+      (libgit2-shutdown))))
+
+(define (repository-cache-directory url)
+  "Return the directory associated to URL in %repository-cache-path."
+  (string-append
+   (%repository-cache-path) "/"
+   (bytevector->base32-string (sha256 (string->utf8 url)))))
+
+(define (clone-with-error-handling url path)
+  "Clone git repository at URL into PATH with error handling."
+  (catch 'git-error
+    (lambda ()
+      (mkdir-p path)
+      (clone url path))
+    (lambda (key . parameters)
+      (rmdir path)
+      (error "Clone error: " parameters))))
+
+(define (repository->head-sha1 repo)
+  "Return the sha1 of the HEAD commit in REPOSITORY as a string."
+  (let ((oid (reference-target (repository-head repo))))
+    (oid->string (commit-id (commit-lookup repo oid)))))
+
+(define (url+commit->name url sha1)
+  "Return the string \"<REPO-NAME>-<SHA1:7>\" where REPO-NAME is the name of
+the git repository, extracted from URL and SHA1:7 the seven first digits
+of SHA1 string."
+  (string-append
+   (string-replace-substring
+    (last (string-split url #\/)) ".git" "")
+   "-" (string-take sha1 7)))
+
+(define* (copy-to-store cache-path #:key url repository)
+  "Copy items in cache-path to store.  URL and REPOSITORY are used
+to forge store directory name."
+  (let* ((commit (repository->head-sha1 repository))
+         (name   (url+commit->name url commit)))
+    (with-store store
+      (values (add-to-store store name #t "sha256" cache-path) commit))))
+
+(define (switch-to-ref repository ref)
+  "Switch to REPOSITORY's branch, commit or tag specified by REF."
+  (let* ((oid (match ref
+                (('branch . branch)
+                 (reference-target
+                  (branch-lookup repository branch BRANCH-REMOTE)))
+                (('commit . commit)
+                 (string->oid commit))
+                (('tag    . tag)
+                 (reference-name->oid repository
+                                      (string-append "refs/tags/" tag)))))
+         (obj (object-lookup repository oid)))
+    ;; guile-git checkout binding seems broken.
+    (reset repository obj RESET_HARD)))
+
+(define (switch-to-ref* repository ref)
+  "Switch to REF in REPOSITORY with error handling."
+  (catch 'git-error
+    (lambda ()
+      (switch-to-ref repository ref))
+    (lambda (key . parameters)
+      (error
+       (format #f "Failed to switch to ref ~s: ~s" ref parameters)))))
+
+(define (remote-fetch* repository remote-name)
+  "Fetch REMOTE-NAME of REPOSITORY with error handling."
+  (catch 'git-error
+    (lambda ()
+      (remote-fetch (remote-lookup repository remote-name)))
+    (lambda (key . parameters)
+      (error
+       (format #f "Failed to fetch remote ~a: ~a" remote-name parameters)))))
+
+(define* (latest-repository-commit url
+                                   #:key
+                                   (ref '(branch . "origin/master")))
+  "Return two values: the content of the git repository at URL copied into a
+store directory and the sha1 of the top level commit in this directory.  The
+reference to be checkout, once the repository is fetched, is specified by REF.
+REF is pair whose key is [branch | commit | tag] and value the associated
+data, respectively [<branch name> | <sha1> | <tag name>].
+
+Git repositories are kept in the cache directory specified by
+%repository-cache-path parameter."
+  (with-libgit2
+   (let* ((cache-dir     (repository-cache-directory url))
+          (cache-exists? (openable-repository? cache-dir))
+          (repository    (if cache-exists?
+                             (repository-open cache-dir)
+                             (clone-with-error-handling url cache-dir))))
+     ;; Only fetch remote if it has not been cloned just before.
+     (when cache-exists?
+       (remote-fetch* repository "origin"))
+
+     (switch-to-ref* repository ref)
+     (copy-to-store cache-dir
+                    #:url url
+                    #:repository repository))))
-- 
2.12.2

Message #8 received at 26777 <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: Mathieu Othacehe <m.othacehe <at> gmail.com>
Cc: 26777 <at> debbugs.gnu.org
Subject: Re: bug#26777: [PATCH] guix: git: Add new module.
Date: Thu, 04 May 2017 17:59:35 +0200

Hi!

Mathieu Othacehe <m.othacehe <at> gmail.com> skribis:

> * guix/git.scm: New file.
> * configure.ac: Check for (guile git).
> * Makefile.am: Build guix/git.scm if (guile git) is available.

Very nice!

> +(define %repository-cache-path
> +  (make-parameter "/var/cache/guix/checkouts"))

s/path/directory/ (In GNU the convention is to use the terms “file name”
or “directory name”, or just “file” or “directory” (info "(standards)
GNU Manuals").)

> +(define (repository-cache-directory url)
> +  "Return the directory associated to URL in %repository-cache-path."
> +  (string-append
> +   (%repository-cache-path) "/"
> +   (bytevector->base32-string (sha256 (string->utf8 url)))))

This is a detail, but in general, for arguments like the cache
directory, I prefer an optional argument like this:

  (define* (repository-cache-directory url
                                       #:optional (cache-directory
                                                   (%repository-cache-directory)))
    …)

> +(define (clone-with-error-handling url path)
> +  "Clone git repository at URL into PATH with error handling."
> +  (catch 'git-error
> +    (lambda ()
> +      (mkdir-p path)
> +      (clone url path))

s/path/directory/

> +    (lambda (key . parameters)
> +      (rmdir path)
> +      (error "Clone error: " parameters))))

Just let the ‘git-error’ through: it’s the caller’s responsibility to
handle it.  Same in other procedures that catch ‘git-error’.

If really necessary, you can add:

  (define-syntax-rule (false-if-git-error exp)
    (catch 'git-error
      (lambda () exp)
      (const #f)))

> +(define* (copy-to-store cache-path #:key url repository)
> +  "Copy items in cache-path to store.  URL and REPOSITORY are used
> +to forge store directory name."
> +  (let* ((commit (repository->head-sha1 repository))
> +         (name   (url+commit->name url commit)))
> +    (with-store store
> +      (values (add-to-store store name #t "sha256" cache-path) commit))))

Please make ‘store’ a parameter, so that the caller can choose what
store they connect to.

Could you send an updated patch?

Thank you!

Ludo’.

Message #11 received at 26777 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <m.othacehe <at> gmail.com>
To: 26777 <at> debbugs.gnu.org
Cc: Mathieu Othacehe <m.othacehe <at> gmail.com>
Subject: [PATCH] guix: git: Add new module.
Date: Fri,  5 May 2017 11:04:01 +0200

* guix/git.scm: New file.
* configure.ac: Check for (guile git).
* Makefile.am: Build guix/git.scm if (guile git) is available.
---
 Makefile.am  |   7 ++++
 configure.ac |   4 ++
 guix/git.scm | 122 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 133 insertions(+)
 create mode 100644 guix/git.scm

diff --git a/Makefile.am b/Makefile.am
index 8fe9e350c..76e5d99c7 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -197,6 +197,13 @@ MODULES +=					\
 
 endif HAVE_GUILE_SSH
 
+if HAVE_GUILE_GIT
+
+MODULES +=					\
+  guix/git.scm
+
+endif HAVE_GUILE_GIT
+
 if BUILD_DAEMON_OFFLOAD
 
 MODULES +=					\
diff --git a/configure.ac b/configure.ac
index dc3d8f377..c937e948d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -104,6 +104,10 @@ dnl Guile-JSON is used in various places.
 GUILE_MODULE_AVAILABLE([have_guile_json], [(json)])
 AM_CONDITIONAL([HAVE_GUILE_JSON], [test "x$have_guile_json" = "xyes"])
 
+dnl Check for Guile-Git.
+GUILE_MODULE_AVAILABLE([have_guile_git], [(git)])
+AM_CONDITIONAL([HAVE_GUILE_GIT], [test "x$have_guile_git" = "xyes"])
+
 dnl Make sure we have a full-fledged Guile.
 GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])
 
diff --git a/guix/git.scm b/guix/git.scm
new file mode 100644
index 000000000..d0c1c51a3
--- /dev/null
+++ b/guix/git.scm
@@ -0,0 +1,122 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix git)
+  #:use-module (git)
+  #:use-module (git object)
+  #:use-module (guix base32)
+  #:use-module (guix hash)
+  #:use-module (guix build utils)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (%repository-cache-directory
+            latest-repository-commit))
+
+(define %repository-cache-directory
+  (make-parameter "/var/cache/guix/checkouts"))
+
+(define-syntax-rule (with-libgit2 thunk ...)
+  (dynamic-wind
+    (lambda ()
+      (libgit2-init!))
+    (lambda ()
+      thunk ...)
+    (lambda ()
+      (libgit2-shutdown))))
+
+(define* (url-cache-directory url
+                              #:optional (cache-directory
+                                          (%repository-cache-directory)))
+  "Return the directory associated to URL in %repository-cache-directory."
+  (string-append
+   cache-directory "/"
+   (bytevector->base32-string (sha256 (string->utf8 url)))))
+
+(define (clone* url directory)
+  "Clone git repository at URL into DIRECTORY.  Upon failure,
+make sure no empty directory is left behind."
+  (with-throw-handler #t
+    (lambda ()
+      (mkdir-p directory)
+      (clone url directory))
+    (lambda _
+      (false-if-exception (rmdir directory)))))
+
+(define (repository->head-sha1 repo)
+  "Return the sha1 of the HEAD commit in REPOSITORY as a string."
+  (let ((oid (reference-target (repository-head repo))))
+    (oid->string (commit-id (commit-lookup repo oid)))))
+
+(define (url+commit->name url sha1)
+  "Return the string \"<REPO-NAME>-<SHA1:7>\" where REPO-NAME is the name of
+the git repository, extracted from URL and SHA1:7 the seven first digits
+of SHA1 string."
+  (string-append
+   (string-replace-substring
+    (last (string-split url #\/)) ".git" "")
+   "-" (string-take sha1 7)))
+
+(define* (copy-to-store cache-directory store #:key url repository)
+  "Copy items in cache-directory to store.  URL and REPOSITORY are used
+to forge store directory name."
+  (let* ((commit (repository->head-sha1 repository))
+         (name   (url+commit->name url commit)))
+    (values (add-to-store store name #t "sha256" cache-directory) commit)))
+
+(define (switch-to-ref repository ref)
+  "Switch to REPOSITORY's branch, commit or tag specified by REF."
+  (let* ((oid (match ref
+                (('branch . branch)
+                 (reference-target
+                  (branch-lookup repository branch BRANCH-REMOTE)))
+                (('commit . commit)
+                 (string->oid commit))
+                (('tag    . tag)
+                 (reference-name->oid repository
+                                      (string-append "refs/tags/" tag)))))
+         (obj (object-lookup repository oid)))
+    ;; guile-git checkout binding seems broken.
+    (reset repository obj RESET_HARD)))
+
+(define* (latest-repository-commit url store
+                                   #:key
+                                   (ref '(branch . "origin/master")))
+  "Return two values: the content of the git repository at URL copied into a
+store directory and the sha1 of the top level commit in this directory.  The
+reference to be checkout, once the repository is fetched, is specified by REF.
+REF is pair whose key is [branch | commit | tag] and value the associated
+data, respectively [<branch name> | <sha1> | <tag name>].
+
+Git repositories are kept in the cache directory specified by
+%repository-cache-directory parameter."
+  (with-libgit2
+   (let* ((cache-dir     (url-cache-directory url))
+          (cache-exists? (openable-repository? cache-dir))
+          (repository    (if cache-exists?
+                             (repository-open cache-dir)
+                             (clone* url cache-dir))))
+     ;; Only fetch remote if it has not been cloned just before.
+     (when cache-exists?
+       (remote-fetch repository "origin"))
+     (switch-to-ref repository ref)
+     (copy-to-store cache-dir store
+                    #:url url
+                    #:repository repository))))
-- 
2.12.2

Message #14 received at 26777 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <m.othacehe <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 26777 <at> debbugs.gnu.org
Subject: Re: bug#26777: [PATCH] guix: git: Add new module.
Date: Fri, 05 May 2017 11:17:52 +0200

Hi Ludo,

> Very nice!

Thanks :)

> Could you send an updated patch?

I just did. I stopped catching git-errors and used a with-throw-handler
to make sure the directory mkdir-ed before cloning is removed if clone
fails. And, unless I'm wrong the git-error should be re-raised.

Mathieu

Message #17 received at 26777 <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: Mathieu Othacehe <m.othacehe <at> gmail.com>
Cc: 26777 <at> debbugs.gnu.org
Subject: Re: bug#26777: [PATCH] guix: git: Add new module.
Date: Fri, 05 May 2017 11:51:09 +0200

Hi!

Mathieu Othacehe <m.othacehe <at> gmail.com> skribis:

> * guix/git.scm: New file.
> * configure.ac: Check for (guile git).
> * Makefile.am: Build guix/git.scm if (guile git) is available.

[...]

> +(define* (copy-to-store cache-directory store #:key url repository)
> +  "Copy items in cache-directory to store.  URL and REPOSITORY are used
> +to forge store directory name."

Could you make ‘store’ the first parameter, as is done elsewhere?

> +(define (switch-to-ref repository ref)
> +  "Switch to REPOSITORY's branch, commit or tag specified by REF."
> +  (let* ((oid (match ref
> +                (('branch . branch)
> +                 (reference-target
> +                  (branch-lookup repository branch BRANCH-REMOTE)))
> +                (('commit . commit)
> +                 (string->oid commit))
> +                (('tag    . tag)
> +                 (reference-name->oid repository
> +                                      (string-append "refs/tags/" tag)))))
> +         (obj (object-lookup repository oid)))
> +    ;; guile-git checkout binding seems broken.
> +    (reset repository obj RESET_HARD)))

Could you add an XXX to this comment and perhaps say why this is broken?
Regardless of brokenness, it sounds safer to always hard-reset the
checkout to make sure we’re in the right state, no?  So maybe you can
even remove the comment.  :-)

> +(define* (latest-repository-commit url store
> +                                   #:key
> +                                   (ref '(branch . "origin/master")))
> +  "Return two values: the content of the git repository at URL copied into a
> +store directory and the sha1 of the top level commit in this directory.  The
> +reference to be checkout, once the repository is fetched, is specified by REF.
> +REF is pair whose key is [branch | commit | tag] and value the associated
> +data, respectively [<branch name> | <sha1> | <tag name>].

Please make ‘store’ the first argument, and add

  #:key (cache-directory (%repository-cache-directory))

OK for ‘master’ with changes along these lines.

Thank you!

Ludo’.

Message #20 received at 26777 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <m.othacehe <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 26777 <at> debbugs.gnu.org
Subject: Re: bug#26777: [PATCH] guix: git: Add new module.
Date: Fri, 05 May 2017 19:54:59 +0200

> Could you add an XXX to this comment and perhaps say why this is broken?
> Regardless of brokenness, it sounds safer to always hard-reset the
> checkout to make sure we’re in the right state, no?  So maybe you can
> even remove the comment.  :-)

I removed it :)

> OK for ‘master’ with changes along these lines.

Pushed as a70b784708fb5e1b78430aa793d89ca04bc641a8.

Thanks,

Mathieu

Message #25 received at 26777-done <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: Mathieu Othacehe <m.othacehe <at> gmail.com>
Cc: 26777-done <at> debbugs.gnu.org
Subject: Re: bug#26777: [PATCH] guix: git: Add new module.
Date: Fri, 05 May 2017 22:19:42 +0200

Mathieu Othacehe <m.othacehe <at> gmail.com> skribis:

>> Could you add an XXX to this comment and perhaps say why this is broken?
>> Regardless of brokenness, it sounds safer to always hard-reset the
>> checkout to make sure we’re in the right state, no?  So maybe you can
>> even remove the comment.  :-)
>
> I removed it :)
>
>> OK for ‘master’ with changes along these lines.
>
> Pushed as a70b784708fb5e1b78430aa793d89ca04bc641a8.

Great.  Remember to email NNN-done <at> debbugs.gnu.org when you’re done.
:-)

Thanks,
Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.