1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; 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 import gnu)
#:use-module (guix gnu-maintenance)
#:use-module (guix import utils)
#:use-module (guix i18n)
#:use-module (guix utils)
#:use-module (guix store)
#:use-module (gcrypt hash)
#:use-module (guix base32)
#:use-module (guix upstream)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (web uri)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:export (gnu->guix-package))
;;; Commentary:
;;;
;;; Generate a package declaration template for the latest version of a GNU
;;; package, using meta-data available upstream for the package.
;;;
;;; Code:
(define (qualified-url url)
"Return a fully-qualified URL based on URL."
(if (string-prefix? "/" url)
(string-append "http://www.gnu.org" url)
url))
(define (preferred-archive-type release)
"Return the preferred type of archive for downloading RELEASE."
(find (cute member <> (upstream-source-archive-types release))
'("xz" "lz" "bz2" "tbz2" "gz" "tgz" "Z")))
(define* (gnu-package->sexp package release
#:key (key-download 'interactive))
"Return the 'package' sexp for the RELEASE (a <gnu-release>) of PACKAGE (a
<gnu-package>), or #f upon failure. Use KEY-DOWNLOAD as the OpenPGP key
download policy (see 'download-tarball' for details.)"
(define name
(gnu-package-name package))
(define url-base
;; XXX: We assume that RELEASE's directory starts with "/gnu".
(string-append "mirror:/"
(match (upstream-source-urls release)
((url rest ...)
(dirname (uri-path (string->uri url)))))
"/" name "-"))
(define archive-type
(preferred-archive-type release))
(define url
(find (cut string-suffix? archive-type <>)
(upstream-source-urls release)))
(define sig-url
(find (cute string-suffix? (string-append archive-type ".sig") <>)
(upstream-source-signature-urls release)))
(with-store store
(match (download-tarball store url sig-url
#:key-download key-download)
((? string? tarball)
`(package
(name ,name)
(version ,(upstream-source-version release))
(source (origin
(method url-fetch)
(uri (string-append ,url-base version
,(string-append ".tar." archive-type)))
(sha256
(base32
,(bytevector->nix-base32-string
(file-sha256 tarball))))))
(build-system gnu-build-system)
(synopsis ,(gnu-package-doc-summary package))
(description ,(gnu-package-doc-description package))
(home-page ,(match (gnu-package-doc-urls package)
((head . tail) (qualified-url head))))
(license find-by-yourself!)))
(#f ;failure to download or authenticate the tarball
#f))))
(define* (gnu->guix-package name
#:key (key-download 'interactive))
"Return the package declaration for NAME as an s-expression. Use
KEY-DOWNLOAD as the OpenPGP key download policy (see 'download-tarball' for
details.)"
(match (latest-release name)
((? upstream-source? release)
(let ((version (upstream-source-version release)))
(match (find-package name)
(#f
(raise (condition
(&message
(message
(format #f
(G_ "couldn't find meta-data for GNU ~a")
name))))))
(info
(gnu-package->sexp info release #:key-download key-download)))))
(_
(raise (condition
(&message
(message
(format #f
(G_ "failed to determine latest release of GNU ~a")
name))))))))
;;; gnu.scm ends here
|