blob: a70f3f419eddda49350e8171aec3d7754b8268ae (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
;; Copyright (C) 2021 GNUnet e.V.
;; SPDX-License-Identifier: FSFAP
;; Copying and distribution of this file, with or without modification,
;; are permitted in any medium without royalty provided the copyright
;; notice and this notice are preserved. This file is offered as-is,
;; without any warranty.
(use-modules (fibers)
(rnrs bytevectors)
(gnu extractor enum)
(gnu gnunet block)
(gnu gnunet utils bv-slice)
(gnu gnunet config db)
(gnu gnunet config fs)
(rnrs hashtables)
((gnu gnunet nse client)
#:prefix #{nse:}#)
((gnu gnunet dht client)
#:prefix #{dht:}#)
(web server)
(srfi srfi-11))
(define config (load-configuration))
(define (url-handler server request body)
(define current-estimate (nse:estimate server))
(define body
(if current-estimate
(format #f "timestamp: ~a~%number peers: ~a~%stddev logarithm: ~a"
(nse:estimate:timestamp current-estimate)
(nse:estimate:number-peers current-estimate)
(nse:estimate:standard-deviation current-estimate))
"no estimate available yet ..."))
(values '((content-type text/plain)) body #f))
(define (start config)
(define nse-server (nse:connect config))
(define dht-server (dht:connect config))
(define impl (lookup-server-impl 'fiberized))
(define server (open-server impl `(#:port 8089)))
(define (url-handler* request body)
(url-handler nse-server request body))
;; TODO: Form to start GET and PUT requests?
;; For now, hard code the data to insert.
(dht:put! dht-server
(symbol-value block-type block:test)
(bv-slice/read-write (make-bytevector 64))
(bv-slice/read-write #vu8(#xde #xad #xbe #xef)))
(dht:start-get! dht-server
(symbol-value block-type block:test)
(bv-slice/read-write (make-bytevector 64)) pk)
(let loop ()
(let-values (((client request body)
(read-client impl server)))
(spawn-fiber
(lambda ()
(let-values (((response body state)
(handle-request url-handler* request body '())))
(write-client impl server client response body)))))
(loop)))
(run-fibers (lambda () (start config)))
|
