diff options
Diffstat (limited to 'guix/gnu-maintenance.scm')
| -rw-r--r-- | guix/gnu-maintenance.scm | 124 |
1 files changed, 123 insertions, 1 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 0dc2fab092..619cb3106a 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -32,6 +32,12 @@ #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix packages) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module (guix gnupg) + #:use-module (rnrs io ports) + #:use-module (guix base32) + #:use-module ((guix build utils) + #:select (substitute)) #:export (gnu-package-name gnu-package-mundane-name gnu-package-copyright-holder @@ -50,7 +56,10 @@ releases latest-release - gnu-package-name->name+version)) + gnu-package-name->name+version + package-update-path + package-update + update-package-source)) ;;; Commentary: ;;; @@ -234,6 +243,7 @@ stored." ("mit-scheme" "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg") ("icecat" "ftp.gnu.org" "/gnu/gnuzilla") ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite") + ("glib" "ftp.gnome.org" "/pub/gnome/sources/glib") ("TeXmacs" "ftp.texmacs.org" "/TeXmacs/targz"))) (match (assoc project quirks) @@ -320,4 +330,116 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\"). (values name+version #f) (values (match:substring match 1) (match:substring match 2))))) + +;;; +;;; Auto-update. +;;; + +(define (package-update-path package) + "Return an update path for PACKAGE, or #f if no update is needed." + (and (gnu-package? package) + (match (latest-release (package-name package)) + ((name+version . directory) + (let-values (((_ new-version) + (package-name->name+version name+version))) + (and (version>? name+version (package-full-name package)) + `(,new-version . ,directory)))) + (_ #f)))) + +(define* (download-tarball store project directory version + #:optional (archive-type "gz")) + "Download PROJECT's tarball over FTP and check its OpenPGP signature. On +success, return the tarball file name." + (let* ((server (ftp-server/directory project)) + (base (string-append project "-" version ".tar." archive-type)) + (url (string-append "ftp://" server "/" directory "/" base)) + (sig-url (string-append url ".sig")) + (tarball (download-to-store store url)) + (sig (download-to-store store sig-url))) + (let ((ret (gnupg-verify* sig tarball))) + (if ret + tarball + (begin + (warning (_ "signature verification failed for `~a'") + base) + (warning (_ "(could be because the public key is not in your keyring)")) + #f))))) + +(define (package-update store package) + "Return the new version and the file name of the new version tarball for +PACKAGE, or #f and #f when PACKAGE is up-to-date." + (match (package-update-path package) + ((version . directory) + (let-values (((name) + (package-name package)) + ((archive-type) + (let ((source (package-source package))) + (or (and (origin? source) + (file-extension (origin-uri source))) + "gz")))) + (let ((tarball (download-tarball store name directory version + archive-type))) + (values version tarball)))) + (_ + (values #f #f)))) + +(define (update-package-source package version hash) + "Modify the source file that defines PACKAGE to refer to VERSION, +whose tarball has SHA256 HASH (a bytevector). Return the new version string +if an update was made, and #f otherwise." + (define (new-line line matches replacement) + ;; Iterate over MATCHES and return the modified line based on LINE. + ;; Replace each match with REPLACEMENT. + (let loop ((m* matches) ; matches + (o 0) ; offset in L + (r '())) ; result + (match m* + (() + (let ((r (cons (substring line o) r))) + (string-concatenate-reverse r))) + ((m . rest) + (loop rest + (match:end m) + (cons* replacement + (substring line o (match:start m)) + r)))))) + + (define (update-source file old-version version + old-hash hash) + ;; Update source file FILE, replacing occurrences OLD-VERSION by VERSION + ;; and occurrences of OLD-HASH by HASH (base32 representation thereof). + + ;; TODO: Currently this is a bit of a sledgehammer: if VERSION occurs in + ;; different unrelated places, we may modify it more than needed, for + ;; instance. We should try to make changes only within the sexp that + ;; corresponds to the definition of PACKAGE. + (let ((old-hash (bytevector->nix-base32-string old-hash)) + (hash (bytevector->nix-base32-string hash))) + (substitute file + `((,(regexp-quote old-version) + . ,(cut new-line <> <> version)) + (,(regexp-quote old-hash) + . ,(cut new-line <> <> hash)))) + version)) + + (let ((name (package-name package)) + (loc (package-field-location package 'version))) + (if loc + (let ((old-version (package-version package)) + (old-hash (origin-sha256 (package-source package))) + (file (and=> (location-file loc) + (cut search-path %load-path <>)))) + (if file + (update-source file + old-version version + old-hash hash) + (begin + (warning (_ "~a: could not locate source file") + (location-file loc)) + #f))) + (begin + (format (current-error-port) + (_ "~a: ~a: no `version' field in source; skipping~%") + name (package-location package)))))) + ;;; gnu-maintenance.scm ends here |