go.scm 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2020 Katherine Cox-Buday <cox.katherine.e@gmail.com>
  3. ;;; Copyright © 2020 Helio Machado <0x2b3bfa0+guix@googlemail.com>
  4. ;;; Copyright © 2021 François Joulaud <francois.joulaud@radiofrance.com>
  5. ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
  6. ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
  7. ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
  8. ;;;
  9. ;;; This file is part of GNU Guix.
  10. ;;;
  11. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  12. ;;; under the terms of the GNU General Public License as published by
  13. ;;; the Free Software Foundation; either version 3 of the License, or (at
  14. ;;; your option) any later version.
  15. ;;;
  16. ;;; GNU Guix is distributed in the hope that it will be useful, but
  17. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;;; GNU General Public License for more details.
  20. ;;;
  21. ;;; You should have received a copy of the GNU General Public License
  22. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  23. (define-module (guix import go)
  24. #:use-module (guix build-system go)
  25. #:use-module (guix git)
  26. #:use-module (guix i18n)
  27. #:use-module (guix diagnostics)
  28. #:use-module (guix import utils)
  29. #:use-module (guix import json)
  30. #:use-module (guix packages)
  31. #:use-module ((guix utils) #:select (string-replace-substring))
  32. #:use-module (guix http-client)
  33. #:use-module ((guix licenses) #:prefix license:)
  34. #:use-module (guix memoization)
  35. #:use-module (htmlprag) ;from Guile-Lib
  36. #:autoload (guix git) (update-cached-checkout)
  37. #:autoload (gcrypt hash) (open-hash-port hash-algorithm sha256)
  38. #:autoload (guix serialization) (write-file)
  39. #:autoload (guix base32) (bytevector->nix-base32-string)
  40. #:autoload (guix build utils) (mkdir-p)
  41. #:use-module (ice-9 match)
  42. #:use-module (ice-9 rdelim)
  43. #:use-module (ice-9 receive)
  44. #:use-module (ice-9 regex)
  45. #:use-module (ice-9 textual-ports)
  46. #:use-module ((rnrs io ports) #:select (call-with-port))
  47. #:use-module (srfi srfi-1)
  48. #:use-module (srfi srfi-2)
  49. #:use-module (srfi srfi-9)
  50. #:use-module (srfi srfi-11)
  51. #:use-module (srfi srfi-26)
  52. #:use-module (srfi srfi-34)
  53. #:use-module (sxml match)
  54. #:use-module ((sxml xpath) #:renamer (lambda (s)
  55. (if (eq? 'filter s)
  56. 'xfilter
  57. s)))
  58. #:use-module (web client)
  59. #:use-module (web response)
  60. #:use-module (web uri)
  61. #:export (go-module->guix-package
  62. go-module-recursive-import))
  63. ;;; Parameterize htmlprag to parse valid HTML more reliably.
  64. (%strict-tokenizer? #t)
  65. ;;; Commentary:
  66. ;;;
  67. ;;; (guix import go) attempts to make it easier to create Guix package
  68. ;;; declarations for Go modules.
  69. ;;;
  70. ;;; Modules in Go are a "collection of related Go packages" which are "the
  71. ;;; unit of source code interchange and versioning". Modules are generally
  72. ;;; hosted in a repository.
  73. ;;;
  74. ;;; At this point it should handle correctly modules which have only Go
  75. ;;; dependencies and are accessible from proxy.golang.org (or configured via
  76. ;;; GOPROXY).
  77. ;;;
  78. ;;; We want it to work more or less this way:
  79. ;;; - get latest version for the module from GOPROXY
  80. ;;; - infer VCS root repo from which we will check-out source by
  81. ;;; + recognising known patterns (like github.com)
  82. ;;; + or recognizing .vcs suffix
  83. ;;; + or parsing meta tag in HTML served at the URL
  84. ;;; + or (TODO) if nothing else works by using zip file served by GOPROXY
  85. ;;; - get go.mod from GOPROXY (which is able to synthetize one if needed)
  86. ;;; - extract list of dependencies from this go.mod
  87. ;;;
  88. ;;; The Go module paths are translated to a Guix package name under the
  89. ;;; assumption that there will be no collision.
  90. ;;; TODO list
  91. ;;; - get correct hash in vcs->origin for Mercurial and Subversion
  92. ;;; Code:
  93. (define http-fetch*
  94. ;; Like http-fetch, but memoized and returning the body as a string.
  95. (memoize (lambda args
  96. (call-with-port (apply http-fetch args) get-string-all))))
  97. (define json-fetch*
  98. (memoize json-fetch))
  99. (define (go-path-escape path)
  100. "Escape a module path by replacing every uppercase letter with an
  101. exclamation mark followed with its lowercase equivalent, as per the module
  102. Escaped Paths specification (see:
  103. https://godoc.org/golang.org/x/mod/module#hdr-Escaped_Paths)."
  104. (define (escape occurrence)
  105. (string-append "!" (string-downcase (match:substring occurrence))))
  106. (regexp-substitute/global #f "[A-Z]" path 'pre escape 'post))
  107. ;; Prevent inlining of this procedure, which is accessed by unit tests.
  108. (set! go-path-escape go-path-escape)
  109. (define (go.pkg.dev-info name)
  110. (http-fetch* (string-append "https://pkg.go.dev/" name)))
  111. (define* (go-module-version-string goproxy name #:key version)
  112. "Fetch the version string of the latest version for NAME from the given
  113. GOPROXY server, or for VERSION when specified."
  114. (let ((file (if version
  115. (string-append "@v/" version ".info")
  116. "@latest")))
  117. (assoc-ref (json-fetch* (format #f "~a/~a/~a"
  118. goproxy (go-path-escape name) file))
  119. "Version")))
  120. (define* (go-module-available-versions goproxy name)
  121. "Retrieve the available versions for a given module from the module proxy.
  122. Versions are being returned **unordered** and may contain different versioning
  123. styles for the same package."
  124. (let* ((url (string-append goproxy "/" (go-path-escape name) "/@v/list"))
  125. (body (http-fetch* url))
  126. (versions (remove string-null? (string-split body #\newline))))
  127. (if (null? versions)
  128. (list (go-module-version-string goproxy name)) ;latest version
  129. versions)))
  130. (define (go-package-licenses name)
  131. "Retrieve the list of licenses that apply to NAME, a Go package or module
  132. name (e.g. \"github.com/golang/protobuf/proto\")."
  133. (let* ((body (go.pkg.dev-info (string-append name "?tab=licenses")))
  134. ;; Extract the text contained in a h2 child node of any
  135. ;; element marked with a "License" class attribute.
  136. (select (sxpath `(// (* (@ (equal? (class "License"))))
  137. h2 // *text*))))
  138. (select (html->sxml body))))
  139. (define (sxml->texi sxml-node)
  140. "A very basic SXML to Texinfo converter which attempts to preserve HTML
  141. formatting and links as text."
  142. (sxml-match sxml-node
  143. ((strong ,text)
  144. (format #f "@strong{~a}" text))
  145. ((a (@ (href ,url)) ,text)
  146. (format #f "@url{~a,~a}" url text))
  147. ((code ,text)
  148. (format #f "@code{~a}" text))
  149. (,something-else something-else)))
  150. (define (go-package-description name)
  151. "Retrieve a short description for NAME, a Go package name,
  152. e.g. \"google.golang.org/protobuf/proto\"."
  153. (let* ((body (go.pkg.dev-info name))
  154. (sxml (html->sxml body))
  155. (overview ((sxpath
  156. `(//
  157. (* (@ (equal? (class "Documentation-overview"))))
  158. (p 1))) sxml))
  159. ;; Sometimes, the first paragraph just contains images/links that
  160. ;; has only "\n" for text. The following filter is designed to
  161. ;; omit it.
  162. (contains-text? (lambda (node)
  163. (remove string-null?
  164. (map string-trim-both
  165. (filter (node-typeof? '*text*)
  166. (cdr node))))))
  167. (select-content (sxpath
  168. `(//
  169. (* (@ (equal? (class "UnitReadme-content"))))
  170. div // p ,(xfilter contains-text?))))
  171. ;; Fall-back to use content; this is less desirable as it is more
  172. ;; verbose, but not every page has an overview.
  173. (description (if (not (null? overview))
  174. overview
  175. (select-content sxml)))
  176. (description* (and (not (null? description))
  177. (first description))))
  178. (match description*
  179. (() #f) ;nothing selected
  180. ((p elements ...)
  181. (apply string-append (filter string? (map sxml->texi elements)))))))
  182. (define (go-package-synopsis module-name)
  183. "Retrieve a short synopsis for a Go module named MODULE-NAME,
  184. e.g. \"google.golang.org/protobuf\". The data is scraped from
  185. the https://pkg.go.dev/ web site."
  186. ;; Note: Only the *module* (rather than package) page has the README title
  187. ;; used as a synopsis on the https://pkg.go.dev web site.
  188. (let* ((url (string-append "https://pkg.go.dev/" module-name))
  189. (body (http-fetch* url))
  190. ;; Extract the text contained in a h2 child node of any
  191. ;; element marked with a "License" class attribute.
  192. (select-title (sxpath
  193. `(// (div (@ (equal? (class "UnitReadme-content"))))
  194. // h3 *text*))))
  195. (match (select-title (html->sxml body))
  196. (() #f) ;nothing selected
  197. ((title more ...) ;title is the first string of the list
  198. (string-trim-both title)))))
  199. (define (list->licenses licenses)
  200. "Given a list of LICENSES mostly following the SPDX conventions, return the
  201. corresponding Guix license or 'unknown-license!"
  202. (filter-map (lambda (license)
  203. (and (not (string-null? license))
  204. (not (any (cut string=? <> license)
  205. '("AND" "OR" "WITH")))
  206. ;; Adjust the license names scraped from
  207. ;; https://pkg.go.dev to an equivalent SPDX identifier,
  208. ;; if they differ (see: https://github.com/golang/pkgsite
  209. ;; /internal/licenses/licenses.go#L174).
  210. (or (spdx-string->license
  211. (match license
  212. ("BlueOak-1.0" "BlueOak-1.0.0")
  213. ("BSD-0-Clause" "0BSD")
  214. ("BSD-2-Clause" "BSD-2-Clause-FreeBSD")
  215. ("GPL2" "GPL-2.0")
  216. ("GPL3" "GPL-3.0")
  217. ("NIST" "NIST-PD")
  218. (_ license)))
  219. 'unknown-license!)))
  220. licenses))
  221. (define (fetch-go.mod goproxy module-path version)
  222. "Fetch go.mod from the given GOPROXY server for the given MODULE-PATH
  223. and VERSION and return an input port."
  224. (let ((url (format #f "~a/~a/@v/~a.mod" goproxy
  225. (go-path-escape module-path)
  226. (go-path-escape version))))
  227. (http-fetch* url)))
  228. (define %go.mod-require-directive-rx
  229. ;; A line in a require directive is composed of a module path and
  230. ;; a version separated by whitespace and an optionnal '//' comment at
  231. ;; the end.
  232. (make-regexp
  233. (string-append
  234. "^[[:blank:]]*([^[:blank:]]+)[[:blank:]]+" ;the module path
  235. "([^[:blank:]]+)" ;the version
  236. "([[:blank:]]+//.*)?"))) ;an optional comment
  237. (define %go.mod-replace-directive-rx
  238. ;; ReplaceSpec = ModulePath [ Version ] "=>" FilePath newline
  239. ;; | ModulePath [ Version ] "=>" ModulePath Version newline .
  240. (make-regexp
  241. (string-append
  242. "([^[:blank:]]+)" ;the module path
  243. "([[:blank:]]+([^[:blank:]]+))?" ;optional version
  244. "[[:blank:]]+=>[[:blank:]]+"
  245. "([^[:blank:]]+)" ;the file or module path
  246. "([[:blank:]]+([^[:blank:]]+))?"))) ;the version (if a module path)
  247. (define (parse-go.mod content)
  248. "Parse the go.mod file CONTENT, returning a list of requirements."
  249. ;; We parse only a subset of https://golang.org/ref/mod#go-mod-file-grammar
  250. ;; which we think necessary for our use case.
  251. (define (toplevel requirements replaced)
  252. "This is the main parser. The results are accumulated in THE REQUIREMENTS
  253. and REPLACED lists."
  254. (let ((line (read-line)))
  255. (cond
  256. ((eof-object? line)
  257. ;; parsing ended, give back the result
  258. (values requirements replaced))
  259. ((string=? line "require (")
  260. ;; a require block begins, delegate parsing to IN-REQUIRE
  261. (in-require requirements replaced))
  262. ((string=? line "replace (")
  263. ;; a replace block begins, delegate parsing to IN-REPLACE
  264. (in-replace requirements replaced))
  265. ((string-prefix? "require " line)
  266. ;; a require directive by itself
  267. (let* ((stripped-line (string-drop line 8)))
  268. (call-with-values
  269. (lambda ()
  270. (require-directive requirements replaced stripped-line))
  271. toplevel)))
  272. ((string-prefix? "replace " line)
  273. ;; a replace directive by itself
  274. (let* ((stripped-line (string-drop line 8)))
  275. (call-with-values
  276. (lambda ()
  277. (replace-directive requirements replaced stripped-line))
  278. toplevel)))
  279. (#t
  280. ;; unrecognised line, ignore silently
  281. (toplevel requirements replaced)))))
  282. (define (in-require requirements replaced)
  283. (let ((line (read-line)))
  284. (cond
  285. ((eof-object? line)
  286. ;; this should never happen here but we ignore silently
  287. (values requirements replaced))
  288. ((string=? line ")")
  289. ;; end of block, coming back to toplevel
  290. (toplevel requirements replaced))
  291. (#t
  292. (call-with-values (lambda ()
  293. (require-directive requirements replaced line))
  294. in-require)))))
  295. (define (in-replace requirements replaced)
  296. (let ((line (read-line)))
  297. (cond
  298. ((eof-object? line)
  299. ;; this should never happen here but we ignore silently
  300. (values requirements replaced))
  301. ((string=? line ")")
  302. ;; end of block, coming back to toplevel
  303. (toplevel requirements replaced))
  304. (#t
  305. (call-with-values (lambda ()
  306. (replace-directive requirements replaced line))
  307. in-replace)))))
  308. (define (replace-directive requirements replaced line)
  309. "Extract replaced modules and new requirements from the replace directive
  310. in LINE and add them to the REQUIREMENTS and REPLACED lists."
  311. (let* ((rx-match (regexp-exec %go.mod-replace-directive-rx line))
  312. (module-path (match:substring rx-match 1))
  313. (version (match:substring rx-match 3))
  314. (new-module-path (match:substring rx-match 4))
  315. (new-version (match:substring rx-match 6))
  316. (new-replaced (cons (list module-path version) replaced))
  317. (new-requirements
  318. (if (string-match "^\\.?\\./" new-module-path)
  319. requirements
  320. (cons (list new-module-path new-version) requirements))))
  321. (values new-requirements new-replaced)))
  322. (define (require-directive requirements replaced line)
  323. "Extract requirement from LINE and augment the REQUIREMENTS and REPLACED
  324. lists."
  325. (let* ((rx-match (regexp-exec %go.mod-require-directive-rx line))
  326. (module-path (match:substring rx-match 1))
  327. ;; Double-quoted strings were seen in the wild without escape
  328. ;; sequences; trim the quotes to be on the safe side.
  329. (module-path (string-trim-both module-path #\"))
  330. (version (match:substring rx-match 2)))
  331. (values (cons (list module-path version) requirements) replaced)))
  332. (with-input-from-string content
  333. (lambda ()
  334. (receive (requirements replaced)
  335. (toplevel '() '())
  336. ;; At last remove the replaced modules from the requirements list.
  337. (remove (lambda (r)
  338. (assoc (car r) replaced))
  339. requirements)))))
  340. ;; Prevent inlining of this procedure, which is accessed by unit tests.
  341. (set! parse-go.mod parse-go.mod)
  342. (define-record-type <vcs>
  343. (%make-vcs url-prefix root-regex type)
  344. vcs?
  345. (url-prefix vcs-url-prefix)
  346. (root-regex vcs-root-regex)
  347. (type vcs-type))
  348. (define (make-vcs prefix regexp type)
  349. (%make-vcs prefix (make-regexp regexp) type))
  350. (define known-vcs
  351. ;; See the following URL for the official Go equivalent:
  352. ;; https://github.com/golang/go/blob/846dce9d05f19a1f53465e62a304dea21b99f910/src/cmd/go/internal/vcs/vcs.go#L1026-L1087
  353. (list
  354. (make-vcs
  355. "github.com"
  356. "^(github\\.com/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
  357. 'git)
  358. (make-vcs
  359. "bitbucket.org"
  360. "^(bitbucket\\.org/([A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+))(/[A-Za-z0-9_.\\-]+)*$"
  361. 'unknown)
  362. (make-vcs
  363. "hub.jazz.net/git/"
  364. "^(hub\\.jazz\\.net/git/[a-z0-9]+/[A-Za-z0-9_.\\-]+)(/[A-Za-z0-9_.\\-]+)*$"
  365. 'git)
  366. (make-vcs
  367. "git.apache.org"
  368. "^(git\\.apache\\.org/[a-z0-9_.\\-]+\\.git)(/[A-Za-z0-9_.\\-]+)*$"
  369. 'git)
  370. (make-vcs
  371. "git.openstack.org"
  372. "^(git\\.openstack\\.org/[A-Za-z0-9_.\\-]+/[A-Za-z0-9_.\\-]+)(\\.git)?\
  373. (/[A-Za-z0-9_.\\-]+)*$"
  374. 'git)))
  375. (define (module-path->repository-root module-path)
  376. "Infer the repository root from a module path. Go modules can be
  377. defined at any level of a repository tree, but querying for the meta tag
  378. usually can only be done from the web page at the root of the repository,
  379. hence the need to derive this information."
  380. ;; For reference, see: https://golang.org/ref/mod#vcs-find.
  381. (define vcs-qualifiers '(".bzr" ".fossil" ".git" ".hg" ".svn"))
  382. (define (vcs-qualified-module-path->root-repo-url module-path)
  383. (let* ((vcs-qualifiers-group (string-join vcs-qualifiers "|"))
  384. (pattern (format #f "^(.*(~a))(/|$)" vcs-qualifiers-group))
  385. (m (string-match pattern module-path)))
  386. (and=> m (cut match:substring <> 1))))
  387. (or (and=> (find (lambda (vcs)
  388. (string-prefix? (vcs-url-prefix vcs) module-path))
  389. known-vcs)
  390. (lambda (vcs)
  391. (match:substring (regexp-exec (vcs-root-regex vcs)
  392. module-path) 1)))
  393. (vcs-qualified-module-path->root-repo-url module-path)
  394. module-path))
  395. (define* (go-module->guix-package-name module-path #:optional version)
  396. "Converts a module's path to the canonical Guix format for Go packages.
  397. Optionally include a VERSION string to append to the name."
  398. ;; Map dot, slash and underscore characters to hyphens.
  399. (let ((module-path* (string-map (lambda (c)
  400. (if (member c '(#\. #\/ #\_))
  401. #\-
  402. c))
  403. module-path)))
  404. (string-downcase (string-append "go-" module-path*
  405. (if version
  406. (string-append "-" version)
  407. "")))))
  408. (define (strip-.git-suffix/maybe repo-url)
  409. "Strip a repository URL '.git' suffix from REPO-URL if hosted at GitHub."
  410. (match repo-url
  411. ((and (? (cut string-prefix? "https://github.com" <>))
  412. (? (cut string-suffix? ".git" <>)))
  413. (string-drop-right repo-url 4))
  414. (_ repo-url)))
  415. (define-record-type <module-meta>
  416. (make-module-meta import-prefix vcs repo-root)
  417. module-meta?
  418. (import-prefix module-meta-import-prefix)
  419. (vcs module-meta-vcs) ;a symbol
  420. (repo-root module-meta-repo-root))
  421. (define (fetch-module-meta-data module-path)
  422. "Retrieve the module meta-data from its landing page. This is necessary
  423. because goproxy servers don't currently provide all the information needed to
  424. build a package."
  425. ;; <meta name="go-import" content="import-prefix vcs repo-root">
  426. (let* ((meta-data (http-fetch* (format #f "https://~a?go-get=1" module-path)))
  427. (select (sxpath `(// head (meta (@ (equal? (name "go-import"))))
  428. // content))))
  429. (match (select (html->sxml meta-data))
  430. (() #f) ;nothing selected
  431. (((content content-text))
  432. (match (string-split content-text #\space)
  433. ((root-path vcs repo-url)
  434. (make-module-meta root-path (string->symbol vcs)
  435. (strip-.git-suffix/maybe repo-url))))))))
  436. (define (module-meta-data-repo-url meta-data goproxy)
  437. "Return the URL where the fetcher which will be used can download the
  438. source."
  439. (if (member (module-meta-vcs meta-data) '(fossil mod))
  440. goproxy
  441. (module-meta-repo-root meta-data)))
  442. ;; XXX: Copied from (guix scripts hash).
  443. (define (vcs-file? file stat)
  444. (case (stat:type stat)
  445. ((directory)
  446. (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
  447. ((regular)
  448. ;; Git sub-modules have a '.git' file that is a regular text file.
  449. (string=? (basename file) ".git"))
  450. (else
  451. #f)))
  452. ;; XXX: Adapted from 'file-hash' in (guix scripts hash).
  453. (define* (file-hash file #:optional (algorithm (hash-algorithm sha256)))
  454. ;; Compute the hash of FILE.
  455. (let-values (((port get-hash) (open-hash-port algorithm)))
  456. (write-file file port #:select? (negate vcs-file?))
  457. (force-output port)
  458. (get-hash)))
  459. (define* (git-checkout-hash url reference algorithm)
  460. "Return the ALGORITHM hash of the checkout of URL at REFERENCE, a commit or
  461. tag."
  462. (define cache
  463. (string-append (or (getenv "TMPDIR") "/tmp")
  464. "/guix-import-go-"
  465. (passwd:name (getpwuid (getuid)))))
  466. ;; Use a custom cache to avoid cluttering the default one under
  467. ;; ~/.cache/guix, but choose one under /tmp so that it's persistent across
  468. ;; subsequent "guix import" invocations.
  469. (mkdir-p cache)
  470. (chmod cache #o700)
  471. (let-values (((checkout commit _)
  472. (parameterize ((%repository-cache-directory cache))
  473. (update-cached-checkout url
  474. #:ref
  475. `(tag-or-commit . ,reference)))))
  476. (file-hash checkout algorithm)))
  477. (define (vcs->origin vcs-type vcs-repo-url version)
  478. "Generate the `origin' block of a package depending on what type of source
  479. control system is being used."
  480. (case vcs-type
  481. ((git)
  482. (let ((plain-version? (string=? version (go-version->git-ref version)))
  483. (v-prefixed? (string-prefix? "v" version)))
  484. `(origin
  485. (method git-fetch)
  486. (uri (git-reference
  487. (url ,vcs-repo-url)
  488. ;; This is done because the version field of the package,
  489. ;; which the generated quoted expression refers to, has been
  490. ;; stripped of any 'v' prefixed.
  491. (commit ,(if (and plain-version? v-prefixed?)
  492. '(string-append "v" version)
  493. '(go-version->git-ref version)))))
  494. (file-name (git-file-name name version))
  495. (sha256
  496. (base32
  497. ,(bytevector->nix-base32-string
  498. (git-checkout-hash vcs-repo-url (go-version->git-ref version)
  499. (hash-algorithm sha256))))))))
  500. ((hg)
  501. `(origin
  502. (method hg-fetch)
  503. (uri (hg-reference
  504. (url ,vcs-repo-url)
  505. (changeset ,version)))
  506. (file-name (string-append name "-" version "-checkout"))
  507. (sha256
  508. (base32
  509. ;; FIXME: populate hash for hg repo checkout
  510. "0000000000000000000000000000000000000000000000000000"))))
  511. ((svn)
  512. `(origin
  513. (method svn-fetch)
  514. (uri (svn-reference
  515. (url ,vcs-repo-url)
  516. (revision (string->number version))))
  517. (file-name (string-append name "-" version "-checkout"))
  518. (sha256
  519. (base32
  520. ;; FIXME: populate hash for svn repo checkout
  521. "0000000000000000000000000000000000000000000000000000"))))
  522. (else
  523. (raise
  524. (formatted-message (G_ "unsupported vcs type '~a' for package '~a'")
  525. vcs-type vcs-repo-url)))))
  526. (define* (go-module->guix-package module-path #:key
  527. (goproxy "https://proxy.golang.org")
  528. version
  529. pin-versions?)
  530. "Return the package S-expression corresponding to MODULE-PATH at VERSION, a Go package.
  531. The meta-data is fetched from the GOPROXY server and https://pkg.go.dev/.
  532. When VERSION is unspecified, the latest version available is used."
  533. (let* ((available-versions (go-module-available-versions goproxy module-path))
  534. (version* (or version
  535. (go-module-version-string goproxy module-path))) ;latest
  536. ;; Elide the "v" prefix Go uses.
  537. (strip-v-prefix (cut string-trim <> #\v))
  538. ;; Pseudo-versions do not appear in the versions list; skip the
  539. ;; following check.
  540. (_ (unless (or (go-pseudo-version? version*)
  541. (member version* available-versions))
  542. (error (format #f "error: version ~s is not available
  543. hint: use one of the following available versions ~a\n"
  544. version* available-versions))))
  545. (content (fetch-go.mod goproxy module-path version*))
  546. (dependencies+versions (parse-go.mod content))
  547. (dependencies (if pin-versions?
  548. dependencies+versions
  549. (map car dependencies+versions)))
  550. (guix-name (go-module->guix-package-name module-path))
  551. (root-module-path (module-path->repository-root module-path))
  552. ;; The VCS type and URL are not included in goproxy information. For
  553. ;; this we need to fetch it from the official module page.
  554. (meta-data (fetch-module-meta-data root-module-path))
  555. (vcs-type (module-meta-vcs meta-data))
  556. (vcs-repo-url (module-meta-data-repo-url meta-data goproxy))
  557. (synopsis (go-package-synopsis root-module-path))
  558. (description (go-package-description module-path))
  559. (licenses (go-package-licenses module-path)))
  560. (values
  561. `(package
  562. (name ,guix-name)
  563. (version ,(strip-v-prefix version*))
  564. (source
  565. ,(vcs->origin vcs-type vcs-repo-url version*))
  566. (build-system go-build-system)
  567. (arguments
  568. '(#:import-path ,root-module-path))
  569. ,@(maybe-propagated-inputs
  570. (map (match-lambda
  571. ((name version)
  572. (go-module->guix-package-name name (strip-v-prefix version)))
  573. (name
  574. (go-module->guix-package-name name)))
  575. dependencies))
  576. (home-page ,(format #f "https://~a" root-module-path))
  577. (synopsis ,synopsis)
  578. (description ,(and=> description beautify-description))
  579. (license ,(match (list->licenses licenses)
  580. (() #f) ;unknown license
  581. ((license) ;a single license
  582. license)
  583. ((license ...) ;a list of licenses
  584. `(list ,@license)))))
  585. (if pin-versions?
  586. dependencies+versions
  587. dependencies))))
  588. (define go-module->guix-package* (memoize go-module->guix-package))
  589. (define* (go-module-recursive-import package-name
  590. #:key (goproxy "https://proxy.golang.org")
  591. version
  592. pin-versions?)
  593. (recursive-import
  594. package-name
  595. #:repo->guix-package
  596. (lambda* (name #:key version repo)
  597. ;; Disable output buffering so that the following warning gets printed
  598. ;; consistently.
  599. (setvbuf (current-error-port) 'none)
  600. (guard (c ((http-get-error? c)
  601. (warning (G_ "Failed to import package ~s.
  602. reason: ~s could not be fetched: HTTP error ~a (~s).
  603. This package and its dependencies won't be imported.~%")
  604. name
  605. (uri->string (http-get-error-uri c))
  606. (http-get-error-code c)
  607. (http-get-error-reason c))
  608. (values '() '())))
  609. (receive (package-sexp dependencies)
  610. (go-module->guix-package* name #:goproxy goproxy
  611. #:version version
  612. #:pin-versions? pin-versions?)
  613. (values package-sexp dependencies))))
  614. #:guix-name go-module->guix-package-name
  615. #:version version))