blob: 16c22b49f5808cd753c60151e1c7c88eb5b14fa0 (
plain)
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
63
64
65
66
67
68
69
70
71
72
73
74
|
(ns org.gnu.clojure.gnunet.filesharing
(:use (org.gnu.clojure.gnunet bloomfilter crypto message parser peer)
clojure.contrib.monads))
(def message-type-fs-get 137)
(def message-type-fs-put 138)
(def message-type-fs-migration-stop 139)
(def bit-return-to 1)
(def bit-sks-namespace 2)
(def bit-transmit-to 3)
(def parse-get-message
(domonad parser-m
[block-type parse-int32
priority parse-uint32
ttl parse-int32
filter-mutator parse-int32
hash-bitmap parse-int32
query (items hash-size)
return-to (conditional (bit-test hash-bitmap bit-return-to)
(items id-size))
sks-namespace (conditional (bit-test hash-bitmap bit-sks-namespace)
(items hash-size))
transmit-to (conditional (bit-test hash-bitmap bit-transmit-to)
(items id-size))
bloomfilter (optional (parse-bloomfilter bloomfilter-k))]
{:block-type block-type
:priority priority
:ttl ttl
:filter-mutator filter-mutator
:query query
:return-to return-to
:sks-namespace sks-namespace
:transmit-to transmit-to
:bloomfilter bloomfilter}))
(defn bound-priority
[priority remote-peer]
)
(defn admit-get!
[peer remote-peer message]
(when-let [get-message (first (parse-get-message (:bytes message)))]
(.write *out* (.toString get-message))
(.write *out* "\n")
)
(when-let [return-to (if (:return-to message)
((deref (:remote-peers-agent peer))
(:return-to message))
remote-peer)]
(when-let [priority (bound-priority (:priority message) remote-peer)]
)))
(defn admit-put!
[peer remote-peer message])
(defn admit-migration-stop!
[peer remote-peer message])
(defn activate-filesharing!
[peer]
(send (:dispatch-agent peer)
(fn [dispatchers]
(let [get-dispatchers (dispatchers message-type-fs-get #{})
put-dispatchers (dispatchers message-type-fs-put #{})
migration-stop-dispatchers
(dispatchers message-type-fs-migration-stop #{})]
(conj dispatchers
{message-type-fs-get (conj get-dispatchers admit-get!)
message-type-fs-put (conj put-dispatchers admit-put!)
message-type-fs-migration-stop (conj migration-stop-dispatchers
admit-migration-stop!)})))))
|