ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

refresh: Allow updating to a specific version.

Browse source 
* guix/scripts/refresh.scm (options->packages)[args-packages]: Handle version
  specification in package name arguments.
  (update-package): Add #:version argument and pass it on to called functions.
  (guix-refresh): When updating, pass the specified version (if any) to
  update-package.
  [package-list-without-versions, package-list-with-versions]: New functions.
This commit is contained in:
Hartmut Goebel 2022-06-24 20:40:57 +02:00
parent b82eb8d67a
commit 8aeccc6240
No known key found for this signature in database
GPG key ID: 634A8DFFD3F631DF
1 changed files with 37 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
guix/scripts/refresh.scm
View file

@ -9,6 +9,7 @@
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -46,6 +47,7 @@ (define-module (guix scripts refresh)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-37) #:use-module (srfi srfi-37)
#:use-module (srfi srfi-71) #:use-module (srfi srfi-71)
@ -181,7 +183,7 @@ (define (show-help)
(newline) (newline)
(show-bug-report-information)) (show-bug-report-information))
(define (options->packages opts) (define (options->update-specs opts)
"Return the list of packages requested by OPTS, honoring options like "Return the list of packages requested by OPTS, honoring options like
'--recursive'." '--recursive'."
(define core-package? (define core-package?
@ -224,7 +226,7 @@ (define args-packages
(('argument . spec) (('argument . spec)
;; Take either the specified version or the ;; Take either the specified version or the
;; latest one. ;; latest one.
(specification->package spec)) (update-specification->update-spec spec))
(('expression . exp) (('expression . exp)
(read/eval-package-expression exp)) (read/eval-package-expression exp))
(_ #f)) (_ #f))
@ -254,6 +256,25 @@ (define packages
(with-monad %store-monad (with-monad %store-monad
(return packages)))) (return packages))))
;;;
;;; Utilities.
;;;
(define-record-type <update-spec>
(update-spec package version)
update?
(package update-spec-package)
(version update-spec-version))
(define (update-specification->update-spec spec)
"Given SPEC, a package name like \"guile@2.0=2.0.8\", return a <update>
record with two fields: the package to upgrade, and the target version."
(match (string-rindex spec #\=)
(#f (update-spec (specification->package spec) #f))
(idx (update-spec (specification->package (substring spec 0 idx))
(substring spec (1+ idx))))))
;;; ;;;
;;; Updates. ;;; Updates.
@ -298,7 +319,7 @@ (define (warn-no-updater package)
(G_ "no updater for ~a~%") (G_ "no updater for ~a~%")
(package-name package))) (package-name package)))
(define* (update-package store package updaters (define* (update-package store package version updaters
#:key (key-download 'interactive) warn?) #:key (key-download 'interactive) warn?)
"Update the source file that defines PACKAGE with the new version. "Update the source file that defines PACKAGE with the new version.
KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
@ -307,7 +328,7 @@ (define* (update-package store package updaters
(if (lookup-updater package updaters) (if (lookup-updater package updaters)
(let ((version output source (let ((version output source
(package-update store package updaters (package-update store package updaters
#:key-download key-download)) #:key-download key-download #:version version))
(loc (or (package-field-location package 'version) (loc (or (package-field-location package 'version)
(package-location package)))) (package-location package))))
(when version (when version
@ -540,12 +561,12 @@ (define (options->updaters opts)
(with-error-handling (with-error-handling
(with-store store (with-store store
(run-with-store store (run-with-store store
(mlet %store-monad ((packages (options->packages opts))) (mlet %store-monad ((update-specs (options->update-specs opts)))
(cond (cond
(list-dependent? (list-dependent?
(list-dependents packages)) (list-dependents (map update-spec-package update-specs)))
(list-transitive? (list-transitive?
(list-transitive packages)) (list-transitive (map update-spec-package update-specs)))
(update? (update?
(parameterize ((%openpgp-key-server (parameterize ((%openpgp-key-server
(or (assoc-ref opts 'key-server) (or (assoc-ref opts 'key-server)
@ -558,13 +579,17 @@ (define (options->updaters opts)
(string-append (config-directory) (string-append (config-directory)
"/upstream/trustedkeys.kbx")))) "/upstream/trustedkeys.kbx"))))
(for-each (for-each
(cut update-package store <> updaters (lambda (update)
#:key-download key-download (update-package store
#:warn? warn?) (update-spec-package update)
packages) (update-spec-version update)
updaters
#:key-download key-download
#:warn? warn?))
update-specs)
(return #t))) (return #t)))
(else (else
(for-each (cut check-for-package-update <> updaters (for-each (cut check-for-package-update <> updaters
#:warn? warn?) #:warn? warn?)
packages) (map update-spec-package update-specs))
(return #t))))))))) (return #t)))))))))