gnunet-dht.scm 3.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798
  1. ;; SPDX-FileCopyrightText: 2021 pukkamustard <pukkamustard@posteo.net>
  2. ;; SPDX-FileCopyrightText: 2022 Maxime Devos <maximedevos@telenet.be>
  3. ;;
  4. ;; SPDX-License-Identifier: AGPL-3.0-or-later
  5. ;; This module provides an interface to the GNUnet DHT service for storing and
  6. ;; retrieving blocks. This can be used to store blocks of ERIS encoded content.
  7. ;; TODO: the FS service has some fanciness w.r.t. reputation and not storing
  8. ;; everything on DHT directly, instead contacting relevant peers with CADET.
  9. ;;
  10. ;; Scheme-GNUnet is AGPL, so this module is AGPL (and not GPL) too.
  11. (define-module (eris blocks gnunet-dht)
  12. #:use-module (gnu gnunet config fs)
  13. #:use-module (gnu gnunet dht client)
  14. #:use-module (gnu gnunet utils bv-slice)
  15. #:use-module (gnu gnunet netstruct syntactic)
  16. #:use-module (gnu gnunet hashcode struct)
  17. #:use-module (fibers conditions)
  18. #:use-module (srfi srfi-71)
  19. #:use-module (rnrs bytevectors)
  20. #:export (eris-gnunet-dht-server
  21. eris-blocks-gnunet-dht-reducer
  22. eris-blocks-gnunet-dht-ref))
  23. ;; Connection to the DHT service, made with 'connect'
  24. ;; from (gnu gnunet dht client)
  25. (define eris-gnunet-dht-server (make-parameter #f))
  26. (define (current-dht-server)
  27. (or (eris-gnunet-dht-server)
  28. (error "not connected to the DHT service, set 'eris-gnunet-dht-server'!'")))
  29. ;; TODO: register a dedicated block type instead of using
  30. ;; block:test
  31. (define eris-block-type 8)
  32. (define (reference->dht-key ref)
  33. (define key/extended (make-slice/read-write (sizeof /hashcode:512 '())))
  34. (slice-copy! (bv-slice/read-write ref)
  35. (slice-slice key/extended 0 (bytevector-length ref)))
  36. (slice/read-only key/extended))
  37. (define (gnunet-block-put key value)
  38. "Store a block on GNUnet's DHT."
  39. ;; TODO: set the expiration time and replication level appropriately.
  40. ;; TODO: make-datum and put! assume that the bytevector slice isn't modified
  41. ;; until it is sent; verify that 'value' aren't modified or make a copy.
  42. (put! (current-dht-server)
  43. (datum->insertion
  44. (make-datum eris-block-type
  45. (reference->dht-key key)
  46. (bv-slice/read-write value)))))
  47. ;; GNUnet block reducer
  48. (define eris-blocks-gnunet-dht-reducer
  49. (case-lambda
  50. ;; Initialization. Nothing to do here. In an improved implementation,
  51. ;; we might want to limit the number of blocks that are currently
  52. ;; being sent to the service, to keep memory usage from growing
  53. ;; indefinitely when the service is slow.
  54. (() '())
  55. ;; Completion. Again, nothing to do.
  56. ((_) 'done)
  57. ;; store a block
  58. ((_ ref-block)
  59. (gnunet-block-put (car ref-block) (cdr ref-block)))))
  60. (define (eris-blocks-gnunet-dht-ref ref)
  61. "Dereference a block from GNUnet's DHT"
  62. ;; TODO: implement timeouts!
  63. ;; TODO: it would be nice if guile-eris could fetch multiple blocks
  64. ;; in parallel.
  65. (define query
  66. (make-query eris-block-type (reference->dht-key ref)))
  67. (define response)
  68. (define received (make-condition))
  69. (define (found search-result)
  70. ;; TODO: verify the value matches the key.
  71. ;; A malicious peer or a peer with broken memory
  72. ;; could put invalid key->value mappings into the DHT,
  73. ;; which should ideally be ignored in favour of correct
  74. ;; mappings ...
  75. (define value (datum-value (search-result->datum search-result)))
  76. (define value/bv (make-bytevector (slice-length value)))
  77. (slice-copy! value (bv-slice/read-write value/bv))
  78. (set! response value/bv)
  79. (signal-condition! received))
  80. (define get-handle (start-get! (current-dht-server) query found))
  81. (wait received)
  82. ;; TODO: cancel the get-handle to avoid leaking memory
  83. ;; (not yet implemented in gnunet-scheme ...)
  84. response)