executable_clone-gitlab-swh.scm 6.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  1. #!/usr/bin/env -S guile --no-auto-compile -e main -s
  2. !#
  3. ;; GITLAB_URL=https://gitlab.softwareheritage.org
  4. (use-modules (ice-9 format)
  5. (ice-9 match)
  6. (ice-9 popen)
  7. (ice-9 rdelim)
  8. (json)
  9. (srfi srfi-1)
  10. (ice-9 pretty-print)
  11. (guix build utils))
  12. (define gitlab-url
  13. (and=> (getenv "GITLAB_URL")
  14. (lambda (gitlab-url)
  15. gitlab-url)))
  16. (define gitlab-token
  17. (and=> (getenv "GITLAB_TOKEN")
  18. (lambda (gitlab-token)
  19. gitlab-token)))
  20. (define (gitlab-groups)
  21. (read-string
  22. (apply open-pipe* OPEN_READ
  23. `("curl"
  24. ,@(if gitlab-token
  25. (list "--header"
  26. (format #f "PRIVATE-TOKEN: ~a" gitlab-token))
  27. '())
  28. "--header" "Content-Type: application/json"
  29. "--silent"
  30. "--insecure"
  31. "--request" "GET"
  32. ,(string-append gitlab-url "/api/v4/groups")))))
  33. (define groups
  34. #f)
  35. (define gitlab-subgroups
  36. #t)
  37. (define (main . args)
  38. (map (lambda (group)
  39. (let* ((port (apply open-pipe* OPEN_READ
  40. `("curl"
  41. ,@(if gitlab-token
  42. (list "--header" (format #f "PRIVATE-TOKEN: ~a" gitlab-token))
  43. '())
  44. "--header" "Content-Type: application/json"
  45. "--silent"
  46. "--insecure"
  47. "--request" "GET"
  48. ,(string-append gitlab-url "/api/v4/groups/"
  49. (number->string (assoc-ref group "id"))
  50. (if gitlab-subgroups
  51. "/subgroups"
  52. "")))))
  53. (output (read-string port)))
  54. (close-port port)
  55. (for-each (lambda (subgroup)
  56. (let* ((port (apply open-pipe* OPEN_READ
  57. `("curl"
  58. ,@(if gitlab-token
  59. (list "--header" (format #f "PRIVATE-TOKEN: ~a" gitlab-token))
  60. '())
  61. "--header" "Content-Type: application/json"
  62. "--silent"
  63. "--insecure"
  64. "--request" "GET"
  65. ,(string-append gitlab-url "/api/v4/groups/"
  66. (number->string (assoc-ref subgroup "id"))))))
  67. (output (read-string port)))
  68. (for-each (lambda (project)
  69. (invoke "git" "grab"
  70. (assoc-ref project "http_url_to_repo")))
  71. (array->list (assoc-ref (json-string->scm output) "projects")))
  72. (close-port port)))
  73. (array->list (json-string->scm output)))
  74. (for-each (lambda (subgroup)
  75. (let* ((port (apply open-pipe* OPEN_READ
  76. `("curl"
  77. ,@(if gitlab-token
  78. (list "--header" (format #f "PRIVATE-TOKEN: ~a" gitlab-token))
  79. '())
  80. "--header" "Content-Type: application/json"
  81. "--silent"
  82. "--insecure"
  83. "--request" "GET"
  84. ,(string-append gitlab-url "/api/v4/groups/"
  85. (number->string (assoc-ref subgroup "id"))
  86. (if gitlab-subgroups
  87. "/subgroups"
  88. "")))))
  89. (output (read-string port)))
  90. (for-each (lambda (subgroup)
  91. (let* ((port (apply open-pipe* OPEN_READ
  92. `("curl"
  93. ,@(if gitlab-token
  94. (list "--header" (format #f "PRIVATE-TOKEN: ~a" gitlab-token))
  95. '())
  96. "--header" "Content-Type: application/json"
  97. "--silent"
  98. "--insecure"
  99. "--request" "GET"
  100. ,(string-append gitlab-url "/api/v4/groups/"
  101. (number->string (assoc-ref subgroup "id"))))))
  102. (output (read-string port)))
  103. (for-each (lambda (project)
  104. (invoke "git" "grab"
  105. (assoc-ref project "http_url_to_repo")))
  106. (array->list (assoc-ref (json-string->scm output) "projects")))
  107. (close-port port)))
  108. (array->list (json-string->scm output)))
  109. (close-port port)))
  110. (array->list (json-string->scm output)))))
  111. (if groups
  112. (array->list (json-string->scm (gitlab-groups)))
  113. '((("id" . 25))))))