mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
Revert "guix: git: Add new module."
This reverts commita70b784708
. Commita70b784708
caused `guix pull` to fail: ERROR: In procedure scm-error: ERROR: no code for module (git)
This commit is contained in:
parent
99c1554c9b
commit
40d728a87d
3 changed files with 0 additions and 134 deletions
|
@ -197,13 +197,6 @@ MODULES += \
|
|||
|
||||
endif HAVE_GUILE_SSH
|
||||
|
||||
if HAVE_GUILE_GIT
|
||||
|
||||
MODULES += \
|
||||
guix/git.scm
|
||||
|
||||
endif HAVE_GUILE_GIT
|
||||
|
||||
if BUILD_DAEMON_OFFLOAD
|
||||
|
||||
MODULES += \
|
||||
|
|
|
@ -104,10 +104,6 @@ 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])
|
||||
|
||||
|
|
123
guix/git.scm
123
guix/git.scm
|
@ -1,123 +0,0 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@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 store cache-directory #: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)))
|
||||
(reset repository obj RESET_HARD)))
|
||||
|
||||
(define* (latest-repository-commit store url
|
||||
#:key
|
||||
(cache-directory
|
||||
(%repository-cache-directory))
|
||||
(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-directory))
|
||||
(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 (remote-lookup repository "origin")))
|
||||
(switch-to-ref repository ref)
|
||||
(copy-to-store store cache-dir
|
||||
#:url url
|
||||
#:repository repository))))
|
Loading…
Reference in a new issue