(address . guix-patches@gnu.org)(name . Simon Tournier)(address . zimon.toutoune@gmail.com)
Reported by Perry, Daniel J <dperry45@gatech.edu>.
* guix/scripts/archive.scm (compatible-option): New procedure.
(%options): Use it.
---
guix/scripts/archive.scm | 23 ++++++++++++++++++++---
1 file changed, 20 insertions(+), 3 deletions(-)
Toggle diff (64 lines)
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 2b5a55a23f..a1b2b73a0f 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -115,6 +116,22 @@ (define %key-generation-parameters
"(genkey (ecdsa (curve Ed25519) (flags rfc6979)))"
"(genkey (rsa (nbits 4:4096)))"))
+(define* (compatible-option result
+ #:optional
+ (actions (list 'authorize 'export 'import)))
+ "Return the RESULT if it is compatible with the list of ACTIONS."
+ (let ((some-actions (fold (lambda (action answers)
+ (if (assoc-ref result action)
+ (cons action answers)
+ answers))
+ '()
+ actions)))
+ (match some-actions
+ ((action)
+ result)
+ ((action other-action _ ...)
+ (leave (G_ "ambiguous options: ~s with ~s~%") action other-action)))))
+
(define %options
;; Specifications of the command-line options.
(cons* (option '(#\h "help") #f #f
@@ -126,13 +143,13 @@ (define %options
(show-version-and-exit "guix archive")))
(option '("export") #f #f
(lambda (opt name arg result)
- (alist-cons 'export #t result)))
+ (compatible-option (alist-cons 'export #t result))))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'export-recursive? #t result)))
(option '("import") #f #f
(lambda (opt name arg result)
- (alist-cons 'import #t result)))
+ (compatible-option (alist-cons 'import #t result))))
(option '("missing") #f #f
(lambda (opt name arg result)
(alist-cons 'missing #t result)))
@@ -158,7 +175,7 @@ (define %options
(error-string err))))))
(option '("authorize") #f #f
(lambda (opt name arg result)
- (alist-cons 'authorize #t result)))
+ (compatible-option (alist-cons 'authorize #t result))))
(option '(#\S "source") #f #f
(lambda (opt name arg result)
base-commit: dcc5c34504c94732c135a85fb4db40ca9796270e
--
2.38.1