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

gnu-maintenance: GNU updater no longer relies on FTP access.

Browse source 
Partly fixes <https://bugs.gnu.org/28159>.
Suggested by Hartmut Goebel <h.goebel@crazy-compilers.com>.

* guix/gnu-maintenance.scm (%gnu-file-list-uri): New variable.
(ftp.gnu.org-files, latest-gnu-release): New procedures.
(%gnu-updater)[pred]: Change to GNU-HOSTED?.
[latest]: Change to LATEST-GNU-RELEASE.
(%gnu-ftp-updater): New variable.
This commit is contained in:
Ludovic Courtès 2017-09-03 23:31:09 +02:00
parent e3c83a7cd3
commit 100b216d8a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 66 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

67
guix/gnu-maintenance.scm
View file

@ -26,6 +26,7 @@ (define-module (guix gnu-maintenance)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (rnrs io ports)
#:use-module (system foreign)
#:use-module (guix http-client)
#:use-module (guix ftp-client)
@ -34,6 +35,7 @@ (define-module (guix gnu-maintenance)
#:use-module (guix records)
#:use-module (guix upstream)
#:use-module (guix packages)
#:use-module (guix zlib)
#:export (gnu-package-name
gnu-package-mundane-name
gnu-package-copyright-holder
@ -58,6 +60,7 @@ (define-module (guix gnu-maintenance)
gnu-package-name->name+version
%gnu-updater
%gnu-ftp-updater
%gnome-updater
%kde-updater
%xorg-updater
@ -433,6 +436,56 @@ (define (latest-release* package)
#:server server
#:directory directory))))
(define %gnu-file-list-uri
;; URI of the file list for ftp.gnu.org.
(string->uri "https://ftp.gnu.org/find.txt.gz"))
(define ftp.gnu.org-files
(mlambda ()
"Return the list of files available at ftp.gnu.org."
;; XXX: Memoize the whole procedure to work around the fact that
;; 'http-fetch/cached' caches the gzipped version.
(define (trim-leading-components str)
;; Trim the leading ".", if any, in "./gnu/foo".
(string-trim str (char-set #\.)))
(define (string->lines str)
(string-tokenize str (char-set-complement (char-set #\newline))))
(let ((port (http-fetch/cached %gnu-file-list-uri #:ttl (* 60 60))))
(map trim-leading-components
(call-with-gzip-input-port port
(compose string->lines get-string-all))))))
(define (latest-gnu-release package)
"Return the latest release of PACKAGE, a GNU package available via
ftp.gnu.org.
This method does not rely on FTP access at all; instead, it browses the file
list available from %GNU-FILE-LIST-URI over HTTP(S)."
(let-values (((server directory)
(ftp-server/directory package))
((name)
(package-upstream-name package)))
(let* ((files (ftp.gnu.org-files))
(relevant (filter (lambda (file)
(and (string-contains file directory)
(release-file? name (basename file))
))
files)))
(match (sort relevant (lambda (file1 file2)
(version>? (basename file1) (basename file2))))
((tarball _ ...)
(upstream-source
(package name)
(version (tarball->version tarball))
(urls (list (string-append "mirror://gnu/" tarball)))
(signature-urls (map (cut string-append <> ".sig") urls))))
(()
#f)))))
(define %package-name-rx
;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses
;; "TeXmacs-X.Y-src", the `-src' suffix is allowed.
@ -557,10 +610,22 @@ (define (latest-kernel.org-release package)
".sign"))))))
(define %gnu-updater
;; This is for everything at ftp.gnu.org.
(upstream-updater
(name 'gnu)
(description "Updater for GNU packages")
(pred pure-gnu-package?)
(pred gnu-hosted?)
(latest latest-gnu-release)))
(define %gnu-ftp-updater
;; This is for GNU packages taken from alternate locations, such as
;; alpha.gnu.org, ftp.gnupg.org, etc. It is obsolescent.
(upstream-updater
(name 'gnu-ftp)
(description "Updater for GNU packages only available via FTP")
(pred (lambda (package)
(and (not (gnu-hosted? package))
(pure-gnu-package? package))))
(latest latest-release*)))
(define %gnome-updater