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.
 
 
 
 
 
 

75 lines
2.7 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
  3. ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
  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. ;;;
  20. ;;; Download a binary file from an external source.
  21. ;;;
  22. (use-modules (ice-9 match)
  23. (web uri)
  24. (web client)
  25. (rnrs io ports)
  26. (srfi srfi-11)
  27. (guix utils)
  28. (guix hash))
  29. (define %url-base
  30. "http://alpha.gnu.org/gnu/guix/bootstrap"
  31. ;; Alternately:
  32. ;;"http://www.fdn.fr/~lcourtes/software/guix/packages"
  33. )
  34. ;; XXX: Work around <http://bugs.gnu.org/13095>, present in Guile
  35. ;; up to 2.0.7.
  36. (module-define! (resolve-module '(web client))
  37. 'shutdown (const #f))
  38. (define (file-name->uri file)
  39. "Return the URI for FILE."
  40. (match (string-tokenize file (char-set-complement (char-set #\/)))
  41. ((_ ... system basename)
  42. (string->uri (string-append %url-base "/" system
  43. (match system
  44. ("armhf-linux"
  45. "/20150101/")
  46. (_
  47. "/20131110/"))
  48. basename)))))
  49. (match (command-line)
  50. ((_ file expected-hash)
  51. (let ((uri (file-name->uri file)))
  52. (format #t "downloading file `~a' from `~a'...~%"
  53. file (uri->string uri))
  54. (let*-values (((resp data) (http-get uri #:decode-body? #f))
  55. ((hash) (bytevector->base16-string (sha256 data)))
  56. ((part) (string-append file ".part")))
  57. (if (string=? expected-hash hash)
  58. (begin
  59. (call-with-output-file part
  60. (lambda (port)
  61. (put-bytevector port data)))
  62. (rename-file part file))
  63. (begin
  64. (format (current-error-port)
  65. "file at `~a' has SHA256 ~a; expected ~a~%"
  66. (uri->string uri) hash expected-hash)
  67. (exit 1)))))))