gnu-maintenance: Generalize, leading to (guix upstream).

* guix/gnu-maintenance.scm (<gnu-release>): Remove.
  (coalesce-releases): Move to upstream.scm.  Rename to
  'coalesce-sources'; adjust callers.
  (releases, latest-release): Return <upstream-source> objects instead
  of <gnu-release> objects.
  (latest-release*, non-emacs-gnu-package?): New procedures.
  (gnu-release-archive-types): Remove.
  (%gnu-updater): New variable.
  (package-update-path, download-tarball, package-update,
  update-package-source): Move to...
* guix/upstream.scm: ... here.  New file.
* Makefile.am (MODULES): Add it.
* po/guix/POTFILES.in: Replace gnu-maintenance.scm with upstream.scm.
* guix/scripts/refresh.scm (%updaters): New variable.
  (update-package): Adjust to new 'package-update' interface.
  (guix-refresh): Adjust to new 'package-update-path'.  Remove
  'false-if-exception' around it.

Makefile.am

@@ -48,6 +48,7 @@ MODULES =					\
   guix/nar.scm					\
   guix/derivations.scm				\
   guix/gnu-maintenance.scm			\
+  guix/upstream.scm				\
   guix/licenses.scm				\
   guix/build-system.scm				\
   guix/build-system/cmake.scm			\

guix/gnu-maintenance.scm

@@ -29,16 +29,10 @@
   #:use-module (system foreign)
   #:use-module (guix http-client)
   #:use-module (guix ftp-client)
-  #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix records)
+  #:use-module (guix upstream)
   #: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
@@ -56,21 +50,12 @@
             find-packages
             gnu-package?
 
-            gnu-release?
-            gnu-release-package
-            gnu-release-version
-            gnu-release-directory
-            gnu-release-files
-
             releases
             latest-release
             gnu-release-archive-types
             gnu-package-name->name+version
 
-            download-tarball
+            %gnu-updater))
-            package-update-path
-            package-update
-            update-package-source))
 
 ;;; Commentary:
 ;;;
@@ -218,13 +203,6 @@ network to check in GNU's database."
 ;;; Latest release.
 ;;;
 
-(define-record-type* <gnu-release> gnu-release make-gnu-release
-  gnu-release?
-  (package    gnu-release-package)
-  (version    gnu-release-version)
-  (directory  gnu-release-directory)
-  (files      gnu-release-files))
-
 (define (ftp-server/directory project)
   "Return the FTP server and directory where PROJECT's tarball are
 stored."
@@ -284,29 +262,6 @@ true."
                 (gnu-package-name->name+version (sans-extension tarball))))
     version))
 
-(define (coalesce-releases releases)
-  "Coalesce the elements of RELEASES that correspond to the same version."
-  (define (same-version? r1 r2)
-    (string=? (gnu-release-version r1) (gnu-release-version r2)))
-
-  (define (release>? r1 r2)
-    (version>? (gnu-release-version r1) (gnu-release-version r2)))
-
-  (fold (lambda (release result)
-          (match result
-            ((head . tail)
-             (if (same-version? release head)
-                 (cons (gnu-release
-                        (inherit release)
-                        (files (append (gnu-release-files release)
-                                       (gnu-release-files head))))
-                       tail)
-                 (cons release result)))
-            (()
-             (list release))))
-        '()
-        (sort releases release>?)))
-
 (define (releases project)
   "Return the list of releases of PROJECT as a list of release name/directory
 pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\"). "
@@ -319,13 +274,24 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
       (match directories
         (()
          (ftp-close conn)
-         (coalesce-releases result))
+         (coalesce-sources result))
         ((directory rest ...)
          (let* ((files   (ftp-list conn directory))
                 (subdirs (filter-map (match-lambda
-                                      ((name 'directory . _) name)
+                                       ((name 'directory . _) name)
-                                      (_ #f))
+                                       (_ #f))
                                      files)))
+           (define (file->url file)
+             (string-append "ftp://" server directory "/" file))
+
+           (define (file->source file)
+             (let ((url (file->url file)))
+               (upstream-source
+                (package project)
+                (version (tarball->version file))
+                (urls (list url))
+                (signature-urls (list (string-append url ".sig"))))))
+
            (loop (append (map (cut string-append directory "/" <>)
                               subdirs)
                          rest)
@@ -335,15 +301,10 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
                   ;; in /gnu/guile, filter out guile-oops and
                   ;; guile-www; in mit-scheme, filter out binaries.
                   (filter-map (match-lambda
-                               ((file 'file . _)
+                                ((file 'file . _)
-                                (if (release-file? project file)
+                                 (and (release-file? project file)
-                                    (gnu-release
+                                      (file->source file)))
-                                     (package project)
+                                (_ #f))
-                                     (version (tarball->version file))
-                                     (directory directory)
-                                     (files (list file)))
-                                    #f))
-                               (_ #f))
                               files)
                   result))))))))
 
@@ -355,7 +316,7 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
     (if (version>? a b) a b))
 
   (define (latest-release a b)
-    (if (version>? (gnu-release-version a) (gnu-release-version b))
+    (if (version>? (upstream-source-version a) (upstream-source-version b))
         a b))
 
   (define contains-digit?
@@ -368,6 +329,17 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
   (let-values (((server directory) (ftp-server/directory project)))
     (define conn (ftp-open server))
 
+    (define (file->url file)
+      (string-append "ftp://" server directory "/" file))
+
+    (define (file->source file)
+      (let ((url (file->url file)))
+        (upstream-source
+         (package project)
+         (version (tarball->version file))
+         (urls (list url))
+         (signature-urls (list (string-append url ".sig"))))))
+
     (let loop ((directory directory)
                (result    #f))
       (let* ((entries (ftp-list conn directory))
@@ -375,12 +347,12 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
              ;; Filter out sub-directories that do not contain digits---e.g.,
              ;; /gnuzilla/lang and /gnupg/patches.
              (subdirs (filter-map (match-lambda
-                                   (((? patch-directory-name? dir)
+                                    (((? patch-directory-name? dir)
-                                     'directory . _)
+                                      'directory . _)
-                                    #f)
+                                     #f)
-                                   (((? contains-digit? dir) 'directory . _)
+                                    (((? contains-digit? dir) 'directory . _)
-                                    dir)
+                                     dir)
-                                   (_ #f))
+                                    (_ #f))
                                   entries))
 
              ;; Whether or not SUBDIRS is empty, compute the latest releases
@@ -390,19 +362,14 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
              (releases (filter-map (match-lambda
                                      ((file 'file . _)
                                       (and (release-file? project file)
-                                           (gnu-release
+                                           (file->source file)))
-                                            (package project)
-                                            (version
-                                             (tarball->version file))
-                                            (directory directory)
-                                            (files (list file)))))
                                      (_ #f))
                                    entries)))
 
         ;; Assume that SUBDIRS correspond to versions, and jump into the
         ;; one with the highest version number.
         (let* ((release  (reduce latest-release #f
-                                 (coalesce-releases releases)))
+                                 (coalesce-sources releases)))
                (result   (if (and result release)
                              (latest-release release result)
                              (or release result)))
@@ -414,10 +381,18 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
                 (ftp-close conn)
                 result)))))))
 
-(define (gnu-release-archive-types release)
+(define (latest-release* package)
-  "Return the available types of archives for RELEASE---a list of strings such
+  "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE
-as \"gz\" or \"xz\"."
+is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that
-  (map file-extension (gnu-release-files release)))
+name (this is the case for \"emacs-auctex\", for instance.)"
+  (catch 'ftp-error
+    (lambda ()
+      (latest-release package))
+    (lambda (key port . rest)
+      (if (ftp-connection? port)
+          (ftp-close port)
+          (close-port port))
+      #f)))
 
 (define %package-name-rx
   ;; Regexp for a package name, e.g., "foo-X.Y".  Since TeXmacs uses
@@ -431,121 +406,15 @@ as \"gz\" or \"xz\"."
         (values name+version #f)
         (values (match:substring match 1) (match:substring match 2)))))
 
-
+(define (non-emacs-gnu-package? package)
-;;;
+  "Return true if PACKAGE is a non-Emacs GNU package.  This excludes AucTeX,
-;;; Auto-update.
+for instance, whose releases are now uploaded to elpa.gnu.org."
-;;;
+  (and (not (string-prefix? "emacs-" (package-name package)))
+       (gnu-package? package)))
 
-(define (package-update-path package)
+(define %gnu-updater
-  "Return an update path for PACKAGE, or #f if no update is needed."
+  (upstream-updater 'gnu
-  (and (gnu-package? package)
+                    non-emacs-gnu-package?
-       (match (latest-release (package-name package))
+                    latest-release*))
-         (($ <gnu-release> name version directory)
-          (and (version>? version (package-version package))
-               `(,version . ,directory)))
-         (_ #f))))
-
-(define* (download-tarball store project directory version
-                           #:key (archive-type "gz")
-                                 (key-download 'interactive))
-  "Download PROJECT's tarball over FTP and check its OpenPGP signature.  On
-success, return the tarball file name.  KEY-DOWNLOAD specifies a download
-policy for missing OpenPGP keys; allowed values: 'interactive' (default),
-'always', and 'never'."
-  (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 #:key-download key-download)))
-      (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 #:key (key-download 'interactive))
-  "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.  KEY-DOWNLOAD specifies a
-download policy for missing OpenPGP keys; allowed values: 'always', 'never',
-and 'interactive' (default)."
-  (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 archive-type
-                                        #:key-download key-download)))
-         (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~%")
-                  (location->string (package-location package))
-                  name)))))
 
 ;;; gnu-maintenance.scm ends here

guix/scripts/refresh.scm

@@ -25,7 +25,8 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix packages)
-  #:use-module (guix gnu-maintenance)
+  #:use-module (guix upstream)
+  #:use-module ((guix gnu-maintenance) #:select (%gnu-updater))
   #:use-module (guix gnupg)
   #:use-module (gnu packages)
   #:use-module ((gnu packages commencement) #:select (%final-inputs))
@@ -124,6 +125,15 @@ specified with `--select'.\n"))
   (newline)
   (show-bug-report-information))
 
+
+;;;
+;;; Updates.
+;;;
+
+(define %updaters
+  ;; List of "updaters" used by default.
+  (list %gnu-updater))
+
 (define* (update-package store package #:key (key-download 'interactive))
   "Update the source file that defines PACKAGE with the new version.
 KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
@@ -131,12 +141,12 @@ values: 'interactive' (default), 'always', and 'never'."
   (let-values (((version tarball)
                 (catch #t
                   (lambda ()
-                    (package-update store package #:key-download key-download))
+                    (package-update store package %updaters
+                                    #:key-download key-download))
                   (lambda _
                     (values #f #f))))
                ((loc)
-                (or (package-field-location package
+                (or (package-field-location package 'version)
-                                            'version)
                     (package-location package))))
     (when version
       (if (and=> tarball file-exists?)
@@ -153,7 +163,6 @@ values: 'interactive' (default), 'always', and 'never'."
 downloaded and authenticated; not updating~%")
                    (package-name package) version)))))
 
-
 
 ;;;
 ;;; Entry point.
@@ -262,14 +271,14 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
              packages))))
        (else
         (for-each (lambda (package)
-                    (match (false-if-exception (package-update-path package))
+                    (match (package-update-path package %updaters)
-                      ((new-version . directory)
+                      ((? upstream-source? source)
                        (let ((loc (or (package-field-location package 'version)
                                       (package-location package))))
                          (format (current-error-port)
                                  (_ "~a: ~a would be upgraded from ~a to ~a~%")
                                  (location->string loc)
                                  (package-name package) (package-version package)
-                                 new-version)))
+                                 (upstream-source-version source))))
-                      (_ #f)))
+                      (#f #f)))
                   packages))))))

guix/upstream.scm

@@ -0,0 +1,259 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix upstream)
+  #:use-module (guix records)
+  #:use-module (guix utils)
+  #:use-module ((guix download)
+                #:select (download-to-store))
+  #:use-module ((guix build utils)
+                #:select (substitute))
+  #:use-module (guix gnupg)
+  #:use-module (guix packages)
+  #:use-module (guix ui)
+  #:use-module (guix base32)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:export (upstream-source
+            upstream-source?
+            upstream-source-package
+            upstream-source-version
+            upstream-source-urls
+            upstream-source-signature-urls
+
+            coalesce-sources
+
+            upstream-updater
+            upstream-updater?
+            upstream-updater-name
+            upstream-updater-predicate
+            upstream-updater-latest
+
+            download-tarball
+            package-update-path
+            package-update
+            update-package-source))
+
+;;; Commentary:
+;;;
+;;; This module provides tools to represent and manipulate a upstream source
+;;; code, and to auto-update package recipes.
+;;;
+;;; Code:
+
+;; Representation of upstream's source.  There can be several URLs--e.g.,
+;; tar.gz, tar.gz, etc.  There can be correspond signature URLs, one per
+;; source URL.
+(define-record-type* <upstream-source>
+  upstream-source make-upstream-source
+  upstream-source?
+  (package        upstream-source-package)        ;string
+  (version        upstream-source-version)        ;string
+  (urls           upstream-source-urls)           ;list of strings
+  (signature-urls upstream-source-signature-urls  ;#f | list of strings
+                  (default #f)))
+
+(define (upstream-source-archive-types release)
+  "Return the available types of archives for RELEASE---a list of strings such
+as \"gz\" or \"xz\"."
+  (map file-extension (upstream-source-urls release)))
+
+(define (coalesce-sources sources)
+  "Coalesce the elements of SOURCES, a list of <upstream-source>, that
+correspond to the same version."
+  (define (same-version? r1 r2)
+    (string=? (upstream-source-version r1) (upstream-source-version r2)))
+
+  (define (release>? r1 r2)
+    (version>? (upstream-source-version r1) (upstream-source-version r2)))
+
+  (fold (lambda (release result)
+          (match result
+            ((head . tail)
+             (if (same-version? release head)
+                 (cons (upstream-source
+                        (inherit release)
+                        (urls (append (upstream-source-urls release)
+                                      (upstream-source-urls head)))
+                        (signature-urls
+                         (append (upstream-source-signature-urls release)
+                                 (upstream-source-signature-urls head))))
+                       tail)
+                 (cons release result)))
+            (()
+             (list release))))
+        '()
+        (sort sources release>?)))
+
+
+;;;
+;;; Auto-update.
+;;;
+
+(define-record-type <upstream-updater>
+  (upstream-updater name pred latest)
+  upstream-updater?
+  (name      upstream-updater-name)
+  (pred      upstream-updater-predicate)
+  (latest    upstream-updater-latest))
+
+(define (lookup-updater package updaters)
+  "Return an updater among UPDATERS that matches PACKAGE, or #f if none of
+them matches."
+  (any (match-lambda
+         (($ <upstream-updater> _ pred latest)
+          (and (pred package) latest)))
+       updaters))
+
+(define (package-update-path package updaters)
+  "Return an upstream source to update PACKAGE to, or #f if no update is
+needed or known."
+  (match (lookup-updater package updaters)
+    ((? procedure? latest-release)
+     (match (latest-release (package-name package))
+       ((and source ($ <upstream-source> name version))
+        (and (version>? version (package-version package))
+             source))
+       (_ #f)))
+    (#f #f)))
+
+(define* (download-tarball store url signature-url
+                           #:key (key-download 'interactive))
+  "Download the tarball at URL to the store; check its OpenPGP signature at
+SIGNATURE-URL, unless SIGNATURE-URL is false.  On success, return the tarball
+file name.  KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys;
+allowed values: 'interactive' (default), 'always', and 'never'."
+  (let ((tarball (download-to-store store url)))
+    (if (not signature-url)
+        tarball
+        (let* ((sig (download-to-store store signature-url))
+               (ret (gnupg-verify* sig tarball #:key-download key-download)))
+          (if ret
+              tarball
+              (begin
+                (warning (_ "signature verification failed for `~a'~%")
+                         url)
+                (warning (_ "(could be because the public key is not in your keyring)~%"))
+                #f))))))
+
+(define (find2 pred lst1 lst2)
+  "Like 'find', but operate on items from both LST1 and LST2.  Return two
+values: the item from LST1 and the item from LST2 that match PRED."
+  (let loop ((lst1 lst1) (lst2 lst2))
+    (match lst1
+      ((head1 . tail1)
+       (match lst2
+         ((head2 . tail2)
+          (if (pred head1 head2)
+              (values head1 head2)
+              (loop tail1 tail2)))))
+      (()
+       (values #f #f)))))
+
+(define* (package-update store package updaters
+                         #:key (key-download 'interactive))
+  "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.  KEY-DOWNLOAD specifies a
+download policy for missing OpenPGP keys; allowed values: 'always', 'never',
+and 'interactive' (default)."
+  (match (package-update-path package updaters)
+    (($ <upstream-source> _ version urls signature-urls)
+     (let*-values (((name)
+                    (package-name package))
+                   ((archive-type)
+                    (match (and=> (package-source package) origin-uri)
+                      ((? string? uri)
+                       (or (file-extension uri) "gz"))
+                      (_
+                       "gz")))
+                   ((url signature-url)
+                    (find2 (lambda (url sig-url)
+                             (string-suffix? archive-type url))
+                           urls
+                           (or signature-urls (circular-list #f)))))
+       (let ((tarball (download-tarball store url signature-url
+                                        #:key-download key-download)))
+         (values version tarball))))
+    (#f
+     (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~%")
+                  (location->string (package-location package))
+                  name)))))
+
+;;; upstream.scm ends here

po/guix/POTFILES.in

@@ -23,7 +23,7 @@ guix/scripts/edit.scm
 guix/scripts/size.scm
 guix/scripts/graph.scm
 guix/scripts/challenge.scm
-guix/gnu-maintenance.scm
+guix/upstream.scm
 guix/ui.scm
 guix/http-client.scm
 guix/nar.scm