cvs-download.scm 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
  3. ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
  4. ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
  5. ;;;
  6. ;;; This file is part of GNU Guix.
  7. ;;;
  8. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  9. ;;; under the terms of the GNU General Public License as published by
  10. ;;; the Free Software Foundation; either version 3 of the License, or (at
  11. ;;; your option) any later version.
  12. ;;;
  13. ;;; GNU Guix is distributed in the hope that it will be useful, but
  14. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;;; GNU General Public License for more details.
  17. ;;;
  18. ;;; You should have received a copy of the GNU General Public License
  19. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  20. (define-module (guix cvs-download)
  21. #:use-module (guix records)
  22. #:use-module (guix gexp)
  23. #:use-module (guix store)
  24. #:use-module (guix monads)
  25. #:use-module (guix modules)
  26. #:use-module (guix packages)
  27. #:use-module (ice-9 match)
  28. #:export (cvs-reference
  29. cvs-reference?
  30. cvs-reference-root-directory
  31. cvs-reference-module
  32. cvs-reference-revision
  33. cvs-fetch))
  34. ;;; Commentary:
  35. ;;;
  36. ;;; An <origin> method that fetches a specific revision or date from a CVS
  37. ;;; repository. The CVS-ROOT-DIRECTORY, MODULE and REVISION are specified
  38. ;;; with a <cvs-reference> object. REVISION should be specified as either a
  39. ;;; date string in ISO-8601 format (e.g. "2012-12-21") or a CVS tag.
  40. ;;;
  41. ;;; Code:
  42. (define-record-type* <cvs-reference>
  43. cvs-reference make-cvs-reference
  44. cvs-reference?
  45. (root-directory cvs-reference-root-directory) ; string
  46. (module cvs-reference-module) ; string
  47. (revision cvs-reference-revision)) ; string
  48. (define (cvs-package)
  49. "Return the default CVS package."
  50. (let ((distro (resolve-interface '(gnu packages version-control))))
  51. (module-ref distro 'cvs)))
  52. (define* (cvs-fetch ref hash-algo hash
  53. #:optional name
  54. #:key (system (%current-system)) (guile (default-guile))
  55. (cvs (cvs-package)))
  56. "Return a fixed-output derivation that fetches REF, a <cvs-reference>
  57. object. The output is expected to have recursive hash HASH of type
  58. HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
  59. (define guile-lzlib
  60. (module-ref (resolve-interface '(gnu packages guile)) 'guile-lzlib))
  61. (define guile-json
  62. (module-ref (resolve-interface '(gnu packages guile)) 'guile-json-4))
  63. (define gnutls
  64. (module-ref (resolve-interface '(gnu packages tls)) 'guile-gnutls))
  65. (define modules
  66. (delete '(guix config)
  67. (source-module-closure '((guix build cvs)
  68. (guix build download-nar)))))
  69. (define build
  70. (with-imported-modules modules
  71. (with-extensions (list guile-json gnutls ;for (guix swh)
  72. guile-lzlib)
  73. #~(begin
  74. (use-modules (guix build cvs)
  75. (guix build download-nar))
  76. (or (cvs-fetch '#$(cvs-reference-root-directory ref)
  77. '#$(cvs-reference-module ref)
  78. '#$(cvs-reference-revision ref)
  79. #$output
  80. #:cvs-command (string-append #+cvs "/bin/cvs"))
  81. (download-nar #$output))))))
  82. (mlet %store-monad ((guile (package->derivation guile system)))
  83. (gexp->derivation (or name "cvs-checkout") build
  84. #:leaked-env-vars '("http_proxy" "https_proxy"
  85. "LC_ALL" "LC_MESSAGES" "LANG"
  86. "COLUMNS")
  87. #:system system
  88. #:hash-algo hash-algo
  89. #:hash hash
  90. #:recursive? #t
  91. #:guile-for-build guile
  92. #:local-build? #t)))
  93. ;;; cvs-download.scm ends here