From 3e5749fc331243e9d29baa73a569dc6b6de25f33 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Mon, 15 Nov 2021 16:37:17 +0000 Subject: [PATCH] guix: Add download-multi-svn-to-store. * guix/svn-download.scm (download-multi-svn-to-store): New procedure. --- guix/svn-download.scm | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/guix/svn-download.scm b/guix/svn-download.scm index b96151234c..e5fe8f1840 100644 --- a/guix/svn-download.scm +++ b/guix/svn-download.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2016, 2019 Ludovic Courtès ;;; Copyright © 2014 Sree Harsha Totakura -;;; Copyright © 2017, 2019 Ricardo Wurmus +;;; Copyright © 2017, 2019, 2021 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,7 +26,9 @@ (define-module (guix svn-download) #:use-module (guix packages) #:use-module (guix utils) #:use-module ((guix build svn) #:prefix build:) + #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module (ice-9 match) + #:use-module (srfi srfi-1) #:export (svn-reference svn-reference? svn-reference-url @@ -41,7 +43,8 @@ (define-module (guix svn-download) svn-multi-reference-revision svn-multi-reference-locations svn-multi-reference-recursive? - svn-multi-fetch)) + svn-multi-fetch + download-multi-svn-to-store)) ;;; Commentary: ;;; @@ -166,4 +169,28 @@ (define* (download-svn-to-store store ref (add-to-store store name #t "sha256" (string-append temp "/svn"))))))) +(define* (download-multi-svn-to-store store ref + #:optional (name (basename (svn-multi-reference-url ref))) + #:key (log (current-error-port))) + "Download from REF, a object to STORE. Write progress +reports to LOG." + (call-with-temporary-directory + (lambda (temp) + (and (every (lambda (location) + (let ((dir (string-append temp "/" (dirname location)))) + (mkdir-p dir)) + (parameterize ((current-output-port log)) + (build:svn-fetch (string-append (svn-multi-reference-url ref) + "/" location) + (svn-multi-reference-revision ref) + (if (string-suffix? "/" location) + (string-append temp "/" location) + (string-append temp "/" (dirname location))) + #:recursive? + (svn-multi-reference-recursive? ref) + #:user-name (svn-multi-reference-user-name ref) + #:password (svn-multi-reference-password ref)))) + (svn-multi-reference-locations ref)) + (add-to-store store name #t "sha256" temp))))) + ;;; svn-download.scm ends here