swh.scm 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
  3. ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
  4. ;;;
  5. ;;; This file is part of GNU Guix.
  6. ;;;
  7. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  8. ;;; under the terms of the GNU General Public License as published by
  9. ;;; the Free Software Foundation; either version 3 of the License, or (at
  10. ;;; your option) any later version.
  11. ;;;
  12. ;;; GNU Guix is distributed in the hope that it will be useful, but
  13. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;;; GNU General Public License for more details.
  16. ;;;
  17. ;;; You should have received a copy of the GNU General Public License
  18. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  19. (define-module (guix swh)
  20. #:use-module (guix base16)
  21. #:use-module (guix build utils)
  22. #:use-module ((guix build syscalls) #:select (mkdtemp!))
  23. #:use-module (web uri)
  24. #:use-module (web client)
  25. #:use-module (web response)
  26. #:use-module (json)
  27. #:use-module (srfi srfi-1)
  28. #:use-module (srfi srfi-9)
  29. #:use-module (srfi srfi-11)
  30. #:use-module (srfi srfi-19)
  31. #:use-module (ice-9 match)
  32. #:use-module (ice-9 regex)
  33. #:use-module (ice-9 popen)
  34. #:use-module ((ice-9 ftw) #:select (scandir))
  35. #:export (%swh-base-url
  36. %verify-swh-certificate?
  37. %allow-request?
  38. request-rate-limit-reached?
  39. origin?
  40. origin-type
  41. origin-url
  42. origin-visits
  43. lookup-origin
  44. visit?
  45. visit-date
  46. visit-origin
  47. visit-url
  48. visit-snapshot-url
  49. visit-status
  50. visit-number
  51. visit-snapshot
  52. branch?
  53. branch-name
  54. branch-target
  55. release?
  56. release-id
  57. release-name
  58. release-message
  59. release-target
  60. revision?
  61. revision-id
  62. revision-date
  63. revision-directory
  64. lookup-revision
  65. lookup-origin-revision
  66. content?
  67. content-checksums
  68. content-data-url
  69. content-length
  70. lookup-content
  71. directory-entry?
  72. directory-entry-name
  73. directory-entry-type
  74. directory-entry-checksums
  75. directory-entry-length
  76. directory-entry-permissions
  77. lookup-directory
  78. directory-entry-target
  79. save-reply?
  80. save-reply-origin-url
  81. save-reply-origin-type
  82. save-reply-request-date
  83. save-reply-request-status
  84. save-reply-task-status
  85. save-origin
  86. save-origin-status
  87. vault-reply?
  88. vault-reply-id
  89. vault-reply-fetch-url
  90. vault-reply-object-id
  91. vault-reply-object-type
  92. vault-reply-progress-message
  93. vault-reply-status
  94. query-vault
  95. request-cooking
  96. vault-fetch
  97. commit-id?
  98. swh-download-directory
  99. swh-download))
  100. ;;; Commentary:
  101. ;;;
  102. ;;; This module provides bindings to the HTTP interface of Software Heritage.
  103. ;;; It allows you to browse the archive, look up revisions (such as SHA1
  104. ;;; commit IDs), "origins" (code hosting URLs), content (files), etc. See
  105. ;;; <https://archive.softwareheritage.org/api/> for more information.
  106. ;;;
  107. ;;; The high-level 'swh-download' procedure allows you to download a Git
  108. ;;; revision from Software Heritage, provided it is available.
  109. ;;;
  110. ;;; Code:
  111. (define %swh-base-url
  112. ;; Presumably we won't need to change it.
  113. (make-parameter "https://archive.softwareheritage.org"))
  114. (define %verify-swh-certificate?
  115. ;; Whether to verify the X.509 HTTPS certificate for %SWH-BASE-URL.
  116. (make-parameter #t))
  117. (define (swh-url path . rest)
  118. ;; URLs returned by the API may be relative or absolute. This has changed
  119. ;; without notice before. Handle both cases by detecting whether the path
  120. ;; starts with a domain.
  121. (define root
  122. (if (string-prefix? "/" path)
  123. (string-append (%swh-base-url) path)
  124. path))
  125. (define url
  126. (string-append root (string-join rest "/" 'prefix)))
  127. ;; Ensure there's a trailing slash or we get a redirect.
  128. (if (string-suffix? "/" url)
  129. url
  130. (string-append url "/")))
  131. ;; XXX: Work around a bug in Guile 3.0.2 where #:verify-certificate? would
  132. ;; be ignored (<https://bugs.gnu.org/40486>).
  133. (define* (http-get* uri #:rest rest)
  134. (apply http-request uri #:method 'GET rest))
  135. (define* (http-post* uri #:rest rest)
  136. (apply http-request uri #:method 'POST rest))
  137. (define %date-regexp
  138. ;; Match strings like "2014-11-17T22:09:38+01:00" or
  139. ;; "2018-09-30T23:20:07.815449+00:00"".
  140. (make-regexp "^([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})((\\.[0-9]+)?)([+-][0-9]{2}):([0-9]{2})$"))
  141. (define (string->date* str)
  142. "Return a SRFI-19 date parsed from STR, a date string as returned by
  143. Software Heritage."
  144. ;; We can't use 'string->date' because of the timezone format: SWH returns
  145. ;; "+01:00" when the '~z' template expects "+0100". So we roll our own!
  146. (or (and=> (regexp-exec %date-regexp str)
  147. (lambda (match)
  148. (define (ref n)
  149. (string->number (match:substring match n)))
  150. (make-date (let ((ns (match:substring match 8)))
  151. (if ns
  152. (string->number (string-drop ns 1))
  153. 0))
  154. (ref 6) (ref 5) (ref 4)
  155. (ref 3) (ref 2) (ref 1)
  156. (+ (* 3600 (ref 9)) ;time zone
  157. (if (< (ref 9) 0)
  158. (- (ref 10))
  159. (ref 10))))))
  160. str)) ;oops!
  161. (define string*
  162. ;; Converts "string or #nil" coming from JSON to "string or #f".
  163. (match-lambda
  164. ((? string? str) str)
  165. ((? null?) #f) ;Guile-JSON 3.x
  166. ('null #f))) ;Guile-JSON 4.x
  167. (define %allow-request?
  168. ;; Takes a URL and method (e.g., the 'http-get' procedure) and returns true
  169. ;; to keep going. This can be used to disallow requests when
  170. ;; 'request-rate-limit-reached?' returns true, for instance.
  171. (make-parameter (const #t)))
  172. ;; The time when the rate limit for "/origin/save" POST requests and that of
  173. ;; other requests will be reset.
  174. ;; See <https://archive.softwareheritage.org/api/#rate-limiting>.
  175. (define %save-rate-limit-reset-time 0)
  176. (define %general-rate-limit-reset-time 0)
  177. (define (request-rate-limit-reached? url method)
  178. "Return true if the rate limit has been reached for URI."
  179. (define uri
  180. (string->uri url))
  181. (define reset-time
  182. (if (and (eq? method http-post*)
  183. (string-prefix? "/api/1/origin/save/" (uri-path uri)))
  184. %save-rate-limit-reset-time
  185. %general-rate-limit-reset-time))
  186. (< (car (gettimeofday)) reset-time))
  187. (define (update-rate-limit-reset-time! url method response)
  188. "Update the rate limit reset time for URL and METHOD based on the headers in
  189. RESPONSE."
  190. (let ((uri (string->uri url)))
  191. (match (assq-ref (response-headers response) 'x-ratelimit-reset)
  192. ((= string->number (? number? reset))
  193. (if (and (eq? method http-post*)
  194. (string-prefix? "/api/1/origin/save/" (uri-path uri)))
  195. (set! %save-rate-limit-reset-time reset)
  196. (set! %general-rate-limit-reset-time reset)))
  197. (_
  198. #f))))
  199. (define* (call url decode #:optional (method http-get*)
  200. #:key (false-if-404? #t))
  201. "Invoke the endpoint at URL using METHOD. Decode the resulting JSON body
  202. using DECODE, a one-argument procedure that takes an input port. When
  203. FALSE-IF-404? is true, return #f upon 404 responses."
  204. (and ((%allow-request?) url method)
  205. (let*-values (((response port)
  206. (method url #:streaming? #t
  207. #:verify-certificate?
  208. (%verify-swh-certificate?))))
  209. ;; See <https://archive.softwareheritage.org/api/#rate-limiting>.
  210. (match (assq-ref (response-headers response) 'x-ratelimit-remaining)
  211. (#f #t)
  212. ((? (compose zero? string->number))
  213. (update-rate-limit-reset-time! url method response)
  214. (throw 'swh-error url method response))
  215. (_ #t))
  216. (cond ((= 200 (response-code response))
  217. (let ((result (decode port)))
  218. (close-port port)
  219. result))
  220. ((and false-if-404?
  221. (= 404 (response-code response)))
  222. (close-port port)
  223. #f)
  224. (else
  225. (close-port port)
  226. (throw 'swh-error url method response))))))
  227. (define-syntax define-query
  228. (syntax-rules (path)
  229. "Define a procedure that performs a Software Heritage query."
  230. ((_ (name args ...) docstring (path components ...)
  231. json->value)
  232. (define (name args ...)
  233. docstring
  234. (call (swh-url components ...) json->value)))))
  235. ;; <https://archive.softwareheritage.org/api/1/origin/https://github.com/guix-mirror/guix/get>
  236. (define-json-mapping <origin> make-origin origin?
  237. json->origin
  238. (visits-url origin-visits-url "origin_visits_url")
  239. (type origin-type)
  240. (url origin-url))
  241. ;; <https://archive.softwareheritage.org/api/1/origin/52181937/visits/>
  242. (define-json-mapping <visit> make-visit visit?
  243. json->visit
  244. (date visit-date "date" string->date*)
  245. (origin visit-origin)
  246. (url visit-url "origin_visit_url")
  247. (snapshot-url visit-snapshot-url "snapshot_url" string*) ;string | #f
  248. (status visit-status "status" string->symbol) ;'full | 'partial | 'ongoing
  249. (number visit-number "visit"))
  250. ;; <https://archive.softwareheritage.org/api/1/snapshot/4334c3ed4bb208604ed780d8687fe523837f1bd1/>
  251. (define-json-mapping <snapshot> make-snapshot snapshot?
  252. json->snapshot
  253. (branches snapshot-branches "branches" json->branches))
  254. ;; This is used for the "branches" field of snapshots.
  255. (define-record-type <branch>
  256. (make-branch name target-type target-url)
  257. branch?
  258. (name branch-name)
  259. (target-type branch-target-type) ;release | revision
  260. (target-url branch-target-url))
  261. (define (json->branches branches)
  262. (map (match-lambda
  263. ((key . value)
  264. (make-branch key
  265. (string->symbol
  266. (assoc-ref value "target_type"))
  267. (assoc-ref value "target_url"))))
  268. branches))
  269. ;; <https://archive.softwareheritage.org/api/1/release/1f44934fb6e2cefccbecd4fa347025349fa9ff76/>
  270. (define-json-mapping <release> make-release release?
  271. json->release
  272. (id release-id)
  273. (name release-name)
  274. (message release-message)
  275. (target-type release-target-type "target_type" string->symbol)
  276. (target-url release-target-url "target_url"))
  277. ;; <https://archive.softwareheritage.org/api/1/revision/359fdda40f754bbf1b5dc261e7427b75463b59be/>
  278. (define-json-mapping <revision> make-revision revision?
  279. json->revision
  280. (id revision-id)
  281. (date revision-date "date" string->date*)
  282. (directory revision-directory)
  283. (directory-url revision-directory-url "directory_url"))
  284. ;; <https://archive.softwareheritage.org/api/1/content/>
  285. (define-json-mapping <content> make-content content?
  286. json->content
  287. (checksums content-checksums "checksums" json->checksums)
  288. (data-url content-data-url "data_url")
  289. (file-type-url content-file-type-url "filetype_url")
  290. (language-url content-language-url "language_url")
  291. (length content-length)
  292. (license-url content-license-url "license_url"))
  293. (define (json->checksums checksums)
  294. (map (match-lambda
  295. ((key . value)
  296. (cons key (base16-string->bytevector value))))
  297. checksums))
  298. ;; <https://archive.softwareheritage.org/api/1/directory/27c69c5d298a43096a53affbf881e7b13f17bdcd/>
  299. (define-json-mapping <directory-entry> make-directory-entry directory-entry?
  300. json->directory-entry
  301. (name directory-entry-name)
  302. (type directory-entry-type "type"
  303. (match-lambda
  304. ("dir" 'directory)
  305. (str (string->symbol str))))
  306. (checksums directory-entry-checksums "checksums"
  307. (match-lambda
  308. (#f #f)
  309. ((? unspecified?) #f)
  310. (lst (json->checksums lst))))
  311. (id directory-entry-id "dir_id")
  312. (length directory-entry-length)
  313. (permissions directory-entry-permissions "perms")
  314. (target-url directory-entry-target-url "target_url"))
  315. ;; <https://archive.softwareheritage.org/api/1/origin/save/>
  316. (define-json-mapping <save-reply> make-save-reply save-reply?
  317. json->save-reply
  318. (origin-url save-reply-origin-url "origin_url")
  319. (origin-type save-reply-origin-type "origin_type")
  320. (request-date save-reply-request-date "save_request_date"
  321. string->date*)
  322. (request-status save-reply-request-status "save_request_status"
  323. string->symbol)
  324. (task-status save-reply-task-status "save_task_status"
  325. (match-lambda
  326. ("not created" 'not-created)
  327. ((? string? str) (string->symbol str)))))
  328. ;; <https://docs.softwareheritage.org/devel/swh-vault/api.html#vault-api-ref>
  329. (define-json-mapping <vault-reply> make-vault-reply vault-reply?
  330. json->vault-reply
  331. (id vault-reply-id)
  332. (fetch-url vault-reply-fetch-url "fetch_url")
  333. (object-id vault-reply-object-id "obj_id")
  334. (object-type vault-reply-object-type "obj_type" string->symbol)
  335. (progress-message vault-reply-progress-message "progress_message")
  336. (status vault-reply-status "status" string->symbol))
  337. ;;;
  338. ;;; RPCs.
  339. ;;;
  340. (define-query (lookup-origin url)
  341. "Return an origin for URL."
  342. (path "/api/1/origin" url "get")
  343. json->origin)
  344. (define-query (lookup-content hash type)
  345. "Return a content for HASH, of the given TYPE--e.g., \"sha256\"."
  346. (path "/api/1/content"
  347. (string-append type ":"
  348. (bytevector->base16-string hash)))
  349. json->content)
  350. (define-query (lookup-revision id)
  351. "Return the revision with the given ID, typically a Git commit SHA1."
  352. (path "/api/1/revision" id)
  353. json->revision)
  354. (define-query (lookup-directory id)
  355. "Return the directory with the given ID."
  356. (path "/api/1/directory" id)
  357. json->directory-entries)
  358. (define (json->directory-entries port)
  359. (map json->directory-entry
  360. (vector->list (json->scm port))))
  361. (define (origin-visits origin)
  362. "Return the list of visits of ORIGIN, a record as returned by
  363. 'lookup-origin'."
  364. (call (swh-url (origin-visits-url origin))
  365. (lambda (port)
  366. (map json->visit (vector->list (json->scm port))))))
  367. (define (visit-snapshot visit)
  368. "Return the snapshot corresponding to VISIT or #f if no snapshot is
  369. available."
  370. (and (visit-snapshot-url visit)
  371. (call (swh-url (visit-snapshot-url visit))
  372. json->snapshot)))
  373. (define (branch-target branch)
  374. "Return the target of BRANCH, either a <revision> or a <release>."
  375. (match (branch-target-type branch)
  376. ('release
  377. (call (swh-url (branch-target-url branch))
  378. json->release))
  379. ('revision
  380. (call (swh-url (branch-target-url branch))
  381. json->revision))))
  382. (define (lookup-origin-revision url tag)
  383. "Return a <revision> corresponding to the given TAG for the repository
  384. coming from URL. Example:
  385. (lookup-origin-revision \"https://github.com/guix-mirror/guix/\" \"v0.8\")
  386. => #<<revision> id: \"44941…\" …>
  387. The information is based on the latest visit of URL available. Return #f if
  388. URL could not be found."
  389. (match (lookup-origin url)
  390. (#f #f)
  391. (origin
  392. (match (filter (lambda (visit)
  393. ;; Return #f if (visit-snapshot VISIT) would return #f.
  394. (and (visit-snapshot-url visit)
  395. (eq? 'full (visit-status visit))))
  396. (origin-visits origin))
  397. ((visit . _)
  398. (let ((snapshot (visit-snapshot visit)))
  399. (match (and=> (find (lambda (branch)
  400. (string=? (string-append "refs/tags/" tag)
  401. (branch-name branch)))
  402. (snapshot-branches snapshot))
  403. branch-target)
  404. ((? release? release)
  405. (release-target release))
  406. ((? revision? revision)
  407. revision)
  408. (#f ;tag not found
  409. #f))))
  410. (()
  411. #f)))))
  412. (define (release-target release)
  413. "Return the revision that is the target of RELEASE."
  414. (match (release-target-type release)
  415. ('revision
  416. (call (swh-url (release-target-url release))
  417. json->revision))))
  418. (define (directory-entry-target entry)
  419. "If ENTRY, a directory entry, has type 'directory, return its list of
  420. directory entries; if it has type 'file, return its <content> object."
  421. (call (swh-url (directory-entry-target-url entry))
  422. (match (directory-entry-type entry)
  423. ('file json->content)
  424. ('directory json->directory-entries))))
  425. (define* (save-origin url #:optional (type "git"))
  426. "Request URL to be saved."
  427. (call (swh-url "/api/1/origin/save" type "url" url) json->save-reply
  428. http-post*))
  429. (define-query (save-origin-status url type)
  430. "Return the status of a /save request for URL and TYPE (e.g., \"git\")."
  431. (path "/api/1/origin/save" type "url" url)
  432. json->save-reply)
  433. (define-query (query-vault id kind)
  434. "Ask the availability of object ID and KIND to the vault, where KIND is
  435. 'directory or 'revision. Return #f if it could not be found, or a
  436. <vault-reply> on success."
  437. ;; <https://docs.softwareheritage.org/devel/swh-vault/api.html#vault-api-ref>
  438. ;; There's a single format supported for directories and revisions and for
  439. ;; now, the "/format" bit of the URL *must* be omitted.
  440. (path "/api/1/vault" (symbol->string kind) id)
  441. json->vault-reply)
  442. (define (request-cooking id kind)
  443. "Request the cooking of object ID and KIND (one of 'directory or 'revision)
  444. to the vault. Return a <vault-reply>."
  445. (call (swh-url "/api/1/vault" (symbol->string kind) id)
  446. json->vault-reply
  447. http-post*))
  448. (define* (vault-fetch id kind
  449. #:key (log-port (current-error-port)))
  450. "Return an input port from which a bundle of the object with the given ID
  451. and KIND (one of 'directory or 'revision) can be retrieved, or #f if the
  452. object could not be found.
  453. For a directory, the returned stream is a gzip-compressed tarball. For a
  454. revision, it is a gzip-compressed stream for 'git fast-import'."
  455. (let loop ((reply (query-vault id kind)))
  456. (match reply
  457. (#f
  458. (and=> (request-cooking id kind) loop))
  459. (_
  460. (match (vault-reply-status reply)
  461. ('done
  462. ;; Fetch the bundle.
  463. (let-values (((response port)
  464. (http-get* (swh-url (vault-reply-fetch-url reply))
  465. #:streaming? #t
  466. #:verify-certificate?
  467. (%verify-swh-certificate?))))
  468. (if (= (response-code response) 200)
  469. port
  470. (begin ;shouldn't happen
  471. (close-port port)
  472. #f))))
  473. ('failed
  474. ;; Upon failure, we're supposed to try again.
  475. (format log-port "SWH vault: failure: ~a~%"
  476. (vault-reply-progress-message reply))
  477. (format log-port "SWH vault: retrying...~%")
  478. (loop (request-cooking id kind)))
  479. ((and (or 'new 'pending) status)
  480. ;; Wait until the bundle shows up.
  481. (let ((message (vault-reply-progress-message reply)))
  482. (when (eq? 'new status)
  483. (format log-port "SWH vault: \
  484. requested bundle cooking, waiting for completion...~%"))
  485. (when (string? message)
  486. (format log-port "SWH vault: ~a~%" message))
  487. ;; Wait long enough so we don't exhaust our maximum number of
  488. ;; requests per hour too fast (as of this writing, the limit is 60
  489. ;; requests per hour per IP address.)
  490. (sleep (if (eq? status 'new) 60 30))
  491. (loop (query-vault id kind)))))))))
  492. ;;;
  493. ;;; High-level interface.
  494. ;;;
  495. (define (call-with-temporary-directory proc) ;FIXME: factorize
  496. "Call PROC with a name of a temporary directory; close the directory and
  497. delete it when leaving the dynamic extent of this call."
  498. (let* ((directory (or (getenv "TMPDIR") "/tmp"))
  499. (template (string-append directory "/guix-directory.XXXXXX"))
  500. (tmp-dir (mkdtemp! template)))
  501. (dynamic-wind
  502. (const #t)
  503. (lambda ()
  504. (proc tmp-dir))
  505. (lambda ()
  506. (false-if-exception (delete-file-recursively tmp-dir))))))
  507. (define* (swh-download-directory id output
  508. #:key (log-port (current-error-port)))
  509. "Download from Software Heritage the directory with the given ID, and
  510. unpack it to OUTPUT. Return #t on success and #f on failure"
  511. (call-with-temporary-directory
  512. (lambda (directory)
  513. (match (vault-fetch id 'directory #:log-port log-port)
  514. (#f
  515. (format log-port
  516. "SWH: directory ~a could not be fetched from the vault~%"
  517. id)
  518. #f)
  519. ((? port? input)
  520. (let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-")))
  521. (dump-port input tar)
  522. (close-port input)
  523. (let ((status (close-pipe tar)))
  524. (unless (zero? status)
  525. (error "tar extraction failure" status)))
  526. (match (scandir directory)
  527. (("." ".." sub-directory)
  528. (copy-recursively (string-append directory "/" sub-directory)
  529. output
  530. #:log (%make-void-port "w"))
  531. #t))))))))
  532. (define (commit-id? reference)
  533. "Return true if REFERENCE is likely a commit ID, false otherwise---e.g., if
  534. it is a tag name. This is based on a simple heuristic so use with care!"
  535. (and (= (string-length reference) 40)
  536. (string-every char-set:hex-digit reference)))
  537. (define* (swh-download url reference output
  538. #:key (log-port (current-error-port)))
  539. "Download from Software Heritage a checkout of the Git tag or commit
  540. REFERENCE originating from URL, and unpack it in OUTPUT. Return #t on success
  541. and #f on failure.
  542. This procedure uses the \"vault\", which contains \"cooked\" directories in
  543. the form of tarballs. If the requested directory is not cooked yet, it will
  544. wait until it becomes available, which could take several minutes."
  545. (match (if (commit-id? reference)
  546. (lookup-revision reference)
  547. (lookup-origin-revision url reference))
  548. ((? revision? revision)
  549. (format log-port "SWH: found revision ~a with directory at '~a'~%"
  550. (revision-id revision)
  551. (swh-url (revision-directory-url revision)))
  552. (swh-download-directory (revision-directory revision) output
  553. #:log-port log-port))
  554. (#f
  555. #f)))