From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:58961) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dS1ml-0001bx-Lu for guix-patches@gnu.org; Mon, 03 Jul 2017 09:53:09 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dS1mg-0008Kh-Nq for guix-patches@gnu.org; Mon, 03 Jul 2017 09:53:07 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:46871) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dS1mg-0008KR-KD for guix-patches@gnu.org; Mon, 03 Jul 2017 09:53:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dS1mg-0003Ia-EO for guix-patches@gnu.org; Mon, 03 Jul 2017 09:53:02 -0400 Subject: [bug#27550] [PATCH 0/2] cuirass: Prepare (guix git) integration. Resent-Message-ID: References: <20170701150043.14654-1-m.othacehe@gmail.com> <87inj9pvvf.fsf@gnu.org> <868tk5ogwe.fsf@gmail.com> From: Mathieu Othacehe In-reply-to: <868tk5ogwe.fsf@gmail.com> Date: Mon, 03 Jul 2017 15:52:31 +0200 Message-ID: <867ezpocf4.fsf@gmail.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: 27550@debbugs.gnu.org --=-=-= Content-Type: text/plain > Anyway the (guix git) binding is almost ready, I'll send a patch soon. Here it is ! Mathieu --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-base-Use-guix-git-module.patch >From 37d7b68c1e89a2873673613f4781efb6acda529b Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sat, 1 Jul 2017 12:29:59 +0200 Subject: [PATCH] base: Use (guix git) module. * src/cuirass/base.scm (copy-repository-cache) : New procedure. (fetch-repository): Use latest-repository-commit to fetch git repository instead of raw git system commands. (process-specs): Use fetch-repository to get a store directory containing the repository described in SPEC, add copy it to cache with "copy-repository-cache". --- src/cuirass/base.scm | 99 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 57 insertions(+), 42 deletions(-) diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 58f2be3..24b4769 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -24,10 +24,12 @@ #:use-module (guix build utils) #:use-module (guix derivations) #:use-module (guix store) + #:use-module (guix git) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 popen) #:use-module (ice-9 rdelim) + #:use-module (ice-9 receive) #:use-module (srfi srfi-19) #:use-module (srfi srfi-34) #:export (;; Procedures. @@ -77,33 +79,42 @@ values." duration) (acons #:duration duration result))))) -(define (fetch-repository spec) - "Get the latest version of repository specified in SPEC. Clone repository -if required. Return the last commit ID on success, #f otherwise." - (define (current-commit) - (let* ((pipe (open-input-pipe "git log -n1")) - (log (read-string pipe)) - (commit (cadr (string-split log char-set:whitespace)))) - (close-pipe pipe) - commit)) - +(define (fetch-repository store spec) + "Get the latest version of repository specified in SPEC. 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." + + (define (add-origin branch) + "Prefix branch name with origin if no remote is specified." + (if (string-index branch #\/) + branch + (string-append "origin/" branch))) + + (let ((name (assq-ref spec #:name)) + (url (assq-ref spec #:url)) + (branch (and=> (assq-ref spec #:branch) + (lambda (b) + `(branch . ,(add-origin b))))) + (commit (and=> (assq-ref spec #:commit) + (lambda (c) + `(commit . ,c)))) + (tag (and=> (assq-ref spec #:tag) + (lambda (t) + `(tag . ,t))))) + (latest-repository-commit store url + #:cache-directory (%package-cachedir) + #:ref (pk (or branch commit tag))))) + +(define (copy-repository-cache repo spec) + "Copy REPO directory in cache. The directory is named after NAME + field in SPEC." (let ((cachedir (%package-cachedir))) (mkdir-p cachedir) (with-directory-excursion cachedir - (let ((name (assq-ref spec #:name)) - (url (assq-ref spec #:url)) - (branch (assq-ref spec #:branch)) - (commit (assq-ref spec #:commit)) - (tag (assq-ref spec #:tag))) - (and (or (file-exists? name) - (zero? (system* "git" "clone" url name))) - (with-directory-excursion name - (and (zero? (system* "git" "fetch")) - (zero? (system* "git" "reset" "--hard" - (or tag - commit - (string-append "origin/" branch)))) - (current-commit)))))))) + (let ((name (assq-ref spec #:name))) + ;; Flush any directory with the same name. + (false-if-exception (delete-file-recursively name)) + (copy-recursively repo name))))) (define (compile dir) ;; Required for fetching Guix bootstrap tarballs. @@ -127,6 +138,7 @@ if required. Return the last commit ID on success, #f otherwise." (%package-database))) (jobs (read port))) (close-pipe port) + ;; XXX: test if jobs is consistent. jobs)) (define (build-packages store db jobs) @@ -171,24 +183,27 @@ if required. Return the last commit ID on success, #f otherwise." (define (process-specs db jobspecs) "Evaluate and build JOBSPECS and store results in DB." (define (process spec) - (let ((commit (fetch-repository spec)) - (stamp (db-get-stamp db spec))) - (when commit - (unless (string=? commit stamp) - (unless (assq-ref spec #:no-compile?) - (compile (string-append (%package-cachedir) "/" - (assq-ref spec #:name)))) - (with-store store - ;; Always set #:keep-going? so we don't stop on the first build - ;; failure. - (set-build-options store - #:use-substitutes? (%use-substitutes?) - #:keep-going? #t) - - (let* ((spec* (acons #:current-commit commit spec)) - (jobs (evaluate store db spec*))) - (build-packages store db jobs)))) - (db-add-stamp db spec commit)))) + (with-store store + (let ((stamp (db-get-stamp db spec))) + (receive (store-dir commit) + (fetch-repository store spec) + (when commit + (unless (string=? commit stamp) + (copy-repository-cache store-dir spec) + + (unless (assq-ref spec #:no-compile?) + (compile (string-append (%package-cachedir) "/" + (assq-ref spec #:name)))) + ;; Always set #:keep-going? so we don't stop on the first build + ;; failure. + (set-build-options store + #:use-substitutes? (%use-substitutes?) + #:keep-going? #t) + + (let* ((spec* (acons #:current-commit commit spec)) + (jobs (evaluate store db spec*))) + (build-packages store db jobs))) + (db-add-stamp db spec commit)))))) (for-each process jobspecs)) -- 2.13.1 --=-=-=--