go.scm 28 KB

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