You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

183 lines
6.6 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (guix import texlive)
  19. #:use-module (ice-9 match)
  20. #:use-module (sxml simple)
  21. #:use-module (sxml xpath)
  22. #:use-module (srfi srfi-11)
  23. #:use-module (srfi srfi-1)
  24. #:use-module (srfi srfi-26)
  25. #:use-module (srfi srfi-34)
  26. #:use-module (web uri)
  27. #:use-module (guix http-client)
  28. #:use-module (gcrypt hash)
  29. #:use-module (guix memoization)
  30. #:use-module (guix store)
  31. #:use-module (guix base32)
  32. #:use-module (guix serialization)
  33. #:use-module (guix svn-download)
  34. #:use-module (guix import utils)
  35. #:use-module (guix utils)
  36. #:use-module (guix upstream)
  37. #:use-module (guix packages)
  38. #:use-module (gnu packages)
  39. #:use-module (guix build-system texlive)
  40. #:export (texlive->guix-package))
  41. ;;; Commentary:
  42. ;;;
  43. ;;; Generate a package declaration template for the latest version of a
  44. ;;; package on CTAN, using the XML output produced by the XML API to the CTAN
  45. ;;; database at http://www.ctan.org/xml/1.2/
  46. ;;;
  47. ;;; Instead of taking the packages from CTAN, however, we fetch the sources
  48. ;;; from the SVN repository of the Texlive project. We do this because CTAN
  49. ;;; only keeps a single version of each package whereas we can access any
  50. ;;; version via SVN. Unfortunately, this means that the importer is really
  51. ;;; just a Texlive importer, not a generic CTAN importer.
  52. ;;;
  53. ;;; Code:
  54. (define string->license
  55. (match-lambda
  56. ("artistic2" 'gpl3+)
  57. ("gpl" 'gpl3+)
  58. ("gpl1" 'gpl1)
  59. ("gpl1+" 'gpl1+)
  60. ("gpl2" 'gpl2)
  61. ("gpl2+" 'gpl2+)
  62. ("gpl3" 'gpl3)
  63. ("gpl3+" 'gpl3+)
  64. ("lgpl2.1" 'lgpl2.1)
  65. ("lgpl3" 'lgpl3)
  66. ("knuth" 'knuth)
  67. ("pd" 'public-domain)
  68. ("bsd2" 'bsd-2)
  69. ("bsd3" 'bsd-3)
  70. ("bsd4" 'bsd-4)
  71. ("opl" 'opl1.0+)
  72. ("ofl" 'silofl1.1)
  73. ("lppl" 'lppl)
  74. ("lppl1" 'lppl1.0+) ; usually means "or later"
  75. ("lppl1.2" 'lppl1.2+) ; usually means "or later"
  76. ("lppl1.3" 'lppl1.3+) ; usually means "or later"
  77. ("lppl1.3a" 'lppl1.3a)
  78. ("lppl1.3b" 'lppl1.3b)
  79. ("lppl1.3c" 'lppl1.3c)
  80. ("cc-by-2" 'cc-by-2.0)
  81. ("cc-by-3" 'cc-by-3.0)
  82. ("cc-by-sa-2" 'cc-by-sa2.0)
  83. ("cc-by-sa-3" 'cc-by-sa3.0)
  84. ("mit" 'expat)
  85. ("fdl" 'fdl1.3+)
  86. ("gfl" 'gfl1.0)
  87. ;; These are known non-free licenses
  88. ("noinfo" 'unknown)
  89. ("nosell" 'non-free)
  90. ("shareware" 'non-free)
  91. ("nosource" 'non-free)
  92. ("nocommercial" 'non-free)
  93. ("cc-by-nc-nd-1" 'non-free)
  94. ("cc-by-nc-nd-2" 'non-free)
  95. ("cc-by-nc-nd-2.5" 'non-free)
  96. ("cc-by-nc-nd-3" 'non-free)
  97. ("cc-by-nc-nd-4" 'non-free)
  98. ((x) (string->license x))
  99. ((lst ...) `(list ,@(map string->license lst)))
  100. (_ #f)))
  101. (define (fetch-sxml name)
  102. "Return an sxml representation of the package information contained in the
  103. XML description of the CTAN package or #f in case of failure."
  104. ;; This API always returns the latest release of the module.
  105. (let ((url (string-append "http://www.ctan.org/xml/1.2/pkg/" name)))
  106. (guard (c ((http-get-error? c)
  107. (format (current-error-port)
  108. "error: failed to retrieve package information \
  109. from ~s: ~a (~s)~%"
  110. (uri->string (http-get-error-uri c))
  111. (http-get-error-code c)
  112. (http-get-error-reason c))
  113. #f))
  114. (xml->sxml (http-fetch url)
  115. #:trim-whitespace? #t))))
  116. (define (guix-name component name)
  117. "Return a Guix package name for a given Texlive package NAME."
  118. (string-append "texlive-" component "-"
  119. (string-map (match-lambda
  120. (#\_ #\-)
  121. (#\. #\-)
  122. (chr (char-downcase chr)))
  123. name)))
  124. (define* (sxml->package sxml #:optional (component "latex"))
  125. "Return the `package' s-expression for a Texlive package from the SXML
  126. expression describing it."
  127. (define (sxml-value path)
  128. (match ((sxpath path) sxml)
  129. (() #f)
  130. ((val) val)))
  131. (with-store store
  132. (let* ((id (sxml-value '(entry @ id *text*)))
  133. (synopsis (sxml-value '(entry caption *text*)))
  134. (version (or (sxml-value '(entry version @ number *text*))
  135. (sxml-value '(entry version @ date *text*))))
  136. (license (string->license (sxml-value '(entry license @ type *text*))))
  137. (home-page (string-append "http://www.ctan.org/pkg/" id))
  138. (ref (texlive-ref component id))
  139. (checkout (download-svn-to-store store ref)))
  140. `(package
  141. (name ,(guix-name component id))
  142. (version ,version)
  143. (source (origin
  144. (method svn-fetch)
  145. (uri (texlive-ref ,component ,id))
  146. (sha256
  147. (base32
  148. ,(bytevector->nix-base32-string
  149. (let-values (((port get-hash) (open-sha256-port)))
  150. (write-file checkout port)
  151. (force-output port)
  152. (get-hash)))))))
  153. (build-system texlive-build-system)
  154. (arguments ,`(,'quote (#:tex-directory ,(string-join (list component id) "/"))))
  155. (home-page ,home-page)
  156. (synopsis ,synopsis)
  157. (description ,(string-trim-both
  158. (string-join
  159. (map string-trim-both
  160. (string-split
  161. (beautify-description
  162. (sxml->string (or (sxml-value '(entry description))
  163. '())))
  164. #\newline)))))
  165. (license ,license)))))
  166. (define texlive->guix-package
  167. (memoize
  168. (lambda* (package-name #:optional (component "latex"))
  169. "Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
  170. s-expression corresponding to that package, or #f on failure."
  171. (and=> (fetch-sxml package-name)
  172. (cut sxml->package <> component)))))
  173. ;;; ctan.scm ends here