mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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.
This commit is contained in:
parent
444bb0d857
commit
63e8bb12a4
9 changed files with 102 additions and 96 deletions
|
@ -306,7 +306,9 @@ (define-public font-gnu-freefont-ttf
|
|||
"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
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org>
|
||||
|
@ -65,7 +65,9 @@ (define-public libgpg-error
|
|||
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 @@ (define-public libgcrypt
|
|||
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 @@ (define-public libassuan
|
|||
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 @@ (define-public libksba
|
|||
"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 @@ (define-public gnupg
|
|||
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)
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
|
||||
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2014, 2015, 2016 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
|
||||
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
||||
|
@ -508,4 +508,5 @@ (define-public icecat
|
|||
"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")))))
|
||||
|
|
|
@ -195,7 +195,8 @@ (define (copy arch)
|
|||
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.
|
||||
|
|
|
@ -191,7 +191,8 @@ (define-public source-highlight
|
|||
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
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
|
||||
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
|
||||
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
|
||||
|
@ -174,7 +174,8 @@ (define-public mit-scheme
|
|||
"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
|
||||
|
|
|
@ -76,7 +76,8 @@ (define-public ucommon
|
|||
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
|
||||
|
|
|
@ -176,7 +176,9 @@ (define-public gnutls
|
|||
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
|
||||
|
|
|
@ -206,34 +206,12 @@ (define (gnu-home-page? package)
|
|||
;;; 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 @@ (define (tarball->version tarball)
|
|||
(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 <upstream-release> 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))
|
||||
(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))
|
||||
(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"))))))
|
||||
(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))))))))
|
||||
(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 @@ (define (file->source directory file)
|
|||
(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 <upstream-source> 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 @@ (define-syntax-rule (false-if-ftp-error exp)
|
|||
#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 <package> 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
|
||||
|
|
Loading…
Reference in a new issue