diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm index 4264341d6a..2904c3f94a 100644 --- a/guix/import/minetest.scm +++ b/guix/import/minetest.scm @@ -297,7 +297,7 @@ results. The return value is a list of records." (define (make-minetest-sexp author/name version repository commit inputs home-page synopsis description media-license license) - "Return a S-expression for the minetest package with the given author/NAME, + "Return a S-expression for the minetest package with the given AUTHOR/NAME, VERSION, REPOSITORY, COMMIT, INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, MEDIA-LICENSE and LICENSE." `(package @@ -452,3 +452,37 @@ list of AUTHOR/NAME strings." #:repo->guix-package minetest->guix-package* #:guix-name (compose contentdb->package-name author/name->name))) + +#| +(define (minetest-package? pkg) + (and (string-prefix? "minetest-" (package:package-name pkg)) + (assq-ref (package:package-properties pkg) 'upstream-name))) + +(define (latest-minetest-release pkg) + "Return an for the latest release of the package PKG." + (define upstream-name + (assoc-ref (package:package-properties pkg) 'upstream-name)) + (define contentdb-package (contentdb-fetch upstream-name)) + (define release (latest-release upstream-name)) + (and contentdb-package release + (and-let* ((old-origin (package:package-source pkg)) + (old-reference (package:origin-uri old-origin)) + (is-git? (download:git-reference? old-reference)) + (commit (release-commit release))) + (upstream-source + (package (package:package-name pkg)) + (version (release-title release)) + (urls (download:git-reference + (url (package-repository contentdb-package)) + (commit commit))))))) + +(define %minetest-updater + (upstream-updater + (name 'minetest) + (description "Updater for Minetest packages on ContentDB") + (pred minetest-package?) + (latest latest-minetest-release))) +|# +;; #:use-module (guix upstream) +;; #:use-module ((guix git-download) #:prefix download:) +;; #:use-module ((guix packages) #:prefix package:) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index fb6c52a567..4f3bbbcb94 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -28,8 +28,10 @@ #:use-module (guix ui) #:use-module (gcrypt hash) #:use-module (guix scripts) + #:use-module (guix serialization) #:use-module ((guix scripts build) #:select (%standard-build-options)) #:use-module (guix store) + #:use-module (guix build utils) #:use-module (guix utils) #:use-module (guix packages) #:use-module (guix profiles) @@ -307,6 +309,17 @@ update would trigger a complete rebuild." (G_ "no updater for ~a~%") (package-name package))) + +;; XXX adapted from (guix scripts hash) +(define (file-hash file select? recursive?) + ;; Compute the hash of FILE. + (if recursive? + (let-values (((port get-hash) (open-sha256-port))) + (write-file file port #:select? select?) + (force-output port) + (get-hash)) + (call-with-input-file file port-sha256))) + (define* (update-package store package updaters #:key (key-download 'interactive) warn?) "Update the source file that defines PACKAGE with the new version. @@ -347,8 +360,8 @@ warn about packages that have no matching updater." (package-name package) (upstream-input-change-name change))) (upstream-source-input-changes source)) - (let ((hash (call-with-input-file tarball - port-sha256))) + (let ((hash (file-hash tarball (const #t) + (directory-exists? tarball)))) (update-package-source package source hash))) (warning (G_ "~a: version ~a could not be \ downloaded and authenticated; not updating~%") diff --git a/guix/upstream.scm b/guix/upstream.scm index 632e9ebc4f..61f67b57c1 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -24,6 +24,11 @@ #:use-module (guix discovery) #:use-module ((guix download) #:select (download-to-store url-fetch)) + #:use-module ((guix git-download) + #:select (git-fetch git-reference? + git-reference-url + git-reference-commit + git-reference-recursive?)) #:use-module (guix gnupg) #:use-module (guix packages) #:use-module (guix diagnostics) @@ -33,6 +38,7 @@ #:use-module (guix store) #:use-module ((guix derivations) #:select (built-derivations derivation->output-path)) #:autoload (gcrypt hash) (port-sha256) + #:autoload (guix git) (latest-repository-commit) #:use-module (guix monads) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) @@ -93,7 +99,8 @@ upstream-source? (package upstream-source-package) ;string (version upstream-source-version) ;string - (urls upstream-source-urls) ;list of strings + ; list of strings or a + (urls upstream-source-urls) (signature-urls upstream-source-signature-urls ;#f | list of strings (default #f)) (input-changes upstream-source-input-changes @@ -361,6 +368,11 @@ values: 'interactive' (default), 'always', and 'never'." system target) "Download SOURCE from its first URL and lower it as a fixed-output derivation that would fetch it." + (define url + (match (upstream-source-urls source) + ((first . _) first) + (_ (raise (formatted-message + (G_ "git origins are unsupported by --with-latest")))))) (mlet* %store-monad ((url -> (first (upstream-source-urls source))) (signature -> (and=> (upstream-source-signature-urls source) @@ -430,9 +442,23 @@ SOURCE, an ." #:key-download key-download))) (values version tarball source)))))) +(define* (package-update/git-fetch store package source #:key key-download) + "Return the version, source code directory, and SOURCE, to update PACKAGE to +SOURCE, an ." + (match source + (($ _ version ref _) + (values version + (latest-repository-commit + store + (git-reference-url ref) + #:ref `(commit . ,(git-reference-commit ref)) + #:recursive? (git-reference-recursive? ref)) + source)))) + (define %method-updates ;; Mapping of origin methods to source update procedures. - `((,url-fetch . ,package-update/url-fetch))) + `((,url-fetch . ,package-update/url-fetch) + (,git-fetch . ,package-update/git-fetch))) (define* (package-update store package #:optional (updaters (force %updaters)) @@ -492,9 +518,22 @@ new version string if an update was made, and #f otherwise." (origin-hash (package-source package)))) (old-url (match (origin-uri (package-source package)) ((? string? url) url) + ((? git-reference? ref) + (git-reference-url ref)) (_ #f))) (new-url (match (upstream-source-urls source) - ((first _ ...) first))) + ((first _ ...) first) + ((? git-reference? ref) + (git-reference-url ref)) + (_ #f))) + (old-commit (match (origin-uri (package-source package)) + ((? git-reference? ref) + (git-reference-commit ref)) + (_ #f))) + (new-commit (match (upstream-source-urls source) + ((? git-reference? ref) + (git-reference-commit ref)) + (_ #f))) (file (and=> (location-file loc) (cut search-path %load-path <>)))) (if file @@ -508,6 +547,9 @@ new version string if an update was made, and #f otherwise." 'filename file)) (replacements `((,old-version . ,version) (,old-hash . ,hash) + ,@(if (and old-commit new-commit) + `((,old-commit . ,new-commit)) + '()) ,@(if (and old-url new-url) `((,(dirname old-url) . ,(dirname new-url)))