From 63e8bb12a46fe6ff493e674fd7ccceb8729c6b47 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 14 Apr 2016 22:18:56 +0200 Subject: gnu-maintenance: Move FTP directory info to 'properties' fields. * guix/gnu-maintenance.scm (ftp-server/directory): Rewrite to honor PACKAGE's properties. Remove list of quirks. (releases): Add #:server and #:directory parameters. Remove call to 'ftp-server/directory'. (latest-release): Likewise. (latest-release*): Add call to 'ftp-server/directory'. Honor 'upstream-name' property of PACKAGE. * gnu/packages/fonts.scm (font-gnu-freefont-ttf): Add 'properties' field. * gnu/packages/gnupg.scm (libgpg-error, libgcrypt, libassuan): (libksba, gnupg): Likewise. * gnu/packages/gnuzilla.scm (icecat): Likewise. * gnu/packages/package-management.scm (guix-0.10.0): Likewise. * gnu/packages/pretty-print.scm (source-highlight): Likewise. * gnu/packages/scheme.scm (mit-scheme): Likewise. * gnu/packages/telephony.scm (ucommon): Likewise. * gnu/packages/tls.scm (gnutls): Likewise. --- gnu/packages/fonts.scm | 4 +- gnu/packages/gnupg.scm | 22 +++-- gnu/packages/gnuzilla.scm | 5 +- gnu/packages/package-management.scm | 3 +- gnu/packages/pretty-print.scm | 3 +- gnu/packages/scheme.scm | 5 +- gnu/packages/telephony.scm | 3 +- gnu/packages/tls.scm | 4 +- guix/gnu-maintenance.scm | 155 +++++++++++++++++------------------- 9 files changed, 105 insertions(+), 99 deletions(-) diff --git a/gnu/packages/fonts.scm b/gnu/packages/fonts.scm index 3d75591560..aa78926d17 100644 --- a/gnu/packages/fonts.scm +++ b/gnu/packages/fonts.scm @@ -306,7 +306,9 @@ sans-serif designed for on-screen reading. It is used by GNOME@tie{}3.") "The GNU Freefont project aims to provide a set of free outline (PostScript Type0, TrueType, OpenType...) fonts covering the ISO 10646/Unicode UCS (Universal Character Set).") - (license license:gpl3+))) + (license license:gpl3+) + (properties '((upstream-name . "freefont") + (ftp-directory . "/gnu/freefont"))))) (define-public font-liberation (package diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 5ed6885cab..b6c1233497 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2013, 2015 Andreas Enge ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2014, 2015, 2016 Mark H Weaver @@ -65,7 +65,9 @@ for all GnuPG components. Among these are GPG, GPGSM, GPGME, GPG-Agent, libgcrypt, Libksba, DirMngr, Pinentry, SmartCard Daemon and possibly more in the future.") - (license license:lgpl2.0+))) + (license license:lgpl2.0+) + (properties '((ftp-server . "ftp.gnupg.org") + (ftp-directory . "/gcrypt/libgpg-error"))))) (define-public libgcrypt (package @@ -99,7 +101,9 @@ Daemon and possibly more in the future.") standard cryptographic building blocks such as symmetric ciphers, hash algorithms, public key algorithms, large integer functions and random number generation.") - (license license:lgpl2.0+))) + (license license:lgpl2.0+) + (properties '((ftp-server . "ftp.gnupg.org") + (ftp-directory . "/gcrypt/libgcrypt"))))) (define-public libgcrypt-1.5 (package (inherit libgcrypt) @@ -136,7 +140,9 @@ generation.") protocol. This protocol is used for IPC between most newer GnuPG components. Both, server and client side functions are provided.") - (license license:lgpl2.0+))) + (license license:lgpl2.0+) + (properties '((ftp-server . "ftp.gnupg.org") + (ftp-directory . "/gcrypt/libassuan"))))) (define-public libksba (package @@ -169,7 +175,9 @@ provided.") "KSBA (pronounced Kasbah) is a library to make X.509 certificates as well as the CMS easily accessible by other applications. Both specifications are building blocks of S/MIME and TLS.") - (license license:gpl3+))) + (license license:gpl3+) + (properties '((ftp-server . "ftp.gnupg.org") + (ftp-directory . "/gcrypt/libksba"))))) (define-public npth (package @@ -243,7 +251,9 @@ features powerful key management and the ability to access public key servers. It includes several libraries: libassuan (IPC between GnuPG components), libgpg-error (centralized GnuPG error values), and libskba (working with X.509 certificates and CMS data).") - (license license:gpl3+))) + (license license:gpl3+) + (properties '((ftp-server . "ftp.gnupg.org") + (ftp-directory . "/gcrypt/gnupg"))))) (define-public gnupg-2.0 (package (inherit gnupg) diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm index b2717b8cdb..bf20a4e05f 100644 --- a/gnu/packages/gnuzilla.scm +++ b/gnu/packages/gnuzilla.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2015 Andreas Enge -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2014, 2015, 2016 Mark H Weaver ;;; Copyright © 2015 Sou Bunnbu ;;; Copyright © 2016 Efraim Flashner @@ -508,4 +508,5 @@ standards.") "IceCat is the GNU version of the Firefox browser. It is entirely free software, which does not recommend non-free plugins and addons. It also features built-in privacy-protecting features.") - (license license:mpl2.0))) ; and others, see toolkit/content/license.html + (license license:mpl2.0) ;and others, see toolkit/content/license.html + (properties '((ftp-directory . "/gnu/gnuzilla"))))) diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 38c9bdb7d1..46ebde80ca 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -195,7 +195,8 @@ also a distribution thereof. It includes a virtual machine image. Besides the usual package management features, it also supports transactional upgrades and roll-backs, per-user profiles, and much more. It is based on the Nix package manager.") - (license gpl3+))) + (license gpl3+) + (properties '((ftp-server . "alpha.gnu.org"))))) (define guix-devel ;; Development version of Guix. diff --git a/gnu/packages/pretty-print.scm b/gnu/packages/pretty-print.scm index 7c0f50d467..a1692dd4de 100644 --- a/gnu/packages/pretty-print.scm +++ b/gnu/packages/pretty-print.scm @@ -191,7 +191,8 @@ their syntactic role. It supports over 150 different languages and it can output to 8 different formats, including HTML, LaTeX and ODF. It can also output to ANSI color escape sequences, so that highlighted source code can be seen in a terminal.") - (license gpl3+))) + (license gpl3+) + (properties '((ftp-directory . "/gnu/src-highlite"))))) (define-public astyle (package diff --git a/gnu/packages/scheme.scm b/gnu/packages/scheme.scm index f9537d72b2..6cf75c2471 100644 --- a/gnu/packages/scheme.scm +++ b/gnu/packages/scheme.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2016 Ricardo Wurmus @@ -174,7 +174,8 @@ "GNU/MIT Scheme is an implementation of the Scheme programming language. It provides an interpreter, a compiler and a debugger. It also features an integrated Emacs-like editor and a large runtime library.") - (license gpl2+))) + (license gpl2+) + (properties '((ftp-directory . "/gnu/mit-scheme/stable.pkg"))))) (define-public bigloo (package diff --git a/gnu/packages/telephony.scm b/gnu/packages/telephony.scm index 76e369a563..50a83fbcf3 100644 --- a/gnu/packages/telephony.scm +++ b/gnu/packages/telephony.scm @@ -76,7 +76,8 @@ to facilitate using C++ design patterns even for very deeply embedded applications, such as for systems using uclibc along with posix threading support.") (license gpl3+) - (home-page "http://www.gnu.org/software/commoncpp"))) + (home-page "http://www.gnu.org/software/commoncpp") + (properties '((ftp-directory . "/gnu/commoncpp"))))) (define-public ccrtp (package diff --git a/gnu/packages/tls.scm b/gnu/packages/tls.scm index cb538362b7..fac26b8bda 100644 --- a/gnu/packages/tls.scm +++ b/gnu/packages/tls.scm @@ -176,7 +176,9 @@ living in the same process.") and DTLS protocols. It is provided in the form of a C library to support the protocols, as well as to parse and write X.5009, PKCS 12, OpenPGP and other required structures.") - (license license:lgpl2.1+))) + (license license:lgpl2.1+) + (properties '((ftp-server . "ftp.gnutls.org") + (ftp-directory . "/gcrypt/gnutls"))))) (define-public openssl (package diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 353892f36d..8021d99c8b 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -206,34 +206,12 @@ network to check in GNU's database." ;;; Latest release. ;;; -(define (ftp-server/directory project) - "Return the FTP server and directory where PROJECT's tarball are -stored." - (define quirks - '(("commoncpp2" "ftp.gnu.org" "/gnu/commoncpp") - ("ucommon" "ftp.gnu.org" "/gnu/commoncpp") - ("libzrtpcpp" "ftp.gnu.org" "/gnu/ccrtp") - ("libosip2" "ftp.gnu.org" "/gnu/osip") - ("libgcrypt" "ftp.gnupg.org" "/gcrypt/libgcrypt") - ("libgpg-error" "ftp.gnupg.org" "/gcrypt/libgpg-error") - ("libassuan" "ftp.gnupg.org" "/gcrypt/libassuan") - ("gnupg" "ftp.gnupg.org" "/gcrypt/gnupg") - ("freefont-ttf" "ftp.gnu.org" "/gnu/freefont") - ("gnu-ghostscript" "ftp.gnu.org" "/gnu/ghostscript") - ("mit-scheme" "ftp.gnu.org" "/gnu/mit-scheme/stable.pkg") - ("icecat" "ftp.gnu.org" "/gnu/gnuzilla") - ("source-highlight" "ftp.gnu.org" "/gnu/src-highlite") - ("gnutls" "ftp.gnutls.org" "/gcrypt/gnutls") - - ;; FIXME: ftp.texmacs.org is currently outdated; texmacs.org refers to - ;; its own http URL instead. - ("TeXmacs" "ftp.texmacs.org" "/TeXmacs/targz"))) - - (match (assoc project quirks) - ((_ server directory) - (values server directory)) - (_ - (values "ftp.gnu.org" (string-append "/gnu/" project))))) +(define (ftp-server/directory package) + "Return the FTP server and directory where PACKAGE's tarball are stored." + (values (or (assoc-ref (package-properties package) 'ftp-server) + "ftp.gnu.org") + (or (assoc-ref (package-properties package) 'ftp-directory) + (string-append "/gnu/" (package-name package))))) (define (sans-extension tarball) "Return TARBALL without its .tar.* or .zip extension." @@ -276,51 +254,53 @@ true." (gnu-package-name->name+version (sans-extension tarball)))) version)) -(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\"). " +(define* (releases project + #:key + (server "ftp.gnu.org") + (directory (string-append "/gnu/" project))) + "Return the list of of PROJECT as a list of release +name/directory pairs." ;; TODO: Parse something like fencepost.gnu.org:/gd/gnuorg/packages-ftp. - (let-values (((server directory) (ftp-server/directory project))) - (define conn (ftp-open server)) - - (let loop ((directories (list directory)) - (result '())) - (match directories - (() - (ftp-close conn) - (coalesce-sources result)) - ((directory rest ...) - (let* ((files (ftp-list conn directory)) - (subdirs (filter-map (match-lambda - ((name 'directory . _) name) - (_ #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) - (append - ;; Filter out signatures, deltas, and files which - ;; are potentially not releases of PROJECT--e.g., - ;; in /gnu/guile, filter out guile-oops and - ;; guile-www; in mit-scheme, filter out binaries. - (filter-map (match-lambda - ((file 'file . _) - (and (release-file? project file) - (file->source file))) - (_ #f)) - files) - result)))))))) + (define conn (ftp-open server)) + + (let loop ((directories (list directory)) + (result '())) + (match directories + (() + (ftp-close conn) + (coalesce-sources result)) + ((directory rest ...) + (let* ((files (ftp-list conn directory)) + (subdirs (filter-map (match-lambda + ((name 'directory . _) name) + (_ #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) + (append + ;; Filter out signatures, deltas, and files which + ;; are potentially not releases of PROJECT--e.g., + ;; in /gnu/guile, filter out guile-oops and + ;; guile-www; in mit-scheme, filter out binaries. + (filter-map (match-lambda + ((file 'file . _) + (and (release-file? project file) + (file->source file))) + (_ #f)) + files) + result))))))) (define* (latest-ftp-release project #:key @@ -412,15 +392,15 @@ return the corresponding signature URL, or #f it signatures are unavailable." (ftp-close conn) result)))))) -(define (latest-release package . rest) +(define* (latest-release package + #:key + (server "ftp.gnu.org") + (directory (string-append "/gnu/" package))) "Return the for the latest version of PACKAGE or #f. -PACKAGE is the name of a GNU package. This procedure automatically uses the -right FTP server and directory for PACKAGE." - (let-values (((server directory) (ftp-server/directory package))) - (apply latest-ftp-release package - #:server server - #:directory directory - rest))) +PACKAGE must be the canonical name of a GNU package." + (latest-ftp-release package + #:server server + #:directory directory)) (define-syntax-rule (false-if-ftp-error exp) "Return #f if an FTP error is raise while evaluating EXP; return the result @@ -435,10 +415,17 @@ of EXP otherwise." #f))) (define (latest-release* package) - "Like 'latest-release', but ignore FTP errors that might occur when PACKAGE -is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that -name (this is the case for \"emacs-auctex\", for instance.)" - (false-if-ftp-error (latest-release (package-name package)))) + "Like 'latest-release', but (1) take a object, and (2) ignore FTP +errors that might occur when PACKAGE is not actually a GNU package, or not +hosted on ftp.gnu.org, or not under that name (this is the case for +\"emacs-auctex\", for instance.)" + (let-values (((server directory) + (ftp-server/directory package))) + (let ((name (or (assoc-ref (package-properties package) 'upstream-name) + (package-name package)))) + (false-if-ftp-error (latest-release name + #:server server + #:directory directory))))) (define %package-name-rx ;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses -- cgit v1.2.3