(address . guix-patches@gnu.org)(name . Maxim Cournoyer)(address . maxim.cournoyer@gmail.com)
fcbe73907f5ee53dd457e092e1f25b99f1a3b1cf.1729472926.git.maxim.cournoyer@gmail.com
* guix/svn-download.scm (<svn-reference>)
[subdirectories]: New field.
(svn-fetch): Set "svn subdirectories" environment variable when subdirectories
are provided.
(svn-fetch-builder): Pass subdirectories to svn-fetch.
* guix/build/svn.scm (svn-fetch) [subdirectories]: New keyword argument.
Implement alternative code path when it's provided.
* doc/guix.texi (svn-reference): Document the new field.
Change-Id: I21ca96bc48d26dafca82b26daccef0d324f79dc5
---
Note: At first I was planning to use this to checkout exactly one
subdirectory of a game data SVN repository, but later I realized SVN
allows for checking out any subdirectory, which made this addition
unnecessary.
I guess it could still be useful when wanting to select more than one
subdirectory, but the perhaps svn-multi-fetch could be used instead,
to combine multiple SVN checkouts into one (IIUC).
Anyway, I'm sending this to guix-devel; if anyone find it useful it
could be considered for guix-patches.
doc/guix.texi | 3 ++
guix/build/svn.scm | 74 ++++++++++++++++++++++++++++---------------
guix/svn-download.scm | 20 +++++++++---
3 files changed, 68 insertions(+), 29 deletions(-)
Toggle diff (201 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index b9f71527a3..2d1e5bdd2c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8312,6 +8312,9 @@ origin Reference
@item @code{password} (default: @code{#f})
Password to access the Subversion repository, if required.
+
+@item @code{subdirectories} (default: @code{#f})
+Only recurse into subdirectories, resulting in a partial checkout.
@end table
@end deftp
diff --git a/guix/build/svn.scm b/guix/build/svn.scm
index 875d3c50ca..1b1c9b1b5c 100644
--- a/guix/build/svn.scm
+++ b/guix/build/svn.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,6 +22,9 @@
(define-module (guix build svn)
#:use-module (guix build utils)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:export (svn-fetch))
@@ -33,35 +37,55 @@ (define-module (guix build svn)
(define* (svn-fetch url revision directory
#:key (svn-command "svn")
- (recursive? #t)
- (user-name #f)
- (password #f))
+ recursive?
+ user-name
+ password
+ subdirectories)
"Fetch REVISION from URL into DIRECTORY. REVISION must be an integer, and a
-valid Subversion revision. Return #t on success, #f otherwise."
+valid Subversion revision. If SUBDIRECTORIES is provided, only these
+subdirectories will be fully fetched (partial checkout). Return #t on
+success, #f otherwise."
+ (define base-options
+ `("--non-interactive"
+ ;; Trust the server certificate. This is OK as we
+ ;; verify the checksum later. This can be removed when
+ ;; ca-certificates package is added.
+ "--trust-server-cert"
+ "-r" ,(number->string revision)
+ ,@(if (and user-name password)
+ (list (string-append "--username=" user-name)
+ (string-append "--password=" password))
+ '())
+ ,@(if recursive?
+ '()
+ (list "--ignore-externals"))))
+
(guard (c ((invoke-error? c)
(report-invoke-error c)
#f))
- (apply invoke svn-command
- "export" "--non-interactive"
- ;; Trust the server certificate. This is OK as we
- ;; verify the checksum later. This can be removed when
- ;; ca-certificates package is added.
- "--trust-server-cert" "-r" (number->string revision)
-
- ;; Disable keyword substitutions (keywords are CVS-like strings
- ;; like "$Date$", "$Id$", and so on) for two reasons: (1) some
- ;; expansions depend on the local time zone, and (2) SWH disables
- ;; it in its archive for this very reason.
- "--ignore-keywords"
-
- `(,@(if (and user-name password)
- (list (string-append "--username=" user-name)
- (string-append "--password=" password))
- '())
- ,@(if recursive?
- '()
- (list "--ignore-externals"))
- ,url ,directory))
+ (match subdirectories
+ (#f
+ (apply invoke svn-command "export"
+ (append base-options
+ `(;; Disable keyword substitutions (keywords are CVS-like strings
+ ;; like "$Date$", "$Id$", and so on) for two reasons: (1) some
+ ;; expansions depend on the local time zone, and (2) SWH disables
+ ;; it in its archive for this very reason.
+ "--ignore-keywords"
+ ,url ,directory))))
+ (_
+ (apply invoke svn-command "checkout"
+ (append base-options
+ `(,@(if subdirectories
+ (list "--depth" "immediates")
+ '())
+ ,url ,directory)))
+ (with-directory-excursion directory
+ (apply invoke svn-command "update"
+ (append base-options
+ (append-map (cut list "--set-depth" "infinity" <>)
+ subdirectories)))
+ (delete-file-recursively ".svn"))))
#t))
;;; svn.scm ends here
diff --git a/guix/svn-download.scm b/guix/svn-download.scm
index b20cdc79d1..e263498f30 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2014-2016, 2019, 2021-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2017, 2019, 2021 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -35,6 +36,7 @@ (define-module (guix svn-download)
svn-reference?
svn-reference-url
svn-reference-revision
+ svn-reference-subdirectories
svn-reference-recursive?
svn-reference-user-name
svn-reference-password
@@ -65,6 +67,8 @@ (define-record-type* <svn-reference>
svn-reference?
(url svn-reference-url) ; string
(revision svn-reference-revision) ; number
+ (subdirectories svn-reference-subdirectories ;list or #f
+ (default #f))
(recursive? svn-reference-recursive? (default #f))
(user-name svn-reference-user-name (default #f))
(password svn-reference-password (default #f)))
@@ -84,7 +88,7 @@ (define (svn-fetch-builder svn hash-algo)
(define guile-gnutls
(module-ref (resolve-interface '(gnu packages tls)) 'guile-gnutls))
- (define tar+gzip ;for (guix swh)
+ (define tar+gzip ;for (guix swh)
(list (module-ref (resolve-interface '(gnu packages compression))
'gzip)
(module-ref (resolve-interface '(gnu packages base))
@@ -96,7 +100,7 @@ (define (svn-fetch-builder svn hash-algo)
(guix build download-nar)
(guix build utils)
(guix swh)))
- (with-extensions (list guile-json guile-gnutls ;for (guix swh)
+ (with-extensions (list guile-json guile-gnutls ;for (guix swh)
guile-lzlib)
#~(begin
(use-modules (guix build svn)
@@ -105,7 +109,8 @@ (define (svn-fetch-builder svn hash-algo)
(guix build download-nar)
(guix build utils)
(guix swh)
- (ice-9 match))
+ (ice-9 match)
+ (srfi srfi-26))
;; Add tar and gzip to $PATH so
;; 'swh-download-directory-by-nar-hash' can invoke them.
@@ -120,7 +125,9 @@ (define (svn-fetch-builder svn hash-algo)
("yes" #t)
(_ #f))
#:user-name (getenv "svn user name")
- #:password (getenv "svn password")))
+ #:password (getenv "svn password")
+ #:subdirectories (and=> (getenv "svn subdirectories")
+ (cut string-split <> #\:))))
(and (download-method-enabled? 'nar)
(download-nar #$output))
(and (download-method-enabled? 'swh)
@@ -164,6 +171,11 @@ (define* (svn-fetch ref hash-algo hash
`(("svn password"
. ,(svn-reference-password ref)))
'())
+ ,@(if (svn-reference-subdirectories ref)
+ `(("svn subdirectories"
+ . ,(string-join
+ (svn-reference-subdirectories ref) ":")))
+ '())
,@(match (getenv "GUIX_DOWNLOAD_METHODS")
(#f '())
(value
base-commit: 503919fcf01d7eb8d550df5c3993aee9a966ba9b
--
2.46.0