You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

123 lines
4.1 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
  3. ;;;
  4. ;;; This file is part of GNU Guix.
  5. ;;;
  6. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 3 of the License, or (at
  9. ;;; your option) any later version.
  10. ;;;
  11. ;;; GNU Guix is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (guix scripts download)
  19. #:use-module (guix ui)
  20. #:use-module (guix store)
  21. #:use-module (guix hash)
  22. #:use-module (guix utils)
  23. #:use-module (guix base32)
  24. #:use-module (guix download)
  25. #:use-module (web uri)
  26. #:use-module (ice-9 match)
  27. #:use-module (srfi srfi-1)
  28. #:use-module (srfi srfi-37)
  29. #:use-module (rnrs bytevectors)
  30. #:use-module (rnrs io ports)
  31. #:export (guix-download))
  32. ;;;
  33. ;;; Command-line options.
  34. ;;;
  35. (define %default-options
  36. ;; Alist of default option values.
  37. `((format . ,bytevector->nix-base32-string)))
  38. (define (show-help)
  39. (display (_ "Usage: guix download [OPTION] URL
  40. Download the file at URL, add it to the store, and print its store path
  41. and the hash of its contents.
  42. Supported formats: 'nix-base32' (default), 'base32', and 'base16'
  43. ('hex' and 'hexadecimal' can be used as well).\n"))
  44. (format #t (_ "
  45. -f, --format=FMT write the hash in the given format"))
  46. (newline)
  47. (display (_ "
  48. -h, --help display this help and exit"))
  49. (display (_ "
  50. -V, --version display version information and exit"))
  51. (newline)
  52. (show-bug-report-information))
  53. (define %options
  54. ;; Specifications of the command-line options.
  55. (list (option '(#\f "format") #t #f
  56. (lambda (opt name arg result)
  57. (define fmt-proc
  58. (match arg
  59. ("nix-base32"
  60. bytevector->nix-base32-string)
  61. ("base32"
  62. bytevector->base32-string)
  63. ((or "base16" "hex" "hexadecimal")
  64. bytevector->base16-string)
  65. (x
  66. (leave (_ "unsupported hash format: ~a~%") arg))))
  67. (alist-cons 'format fmt-proc
  68. (alist-delete 'format result))))
  69. (option '(#\h "help") #f #f
  70. (lambda args
  71. (show-help)
  72. (exit 0)))
  73. (option '(#\V "version") #f #f
  74. (lambda args
  75. (show-version-and-exit "guix download")))))
  76. ;;;
  77. ;;; Entry point.
  78. ;;;
  79. (define (guix-download . args)
  80. (define (parse-options)
  81. ;; Return the alist of option values.
  82. (args-fold* args %options
  83. (lambda (opt name arg result)
  84. (leave (_ "~A: unrecognized option~%") name))
  85. (lambda (arg result)
  86. (alist-cons 'argument arg result))
  87. %default-options))
  88. (with-error-handling
  89. (let* ((opts (parse-options))
  90. (store (open-connection))
  91. (arg (assq-ref opts 'argument))
  92. (uri (or (string->uri arg)
  93. (leave (_ "~a: failed to parse URI~%")
  94. arg)))
  95. (path (case (uri-scheme uri)
  96. ((file)
  97. (add-to-store store (basename (uri-path uri))
  98. #f "sha256" (uri-path uri)))
  99. (else
  100. (download-to-store store (uri->string uri)
  101. (basename (uri-path uri))))))
  102. (hash (call-with-input-file
  103. (or path
  104. (leave (_ "~a: download failed~%")
  105. arg))
  106. port-sha256))
  107. (fmt (assq-ref opts 'format)))
  108. (format #t "~a~%~a~%" path (fmt hash))
  109. #t)))