random.scm 3.3 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586
  1. ;;; guile-gcrypt --- crypto tooling for guile
  2. ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
  3. ;;;
  4. ;;; This file is part of guile-gcrypt.
  5. ;;;
  6. ;;; guile-gcrypt 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
  9. ;;; (at your option) any later version.
  10. ;;;
  11. ;;; guile-gcrypt 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 GNU
  14. ;;; General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with guile-gcrypt. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (gcrypt random)
  19. #:use-module (gcrypt common)
  20. #:use-module (gcrypt base64)
  21. #:use-module (rnrs bytevectors)
  22. #:use-module (system foreign)
  23. #:use-module (ice-9 match)
  24. #:export (%gcry-weak-random
  25. %gcry-strong-random
  26. %gcry-very-strong-random
  27. gen-random-bv
  28. random-token))
  29. (define %gcry-weak-random 0) ; not used
  30. (define %gcry-strong-random 1)
  31. (define %gcry-very-strong-random 2)
  32. (define %gcry-randomize
  33. (pointer->procedure void (libgcrypt-func "gcry_randomize")
  34. `(* ,size_t ,int))) ; buffer, length, level
  35. (define* (gen-random-bv #:optional (bv-length 50)
  36. (level %gcry-strong-random))
  37. (let* ((bv (make-bytevector bv-length))
  38. (bv-ptr (bytevector->pointer bv)))
  39. (%gcry-randomize bv-ptr bv-length %gcry-strong-random)
  40. bv))
  41. (define %gcry-create-nonce
  42. (pointer->procedure void (libgcrypt-func "gcry_create_nonce")
  43. `(* ,size_t))) ; buffer, length
  44. (define* (gen-random-nonce #:optional (bv-length 50))
  45. (let* ((bv (make-bytevector bv-length))
  46. (bv-ptr (bytevector->pointer bv)))
  47. (%gcry-create-nonce bv-ptr bv-length)
  48. bv))
  49. (define* (random-token #:optional (bv-length 30)
  50. (type 'strong))
  51. "Generate a random token.
  52. Generates a token of bytevector BV-LENGTH, default 30.
  53. The default TYPE is 'strong. Possible values are:
  54. - strong: Uses libgcrypt's gcry_randomize procedure with level
  55. GCRY_STRONG_RANDOM (\"use this level for session keys and similar
  56. purposes\").
  57. - very-strong: Also uses libgcrypt's gcry_randomize procedure with level
  58. GCRY_VERY_STRONG_RANDOM (\"Use this level for long term key material\")
  59. - nonce: Uses libgcrypt's gcry_xcreate_nonce, whose documentation I'll
  60. just quote inline:
  61. Fill BUFFER with LENGTH unpredictable bytes. This is commonly
  62. called a nonce and may also be used for initialization vectors and
  63. padding. This is an extra function nearly independent of the other
  64. random function for 3 reasons: It better protects the regular
  65. random generator's internal state, provides better performance and
  66. does not drain the precious entropy pool."
  67. (let ((bv (match type
  68. ('strong
  69. (gen-random-bv bv-length %gcry-strong-random))
  70. ('very-strong
  71. (gen-random-bv bv-length %gcry-very-strong-random))
  72. ('nonce
  73. (gen-random-nonce bv-length)))))
  74. (base64-encode bv 0 bv-length #f #t base64url-alphabet)))