From 673afe0384427bc92fa47870e1dfa092e04aec0b Mon Sep 17 00:00:00 2001 Message-Id: <673afe0384427bc92fa47870e1dfa092e04aec0b.1697066456.git.zimon.toutoune@gmail.com> From: Simon Tournier Date: Thu, 12 Oct 2023 01:16:53 +0200 Subject: [PATCH] scripts: archive: Check compatibility of command line options. Fixes . Reported by Perry, Daniel J . * guix/scripts/archive.scm (compatible-option): New procedure. (%options): Use it. --- guix/scripts/archive.scm | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index e32f22ec99..65932ae152 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 ;;; Copyright © 2020 Tobias Geerinckx-Rice +;;; Copyright © 2023 Simon Tournier ;;; ;;; This file is part of GNU Guix. ;;; @@ -115,6 +116,18 @@ (define %key-generation-parameters "(genkey (ecdsa (curve Ed25519) (flags rfc6979)))" "(genkey (rsa (nbits 4:4096)))")) +(define (compatible-option action result other-actions) + "Return the RESULT if ACTION is compatible with the list of OTHER-ACTIONS." + (let ((other-action (fold (lambda (other answer) + (if (assoc-ref result (string->symbol other)) + other + answer)) + #f + other-actions))) + (if other-action + (leave (G_ "ambiguous options: ~s with ~s~%") action other-action) + (alist-cons (string->symbol action) #t result)))) + (define %options ;; Specifications of the command-line options. (cons* (option '(#\h "help") #f #f @@ -126,13 +139,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 "export" result (list "import" "authorize")))) (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 "import" result (list "export" "authorize")))) (option '("missing") #f #f (lambda (opt name arg result) (alist-cons 'missing #t result))) @@ -158,7 +171,7 @@ (define %options (error-string err)))))) (option '("authorize") #f #f (lambda (opt name arg result) - (alist-cons 'authorize #t result))) + (compatible-option "authorize" result (list "import" "export")))) (option '(#\S "source") #f #f (lambda (opt name arg result) base-commit: 0024ef320eed89468369ece3df05064a2afaabd1 -- 2.38.1