├── .gitignore ├── src └── peer │ ├── dht.clj │ ├── url.clj │ ├── config.clj │ ├── rpc.clj │ ├── heartbeat.clj │ ├── presence.clj │ ├── digest.clj │ ├── util.clj │ ├── web.clj │ ├── bootstrap.clj │ ├── route.clj │ ├── core.clj │ └── connection.clj ├── project.clj ├── test ├── peer │ ├── heartbeat_test.clj │ ├── bootstrap_test.clj │ ├── connection_test.clj │ └── core_test.clj ├── test_utils.clj └── example │ └── distributed_queries.clj ├── README.md └── LICENSE /.gitignore: -------------------------------------------------------------------------------- 1 | .cake 2 | pom.xml 3 | *.jar 4 | *.war 5 | lib 6 | classes 7 | build 8 | /peer 9 | *.sw[op] 10 | -------------------------------------------------------------------------------- /src/peer/dht.clj: -------------------------------------------------------------------------------- 1 | (defprotocol IDHT 2 | (assoc [this id data]) 3 | (dissoc [this id]) 4 | (get [this id])) 5 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject peer "0.1.0-SNAPSHOT" 2 | :description "A peer-to-peer networking toolkit." 3 | :dependencies [[clojure "1.2.0"] 4 | [aleph "0.2.0-alpha3-SNAPSHOT"] 5 | [ring/ring-core "0.3.1"] 6 | [org.bitlet/weupnp "0.1.2-SNAPSHOT"] 7 | [plasma "0.3.0-SNAPSHOT"] 8 | [logjam "0.1.0-SNAPSHOT"]] 9 | :dev-dependencies [[marginalia "0.6.0"] 10 | [cake-marginalia "0.6.0"]]) 11 | -------------------------------------------------------------------------------- /test/peer/heartbeat_test.clj: -------------------------------------------------------------------------------- 1 | (ns peer.heartbeat-test 2 | (:use [plasma graph util api] 3 | [peer core url connection bootstrap heartbeat] 4 | test-utils 5 | clojure.test 6 | clojure.stacktrace) 7 | (:require [logjam.core :as log] 8 | [lamina.core :as lamina] 9 | [plasma.query :as q])) 10 | 11 | ;(log/file [:peer :con] "peer.log") 12 | 13 | (deftest hearbeat-failure-test 14 | (let [a (peer {:port 1234}) 15 | b (peer {:port 1235})] 16 | (try 17 | (detect-failures a) 18 | (detect-failures b) 19 | (finally 20 | (close a) 21 | (close b))))) 22 | 23 | -------------------------------------------------------------------------------- /src/peer/url.clj: -------------------------------------------------------------------------------- 1 | (ns peer.url 2 | (:use [peer config])) 3 | 4 | (defn url 5 | ([proto host] 6 | (str proto "://" host)) 7 | ([proto host port] 8 | (str proto "://" host ":" port))) 9 | 10 | (defn peer-url 11 | [host port] 12 | (url (config :protocol) host port)) 13 | 14 | (defn url-map [url] 15 | (let [match (re-find #"(.*)://([0-9a-zA-Z-_.]*):([0-9]*)" url) 16 | [_ proto host port] match] 17 | {:proto proto 18 | :host host 19 | :port (Integer. port)})) 20 | 21 | (defn assert-url 22 | [url] 23 | (when-not (and (string? url) 24 | (.startsWith url "peer://")) 25 | (throw (Exception. 26 | (str "Trying to open a peer connection with an invalid URL: " url))))) 27 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## Peer to peer networking toolkit 2 | 3 | ### Providing 4 | * TCP and UDP based, NIO socket communications 5 | * a simple communications interface (RPC, multiplexed streams) 6 | * UPnP based port-forwarding configuration 7 | - makes peers behind home networks (NATs) accessible from the outside 8 | * high-level functions for message and password hashing 9 | * automatic local network discovery using UDP broadcast messages 10 | 11 | ### In Progress 12 | * generic bootstrap server for P2P apps 13 | * heartbeat based failure detection to recognize dropped or unavailable peers 14 | * random walk based search and sampling 15 | * localized flooding to peers 16 | * distributed hash table formation 17 | - ring based topology 18 | * generic greedy routing 19 | - for ring based DHT ala chord and others 20 | * basic distributed clustering 21 | 22 | ### Planned 23 | * high-level DHT storage interface 24 | * content based routing using graph queries 25 | -------------------------------------------------------------------------------- /src/peer/config.clj: -------------------------------------------------------------------------------- 1 | (ns peer.config 2 | (:use plasma.util)) 3 | 4 | (defonce config* 5 | (ref {:peer-version "0.1.0" ; version number, for protocol versioning 6 | :protocol "peer" ; default peer protocol 7 | :peer-port 4242 ; listening for incoming socket connections 8 | :presence-port 4243 ; UDP broadcast port for presence messaging 9 | :presence-period 5000 ; presence broadcast period in ms 10 | :connection-cache-limit 50 ; max open connections 11 | :peer-id (uuid) ; TODO: store this somewhere? 12 | :meta-id "UUID:META" ; special UUID for graph meta-data node 13 | 14 | ; :db-path "db" 15 | })) 16 | 17 | (defn config 18 | "Lookup a config value." 19 | ([] @config*) 20 | ([k] (get @config* k)) 21 | ([k v] (dosync (alter config* assoc k v)))) 22 | 23 | -------------------------------------------------------------------------------- /src/peer/rpc.clj: -------------------------------------------------------------------------------- 1 | (ns peer.rpc 2 | (:use [plasma util]) 3 | (:require [logjam.core :as log])) 4 | 5 | (defn rpc-request 6 | "An RPC request to a remote service. Passes params to method and returns 7 | the reply using the same id to correlate the response (or error) with the 8 | request." 9 | [id method params] 10 | (log/to :rpc "rpc-request[" (trim-id id) "]: " method params) 11 | {:type :request 12 | :id id 13 | :method method 14 | :params params}) 15 | 16 | (defn rpc-response 17 | "An RPC response matched to a request." 18 | [req val] 19 | (log/to :rpc "rpc-response[" (trim-id (:id req)) "]: " 20 | (if (seq? val) 21 | (take 5 (seq val)) 22 | val)) 23 | {:type :response 24 | :id (:id req) 25 | :error nil 26 | :result val}) 27 | 28 | (defn rpc-event 29 | "An RPC event is a one-shot message that doesn't expect a response." 30 | [id params] 31 | (log/to :rpc "rpc-event[" (if (uuid? id) (trim-id id) id) "]: " params) 32 | {:type :event 33 | :id id 34 | :params params}) 35 | 36 | (defn rpc-error 37 | "An RPC error for the given request." 38 | [req msg & [data]] 39 | (log/to :rpc "rpc-error[" (trim-id (:id req)) "]: " msg) 40 | {:type :response 41 | :id (:id req) 42 | :result nil 43 | :error {:message msg 44 | :data data}}) 45 | 46 | -------------------------------------------------------------------------------- /src/peer/heartbeat.clj: -------------------------------------------------------------------------------- 1 | (ns peer.heartbeat 2 | (:use [plasma graph util api] 3 | [peer core connection config]) 4 | (:require [plasma.query :as q] 5 | [lamina.core :as lamina] 6 | [logjam.core :as log])) 7 | 8 | ; Stores a seq of heartbeat timestamps for each peer, keyed by root-id. 9 | (def heartbeats* (atom {})) 10 | 11 | (defn- heartbeat-handler 12 | [peer con event] 13 | (let [ts (current-time) 14 | id (first (:params event))] 15 | (swap! heartbeats* update-in [id] conj ts))) 16 | 17 | (defn detect-failures 18 | [peer] 19 | (peer-event-handler peer :heartbeat heartbeat-handler)) 20 | 21 | (defn- send-heartbeat 22 | [con root-id] 23 | (send-event con :heartbeat [root-id])) 24 | 25 | (defn- do-heartbeat 26 | [peer n-query] 27 | (let [root-id (get-node peer ROOT-ID)] 28 | (doseq [neighbor (query peer n-query)] 29 | (let [con (get-connection (:manager peer) (:url neighbor))] 30 | (send-heartbeat con root-id))))) 31 | 32 | (defn heartbeat 33 | "Send a heartbeat message to all neighbors which are chosen 34 | by executing a \"neighbor-query\" every period milliseconds. 35 | The returned function can be called to stop heartbeating." 36 | [peer period n-query] 37 | (periodically period 38 | (fn [] 39 | (try 40 | (do-heartbeat peer n-query) 41 | (catch Exception e 42 | (log/to :heartbeat "Error in heartbeat: " e "\n" 43 | (with-out-str (.printStackTrace e)))))))) 44 | 45 | -------------------------------------------------------------------------------- /src/peer/presence.clj: -------------------------------------------------------------------------------- 1 | (ns peer.presence 2 | (:use [peer config] 3 | [plasma util] 4 | [lamina core] 5 | [aleph udp])) 6 | 7 | (def listeners* (ref {})) 8 | 9 | (defn broadcast-addr 10 | [] 11 | "255.255.255.255") 12 | 13 | (defn presence-channel 14 | "Returns a channel that will receive all presence messages broadcast 15 | on the local network." 16 | ([] (presence-channel (config :presence-port))) 17 | ([port] 18 | (if-let [chan (get @listeners* port)] 19 | chan 20 | (let [msg-chan @(udp-object-socket {:port port}) 21 | p-chan (filter* (fn [msg] 22 | (and (associative? msg) 23 | (= :presence (:type msg)))) 24 | (map* :message msg-chan))] 25 | (dosync (alter listeners* assoc port p-chan)) 26 | p-chan)))) 27 | 28 | (defn- presence-message 29 | "Create a presence message." 30 | [id host port] 31 | (let [presence-ip (broadcast-addr) 32 | {:keys [presence-port plasma-version]} (config) 33 | msg {:type :presence 34 | :plasma-version plasma-version 35 | :id id 36 | :host host 37 | :port port}] 38 | {:message msg :host presence-ip :port presence-port})) 39 | 40 | (defn presence-broadcaster 41 | "Start periodically broadcasting a presence message. Returns a function 42 | that will stop broadcasting when called." 43 | [id host port period] 44 | (let [msg (presence-message id host port) 45 | broadcast-channel @(udp-object-socket {:broadcast true})] 46 | (periodically period #(enqueue broadcast-channel msg)))) 47 | 48 | -------------------------------------------------------------------------------- /test/peer/bootstrap_test.clj: -------------------------------------------------------------------------------- 1 | (ns peer.bootstrap-test 2 | (:use [plasma graph util api] 3 | [peer core url connection bootstrap] 4 | test-utils 5 | clojure.test 6 | clojure.stacktrace) 7 | (:require [logjam.core :as log] 8 | [lamina.core :as lamina] 9 | [plasma.query :as q])) 10 | 11 | ;(log/file [:peer :bootstrap :con] "peer.log") 12 | 13 | (deftest bootstrap-test 14 | (let [port (+ 5000 (rand-int 5000)) 15 | strapper (bootstrap-peer {:port port}) 16 | strap-url (peer-url "localhost" port) 17 | n-peers 10 18 | peers (make-peers n-peers (inc port) 19 | (fn [i] 20 | (clear-graph) 21 | (let [root-id (root-node-id)] 22 | (assoc-node root-id :peer-id i) 23 | (make-edge root-id (make-node) :net))))] 24 | (is (= 1 (count (query strapper (q/path [:net]) 200)))) 25 | (try 26 | (doseq [p peers] 27 | (bootstrap p strap-url)) 28 | (Thread/sleep 2000) 29 | (let [all-peers (query strapper (q/path [:net :peer])) 30 | p-counts (map (comp first #(query % (q/count* (q/path [:net :peer])) 200)) 31 | peers)] 32 | (is (= n-peers (count all-peers))) 33 | (is (every? #(>= % N-BOOTSTRAP-PEERS) p-counts))) 34 | (finally 35 | (close strapper) 36 | (close-peers peers))))) 37 | 38 | (comment 39 | (def strap (bootstrap-peer {:port 2345})) 40 | (def strap-url (peer-url "localhost" 2345)) 41 | 42 | (def peers (make-peers 2 2223 43 | (fn [i] 44 | (clear-graph) 45 | (let [root-id (root-node-id)] 46 | (assoc-node root-id :peer-id i) 47 | (make-edge root-id (make-node) :net))))) 48 | 49 | (bootstrap (second peers) strap-url) 50 | (query (first peers) (-> (q/path [peer [:net :peer]]) 51 | (q/project [peer :proxy :id])) {} 500) 52 | ) 53 | -------------------------------------------------------------------------------- /src/peer/digest.clj: -------------------------------------------------------------------------------- 1 | (ns plasma.digest 2 | (:import (java.security MessageDigest))) 3 | 4 | ; Using a unique site key in the digest helps keep passwords safer from dictionary attacks on weak passwords. 5 | (def *digest-site-key* "asdf134asdf") 6 | (def *default-password-len* 10) 7 | 8 | ; Stretching, running the digest multiple times, makes it harder to brute force passwords also. 5 stretches means 5x the work. 9 | (def DIGEST-NUM-STRETCHES 10) 10 | 11 | (def VALID-CHARS 12 | (map char (concat (range 48 58) ; 0-9 13 | (range 66 91) ; A-Z 14 | (range 97 123)))) ; a-z 15 | 16 | (defn random-char [] 17 | (nth VALID-CHARS (rand (count VALID-CHARS)))) 18 | 19 | (defn random-str [len] 20 | (apply str (take len (repeatedly random-char)))) 21 | 22 | (defn- do-hash [type input] 23 | (let [hasher (MessageDigest/getInstance type)] 24 | (.digest hasher (.getBytes input)))) 25 | 26 | (defn md5 [input] 27 | (do-hash "MD5" input)) 28 | 29 | (defn sha1 [input] 30 | (do-hash "SHA-1" input)) 31 | 32 | (defn sha256 [input] 33 | (do-hash "SHA-256" input)) 34 | 35 | (defn sha512 [input] 36 | (do-hash "SHA-256" input)) 37 | 38 | (defn hex [bytes] 39 | (reduce (fn [result byte] 40 | (str result (.substring 41 | (Integer/toString (+ (bit-and byte 0xff) 0x100) 16) 42 | 1))) 43 | "" bytes)) 44 | 45 | (defn hex->int [hexval] 46 | (read-string (str "0x" hexval))) 47 | 48 | (defn secure-digest [& stuff] 49 | (sha1 (apply str (interpose "--" stuff)))) 50 | 51 | (defn make-token [] 52 | (let [time (.getTime (java.util.Date. )) 53 | garbage (map rand (range 1 10)) 54 | salt (apply str time garbage)] 55 | (secure-digest salt))) 56 | 57 | (defn encrypt-password [password salt] 58 | (reduce (fn [result _] 59 | (secure-digest result salt password *digest-site-key*)) 60 | *digest-site-key* 61 | (range DIGEST-NUM-STRETCHES))) 62 | 63 | (defn random-password [] 64 | (random-str *default-password-len*)) 65 | -------------------------------------------------------------------------------- /src/peer/util.clj: -------------------------------------------------------------------------------- 1 | (ns peer.util) 2 | 3 | (defn uuid 4 | "Creates a random, immutable UUID object that is comparable using the '=' function." 5 | [] (str "UUID:" (. java.util.UUID randomUUID))) 6 | 7 | (defn uuid? [s] 8 | (and (string? s) 9 | (= (seq "UUID:") (take 5 (seq s))))) 10 | 11 | (defn trim-id 12 | "Returns a short version of a uuid." 13 | [id & [n]] 14 | (apply str (take (or n 4) (drop 5 id)))) 15 | 16 | (defn current-time [] 17 | (System/currentTimeMillis)) 18 | 19 | (defn regexp? 20 | [obj] 21 | (= java.util.regex.Pattern (type obj))) 22 | 23 | (defn map-fn 24 | [m key fn & args] 25 | (assoc m key (apply fn (get m key) args))) 26 | 27 | (defn periodically 28 | "Executes a function every period milliseconds. Returns a function that can 29 | be called to terminate the execution. If true is passed as the argument to 30 | this function it will terminate immediately rather than waiting for the 31 | already scheduled tasks to complete." 32 | [period fun] 33 | (let [s (Executors/newSingleThreadScheduledExecutor)] 34 | (.scheduleAtFixedRate s fun (long 0) (long period) TimeUnit/MILLISECONDS) 35 | (fn [& [now?]] 36 | (if now? 37 | (.shutdownNow s) 38 | (.shutdown s))))) 39 | 40 | (defn schedule 41 | "Schedule a function to run after ms milliseconds. Returns a function that can 42 | be called to cancel the scheduled execution." 43 | [ms fun] 44 | (let [s (Executors/newSingleThreadScheduledExecutor)] 45 | (.schedule s fun (long ms) TimeUnit/MILLISECONDS) 46 | (fn [] 47 | (.shutdownNow s)))) 48 | 49 | (defn wait-for 50 | [chan timeout] 51 | (lamina/wait-for-result chan timeout)) 52 | 53 | (defn channel-timeout 54 | "Closes the channel after timeout." 55 | [ch timeout] 56 | (schedule timeout 57 | (fn [] 58 | (log/to :flow "channel-timeout closing...") 59 | (lamina/close ch)))) 60 | 61 | (defn await-promise 62 | "Read a promise waiting for timeout ms for the promise to be delivered. 63 | Raises an exception if a timeout occurs" 64 | ([prom timeout] 65 | (.get (future @prom) timeout TimeUnit/MILLISECONDS))) 66 | -------------------------------------------------------------------------------- /test/test_utils.clj: -------------------------------------------------------------------------------- 1 | (ns test-utils 2 | (:use [peer core url connection bootstrap] 3 | [clojure test stacktrace] 4 | [plasma graph]) 5 | (:require [lamina.core :as lamina] 6 | [plasma.construct :as c])) 7 | 8 | (defn make-peers 9 | "Create n peers, each with a monotically increasing port number. 10 | Then run (fun i) with the peer graph bound to initialize each peer, 11 | and i being the index of the peer being created." 12 | ([n start-port fun] 13 | (doall 14 | (for [i (range n)] 15 | (let [p (peer {:port (+ start-port i) 16 | ;:path (str "db/peer-" i) 17 | } 18 | )] 19 | (with-peer-graph p 20 | (fun i) 21 | p)))))) 22 | 23 | (defn close-peers 24 | [peers] 25 | (doseq [p peers] 26 | (close p))) 27 | 28 | (defn bootstrap-peers 29 | [peers strap-url] 30 | (doall 31 | (for [p peers] 32 | (bootstrap p strap-url)))) 33 | 34 | (defn bootstrapped-peers 35 | [n] 36 | (let [port (+ 5000 (rand-int 5000)) 37 | strapper (bootstrap-peer {:path "db/strapper" :port port}) 38 | strap-url (peer-url "localhost" port) 39 | peers (make-peers n (inc port) identity)] 40 | (bootstrap-peers peers strap-url) 41 | [strapper peers])) 42 | 43 | (defn test-graph [] 44 | (c/construct* 45 | (-> (c/nodes [root ROOT-ID 46 | net :net 47 | music :music 48 | synths :synths 49 | kick {:label :kick :score 0.8} 50 | hat {:label :hat :score 0.3} 51 | snare {:label :snare :score 0.4} 52 | bass {:label :bass :score 0.6} 53 | sessions :sessions 54 | take-six :take-six 55 | red-pill :red-pill]) 56 | (c/edges 57 | [root net :net 58 | root music :music 59 | music synths :synths 60 | synths bass {:label :synth :favorite true} 61 | synths hat :synth 62 | synths kick :synth 63 | synths snare :synth 64 | root sessions :sessions 65 | sessions take-six :session 66 | take-six kick :synth 67 | take-six bass :synth 68 | sessions red-pill :session 69 | red-pill hat :synth 70 | red-pill snare :synth 71 | red-pill kick :synth])))) 72 | 73 | -------------------------------------------------------------------------------- /src/peer/web.clj: -------------------------------------------------------------------------------- 1 | (ns plasma.web 2 | (:use [plasma graph config util] 3 | [aleph formats http tcp] 4 | [ring.middleware file file-info] 5 | [clojure.contrib json] 6 | [clojure stacktrace]) 7 | (:require [logjam.core :as log] 8 | [lamina.core :as lamina])) 9 | 10 | ; Remember: must be set in javascript client also. 11 | (def WEB-PORT 4242) 12 | 13 | (defn- web-rpc-handler 14 | [p req] 15 | (log/to :web "web-rpc-handler: " req) 16 | (let [res 17 | (case (:method req) 18 | "query" 19 | (with-peer-graph p 20 | (load-string 21 | (str 22 | "(require 'plasma.web) 23 | (in-ns 'plasma.web) 24 | " (first (:params req))))))] 25 | {:result res 26 | :error nil 27 | :id (:id req)})) 28 | 29 | (defn- request-handler 30 | [p ch msg] 31 | (when msg 32 | (log/to :web "\nMsg: " msg) 33 | (try 34 | (let [request (read-json msg true) 35 | _ (log/to :web "request: " request) 36 | res (web-rpc-handler p request)] 37 | (log/to :web "Result: " res) 38 | (lamina/enqueue ch (json-str res))) 39 | (catch Exception e 40 | (log/to :web "Request Exception: " e) 41 | (log/to :web "Trace: " (with-out-str (print-stack-trace e))))))) 42 | 43 | (defn- dispatch-synchronous 44 | [request] 45 | (let [{:keys [request-method query-string uri]} request] 46 | (comment if (= uri "/") 47 | (home-view request) 48 | nil))) 49 | 50 | (def sync-app 51 | (-> dispatch-synchronous 52 | (wrap-file "public") 53 | (wrap-file-info))) 54 | 55 | (defn- server [p ch request] 56 | (log/to :web "client connect: " (str request)) 57 | (if (:websocket request) 58 | (lamina/receive-all ch (partial request-handler p ch)) 59 | (if-let [sync-response (sync-app request)] 60 | (lamina/enqueue ch sync-response) 61 | (lamina/enqueue ch {:status 404 :body "Page Not Found"})))) 62 | 63 | (defn web-interface 64 | "Start a web interface for the give peer. 65 | To specify a custom port pass it in an options map: 66 | {:port 1234} 67 | " 68 | ([p] (web-interface p {:port WEB-PORT :websocket true})) 69 | ([p options] 70 | (start-http-server (partial server p) options))) 71 | 72 | (comment 73 | (def SPF "\n\n\0") 74 | 75 | (defn spf-handler [channel connection-info] 76 | (receive-all channel (fn [req] 77 | (if (= "\0" 78 | (byte-buffer->string req)) 79 | (let [f (string->byte-buffer SPF)] 80 | (enqueue-and-close channel f)) 81 | (println (byte-buffer->string req)))))) 82 | 83 | (defn start-policy-server [] 84 | (start-tcp-server spf-handler 85 | {:port 843})) 86 | ) 87 | -------------------------------------------------------------------------------- /src/peer/bootstrap.clj: -------------------------------------------------------------------------------- 1 | (ns peer.bootstrap 2 | (:use [plasma graph util] 3 | [peer core config connection]) 4 | (:require [plasma.query :as q] 5 | [lamina.core :as lamina] 6 | [logjam.core :as log])) 7 | 8 | (log/file :bootstrap "boot.log") 9 | 10 | (defn- peer-urls 11 | [p] 12 | (with-peer-graph p 13 | (q/query (-> (q/path [peer [:net :peer]]) 14 | (q/project ['peer :url]))))) 15 | 16 | (defn- have-peer? 17 | [p url] 18 | (contains? (set (peer-urls p)) url)) 19 | 20 | (defn- advertise-handler 21 | [p con event] 22 | (when event 23 | (let [[root-id url] (:params event)] 24 | (log/to :bootstrap "[advertise-handler] got advertisement:" url root-id) 25 | (when-not (have-peer? p url) 26 | (add-peer p root-id url))) 27 | (log/to :bootstrap "[advertise-handler] bootstrap peer has:" 28 | (count (get-peers p)) "peers"))) 29 | 30 | (defn bootstrap-peer 31 | "Returns a peer that will automatically add new peers to its graph at 32 | [:net :peer] when they connect." 33 | ([] (bootstrap-peer {})) 34 | ([options] 35 | (let [p (peer options)] 36 | (with-peer-graph p (clear-graph)) 37 | (setup-peer-graph p) 38 | (peer-event-handler p :bootstrap-advertise advertise-handler) 39 | (log/to :bootstrap "[bootstrap-peer] has:" (count (get-peers p)) "peers") 40 | p))) 41 | 42 | (def N-BOOTSTRAP-PEERS 5) 43 | (def RETRY-PERIOD 200) 44 | (def MAX-RETRY-PERIOD (* 50 RETRY-PERIOD)) 45 | (def MAX-RETRIES 50) 46 | 47 | (defn add-bootstrap-peers 48 | ([p boot-url n] (add-bootstrap-peers p boot-url n 0)) 49 | ([p boot-url n n-retries] 50 | (let [con (peer-connection p boot-url) 51 | new-peers (query con (-> (q/path [peer [:net :peer]]) 52 | (q/project ['peer :proxy :id]) 53 | (q/choose N-BOOTSTRAP-PEERS)))] 54 | (log/to :bootstrap "n: " n "\n" 55 | "n-retries: " n-retries "\n" 56 | "new-peers: " (seq new-peers)) 57 | (doseq [{url :proxy id :id} new-peers] 58 | (when-not (get-node p id) 59 | (add-peer p id url))) 60 | (let [n-peers (first (query p (q/count* 61 | (q/path [:net :peer]))))] 62 | (log/to :bootstrap "n-peers: " n-peers) 63 | (when (and 64 | (not= :closed @(:status p)) 65 | (< n-retries MAX-RETRIES) 66 | (< n-peers N-BOOTSTRAP-PEERS)) 67 | (schedule (min MAX-RETRY-PERIOD (* RETRY-PERIOD (Math/pow n-retries 1.5))) 68 | #(add-bootstrap-peers p boot-url 69 | (- N-BOOTSTRAP-PEERS n-peers) 70 | (inc n-retries)))))))) 71 | 72 | (defn- advertise 73 | [con root-id url] 74 | (send-event con :bootstrap-advertise [root-id url])) 75 | 76 | (defn- bootstrap* 77 | [p boot-url] 78 | (let [booter (peer-connection p boot-url) 79 | root-id (with-peer-graph p (root-node-id)) 80 | my-url (:url p)] 81 | (setup-peer-query-handlers p booter) 82 | (advertise booter root-id my-url) 83 | (add-bootstrap-peers p boot-url N-BOOTSTRAP-PEERS))) 84 | 85 | (defn bootstrap 86 | [p boot-url] 87 | (schedule 1 #(bootstrap* p boot-url))) 88 | 89 | -------------------------------------------------------------------------------- /test/example/distributed_queries.clj: -------------------------------------------------------------------------------- 1 | (ns example.distributed-queries 2 | (:use [plasma util graph api construct] 3 | [peer core config url connection] 4 | test-utils 5 | clojure.stacktrace) 6 | (:require [logjam.core :as log] 7 | [lamina.core :as lamina] 8 | [plasma.query :as q])) 9 | 10 | ; People: alice, bob, carlos, dave, eve 11 | ; TODO: figure out how to deal with timestamps 12 | 13 | (comment defn make-peer-graph 14 | [] 15 | (clear-graph) 16 | (construct* 17 | (-> (nodes [contacts {} 18 | projects {} 19 | zoom {:name "Zoom" 20 | :genre "minimal" 21 | :last-update ... 22 | } 23 | blam {:name "Blam" 24 | :genre "jazz" 25 | :last-update ...} 26 | ]) 27 | (edges [ROOT-ID contacts :contacts 28 | ROOT-ID projects :projects 29 | ])))) 30 | 31 | (defonce me (peer {:port 1100})) 32 | (defonce alice (peer {:port 1101})) 33 | (defonce bob (peer {:port 1102})) 34 | (defonce carlos (peer {:port 1103})) 35 | 36 | (defn setup-projects 37 | "Setup a basic graph adding two projects to peer p." 38 | [p proj-a proj-b] 39 | (construct p 40 | (-> 41 | (nodes [projects {} 42 | a proj-a 43 | b proj-b]) 44 | (edges [ROOT-ID projects :projects 45 | projects a :project 46 | projects b :project])))) 47 | 48 | (defn setup-peers 49 | [] 50 | (setup-projects alice 51 | {:name "Zoom" :genre "minimal"} 52 | {:name "Doom" :genre "jazz"}) 53 | (setup-projects bob 54 | {:name "Whim" :genre "rock"} 55 | {:name "Wham" :genre "jazz"}) 56 | (setup-projects carlos 57 | {:name "Flip" :genre "minimal"} 58 | {:name "Flop" :genre "rock"})) 59 | 60 | (defn setup-remotes 61 | [] 62 | (let [roots (map (fn [p] 63 | (let [id (:id (get-node p ROOT-ID)) 64 | purl (peer-url "localhost" (:port p))] 65 | {:id id :proxy purl})) 66 | [alice bob carlos])] 67 | (construct me 68 | (-> 69 | (nodes [net (q/path [:net]) 70 | proxies roots]) 71 | (edges [net proxies :peer]))))) 72 | 73 | (defn setup 74 | [] 75 | (setup-peers) ; create our imaginary peers 76 | (setup-remotes) ; add peer roots as proxies to local graph 77 | ) 78 | 79 | (defn peers 80 | [] 81 | (-> (q/path [p [:net :peer]]) 82 | (q/project ['p :id :proxy]))) 83 | 84 | (defn with-project-info 85 | [plan] 86 | (-> plan (q/project ['p :name :genre]))) 87 | 88 | (defn peer-projects-by-genre 89 | [genre] 90 | (-> (q/path [p [:net :peer :projects :project]]) 91 | (q/where (= (:genre 'p) genre)))) 92 | 93 | ; Get peer projects of the genre jazz 94 | ;(query me (with-project-info (peer-projects-by-genre "jazz"))) 95 | 96 | (defn tone 97 | [p q] 98 | (query p q)) 99 | 100 | 101 | (comment defn proxy-node-test [] 102 | (dosync (alter config* assoc 103 | :peer-port (+ 10000 (rand-int 20000)) 104 | :presence-port (+ 10000 (rand-int 20000)))) 105 | (let [port (+ 1000 (rand-int 10000)) 106 | local (peer {:port port}) 107 | remote (peer {:port (inc port)})] 108 | (try 109 | (reset-peer local) 110 | (reset-peer remote) 111 | ; Add a proxy node to the local graph pointing to the root of the remote 112 | ; graph. 113 | (let [remote-root (:id (get-node remote ROOT-ID))] 114 | (log/to :peer "remote-root: " remote-root) 115 | (construct local 116 | (-> (nodes 117 | [net (q/path [:net]) 118 | remote {:id remote-root 119 | :proxy (peer-url "localhost" (:port remote))}]) 120 | (edges 121 | [net remote :peer]))) 122 | 123 | ; Now issue a query that will traverse over the network 124 | ; through the proxy node. 125 | (let [q (-> (q/path [synth [:net :peer :music :synths :synth]]) 126 | (q/project ['synth :label])) 127 | res (query local q)] 128 | (is (= #{:kick :bass :snare :hat} (set (map :label res)))))) 129 | (finally 130 | (close local) 131 | (close remote))))) 132 | 133 | -------------------------------------------------------------------------------- /src/peer/route.clj: -------------------------------------------------------------------------------- 1 | (ns plasma.net.route 2 | (:use [plasma graph util digest api] 3 | [peer connection core url] 4 | [clojure.contrib.math :only (expt)]) 5 | (:require [logjam.core :as log] 6 | [lamina.core :as lamina] 7 | [plasma.query :as q])) 8 | 9 | (defn flood-n 10 | []) 11 | 12 | (defn random-walk-n 13 | "Starting at peer p, do an n hop random walk, returning {:id :proxy} maps 14 | from all the peers traversed." 15 | ([p n] (random-walk-n p n p)) 16 | ([p n start-peer] 17 | (let [walk-fn (fn [[_ g]] 18 | (let [q (-> 19 | (q/path [peer [:net :peer]]) 20 | (q/project ['peer :id :proxy]) 21 | (q/choose 1)) 22 | res (first (query g q))] 23 | [res (peer-connection p (:proxy res))]))] 24 | (map first 25 | (take n (drop 1 26 | (iterate walk-fn [nil start-peer]))))))) 27 | 28 | (defn greedy-iter 29 | []) 30 | 31 | (defn id-bits [id n-bits] 32 | (mod 33 | (cond 34 | (string? id) (hex->int (hex (sha1 id))) 35 | (number? id) id) 36 | (expt 2 n-bits))) 37 | 38 | (defn ring-distance 39 | "Compute the distance between points a and b on a ring (finite group) 40 | where values go from zero to 2^n-bits. Note that this distance is 41 | only computed in the clockwise (positive) direction." 42 | [n-bits a b] 43 | (let [a (id-bits a n-bits) 44 | b (id-bits b n-bits) 45 | max-n (expt 2 n-bits)] 46 | (mod (+ (- b a) 47 | max-n) 48 | max-n))) 49 | 50 | (defn ring-abs-distance 51 | "Compute the natural distance between two points a and b in either direction 52 | on a ring where values go from zero to 2^n-bits." 53 | [n-bits a b] 54 | (let [a (id-bits a n-bits) 55 | b (id-bits b n-bits) 56 | max-n (expt 2 n-bits) 57 | dist (Math/abs (- a b))] 58 | (min dist (- max-n dist)))) 59 | 60 | (defn kademlia-distance 61 | "Compute the kademlia distance between two peer-ids hashed into 62 | an n-bit address space." 63 | [a b n-bits] 64 | (let [a (id-bits a n-bits) 65 | b (id-bits b n-bits)] 66 | (bit-xor a b))) 67 | 68 | (defn to-binary 69 | "Convert a Number to a binary string." 70 | [v] 71 | (.toString (BigInteger/valueOf v) 2)) 72 | 73 | (defn rand-bits 74 | [n] 75 | (apply str (take n (repeatedly (partial rand-int 2))))) 76 | 77 | (defn rand-bucket-id 78 | "Returns a random ID within the range of bucket B." 79 | [local-id n n-bits] 80 | (let [id (id-bits local-id n-bits) 81 | flip (- n-bits (inc n)) 82 | id (bit-flip id flip) 83 | id (reduce #(if (zero? (rand-int 2)) 84 | (bit-flip %1 %2) 85 | %1) 86 | id 87 | (range 0 flip))] 88 | id)) 89 | 90 | (defn k-bucket 91 | "Determine which bucket the test-id should reside in relation 92 | to the local-id while using an n-bit address space." 93 | [local-id test-id n-bits] 94 | (let [id (to-binary (id-bits local-id n-bits)) 95 | test-id (to-binary (id-bits test-id n-bits))] 96 | (count (take-while (fn [[a b]] (= a b)) 97 | (map list id test-id))))) 98 | 99 | ; TODO: Ideally we could put this distance calculation in the query 100 | ; to limit the number of nodes sent... 101 | (defn closest-peers 102 | "Returns the closest n peers (proxy node) to the tgt-id: 103 | {:id :proxy } 104 | " 105 | [p n tgt-id n-bits] 106 | (let [peers (query p (-> (q/path [p [:kad :bucket :peer]]) 107 | (q/project ['p :id :proxy])))] 108 | (if-not (nil? (first peers)) 109 | (take n (sort-by #(kademlia-distance tgt-id (:id %) n-bits) peers)) 110 | []))) 111 | 112 | (def ALPHA 3) 113 | 114 | (defn dht-lookup 115 | [p tgt-id n-bits] 116 | (let [root {:id (peer-id p)}] 117 | (loop [peers [p] 118 | closest root] 119 | (let [closest-dist (kademlia-distance tgt-id (:id closest) n-bits) 120 | cps (flatten (map #(closest-peers % ALPHA tgt-id n-bits) peers)) 121 | cps (map #(assoc % :distance 122 | (kademlia-distance tgt-id (:id %) n-bits)) 123 | cps) 124 | cps (filter #(< (:distance %) closest-dist) cps) 125 | sorted (sort-by :distance cps)] 126 | (if (empty? sorted) 127 | (assoc closest :distance (kademlia-distance (:id root) (:id closest) n-bits)) 128 | (recur (map (comp (partial peer-connection p) :proxy) sorted) 129 | (first sorted))))))) 130 | 131 | (defn dht-join 132 | "Find peers with the addrs that fit in the slots of our peer table. 133 | The addrs closest to power of 2 distances from our ID 134 | 135 | guid + 2^0, 2^1, 2^2, 2^3, etc... 136 | " 137 | [p] 138 | ) 139 | -------------------------------------------------------------------------------- /test/peer/connection_test.clj: -------------------------------------------------------------------------------- 1 | (ns peer.connection-test 2 | (:use clojure.test 3 | [plasma util] 4 | [peer config url connection rpc]) 5 | (:require [logjam.core :as log] 6 | [lamina.core :as lamina])) 7 | 8 | ;(log/file :con "con.log") 9 | ;(log/repl :con) 10 | 11 | (defrecord MockConnection 12 | [url] 13 | IConnection 14 | (request [c m p]) 15 | (request-channel [_]) 16 | (send-event [c id p]) 17 | (event-channel [c]) 18 | (event-channel [c id]) 19 | (stream [c m p]) 20 | (stream-channel [c]) 21 | 22 | IClosable 23 | (close [_])) 24 | 25 | (deftest connection-cache-test 26 | (let [manager (connection-manager)] 27 | (try 28 | (dotimes [i 300] 29 | (refresh-connection manager (MockConnection. 30 | (url "peer" "plasma.org" i))) 31 | (is (<= (connection-count manager) 32 | (config :connection-cache-limit)))) 33 | (finally 34 | (clear-connections manager))))) 35 | 36 | (defn rpc-test 37 | [proto port] 38 | (let [manager (connection-manager) 39 | listener (connection-listener manager proto port)] 40 | (try 41 | (on-connect listener 42 | (fn [con] 43 | (log/to :con "new connection: " con) 44 | (let [requests (request-channel con)] 45 | (lamina/receive-all requests 46 | (fn [[ch req]] 47 | (when req 48 | (log/to :con "got request: " req) 49 | (let [val (* 2 (first (:params req))) 50 | res (rpc-response req val)] 51 | (lamina/enqueue ch res)))))))) 52 | 53 | (let [client (get-connection manager (url proto "localhost" port))] 54 | (dotimes [i 20] 55 | (let [res-chan (request client 'foo [i]) 56 | res (lamina/wait-for-result res-chan 100)] 57 | (is (= (* 2 i) res)))) 58 | (is (zero? (count (:chan client)))) 59 | (close client)) 60 | (finally 61 | (close listener) 62 | (clear-connections manager))))) 63 | 64 | (deftest connection-rpc-test 65 | (rpc-test "peer" 1234) 66 | (rpc-test "upeer" 1234)) 67 | 68 | (defn event-test 69 | [proto port] 70 | (let [manager (connection-manager) 71 | listener (connection-listener manager proto port)] 72 | (try 73 | (let [events (atom [])] 74 | (on-connect listener 75 | (fn [con] 76 | (lamina/receive-all (event-channel con) 77 | (fn [event] 78 | (when event 79 | (swap! events conj (first (:params event)))))))) 80 | (let [client (get-connection manager (url proto "localhost" port))] 81 | (dotimes [i 20] 82 | (send-event client 'foo [i :a :b :c])) 83 | (close client)) 84 | (Thread/sleep 100) 85 | (is (= @events (range 20)))) 86 | (finally 87 | (close listener) 88 | (clear-connections manager))))) 89 | 90 | (deftest connection-event-test 91 | (event-test "peer" 1234) 92 | (event-test "upeer" 1234)) 93 | 94 | (defn stream-test 95 | [proto port] 96 | (let [manager (connection-manager) 97 | listener (connection-listener manager proto port)] 98 | (try 99 | (on-connect listener 100 | (fn [con] 101 | (lamina/receive-all (stream-channel con) 102 | (fn [[s-chan msg]] 103 | (when msg 104 | (lamina/enqueue s-chan (inc (first (:params msg)))) 105 | (lamina/receive-all s-chan 106 | (fn [v] 107 | (when v 108 | (lamina/enqueue s-chan (inc v)))))))))) 109 | 110 | (let [client (get-connection manager (url proto "localhost" port)) 111 | s-chan (stream client 'foo [1]) 112 | res (atom nil)] 113 | (lamina/receive s-chan #(lamina/enqueue s-chan (inc %))) 114 | (Thread/sleep 100) 115 | (lamina/receive s-chan #(lamina/enqueue s-chan (inc %))) 116 | (Thread/sleep 100) 117 | (lamina/receive s-chan #(reset! res %)) 118 | (Thread/sleep 100) 119 | (is (= 6 @res)) 120 | (close client)) 121 | (finally 122 | (close listener) 123 | (clear-connections manager))))) 124 | 125 | (deftest connection-stream-test 126 | (stream-test "peer" 1234) 127 | (stream-test "upeer" 1234)) 128 | 129 | ;(use 'aleph.object) 130 | ;(use 'lamina.core) 131 | ;(def log (atom [])) 132 | ;(def s (start-object-server 133 | ; (fn [ch _] (receive-all ch #(swap! log conj %))) 134 | ; {:port 1234})) 135 | ; 136 | ;(def c (wait-for-result (object-client {:host "localhost" 137 | ; :port 1234}))) 138 | ;(enqueue c "testing") 139 | ;@log 140 | ; 141 | ;(defn bad-stuff 142 | ; [] 143 | ; (def c (wait-for-result (object-client {:host "localhost" 144 | ; :port 1234}))) 145 | ; (enqueue c "testing") 146 | ; (close c)) 147 | ; 148 | ;(dotimes [i 100] (bad-stuff)) 149 | -------------------------------------------------------------------------------- /test/peer/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns peer.core-test 2 | (:use [plasma util graph api construct] 3 | [peer core config url connection] 4 | test-utils 5 | clojure.contrib.generic.math-functions 6 | clojure.test 7 | clojure.stacktrace) 8 | (:require [logjam.core :as log] 9 | [lamina.core :as lamina] 10 | [plasma.query :as q] 11 | [jiraph.graph :as jiraph])) 12 | 13 | (deftest get-node-test 14 | (let [p (peer {:path "db/p1" :port 1234})] 15 | (try 16 | (let [client (get-connection (connection-manager) (peer-url "localhost" 1234))] 17 | (dotimes [i 4] 18 | (let [res-chan (get-node client ROOT-ID) 19 | res (wait-for res-chan 400)] 20 | (is (uuid? (:id res))))) 21 | (close client)) 22 | (finally 23 | (close p))))) 24 | 25 | (defn- reset-peer 26 | [p] 27 | (with-peer-graph p 28 | (clear-graph) 29 | (test-graph))) 30 | 31 | (deftest simple-query-test [] 32 | (let [port (+ 10000 (rand-int 10000)) 33 | p (peer {:path "db/p1" :port port}) 34 | con (get-connection (connection-manager) (peer-url "localhost" port)) 35 | q (-> (q/path [s [:music :synths :synth]]) 36 | (q/where (> (* 100 (:score 's)) (sqrt 2500))))] 37 | (try 38 | (reset-peer p) 39 | (is (= 2 (count (query con q {} 200)))) 40 | (finally 41 | (close con) 42 | (close p))))) 43 | 44 | (deftest peer-query-test [] 45 | (dosync (alter config* assoc 46 | :peer-port (+ 10000 (rand-int 20000)) 47 | :presence-port (+ 10000 (rand-int 20000)))) 48 | (let [port (+ 10000 (rand-int 10000)) 49 | local (peer {:path "db/p1" :port port}) 50 | root-id (:id (get-node local ROOT-ID)) 51 | manager (:manager local)] 52 | (try 53 | (reset-peer local) 54 | (let [{:keys [foo bar] :as res} (construct local 55 | (-> (nodes 56 | [foo {:name "foo"} 57 | bar {:name "bar"}]) 58 | (edges [ROOT-ID foo :foo 59 | foo bar :bar])))] 60 | (is (= bar (:id (first (query local (q/path [:foo :bar]))))))) 61 | 62 | (let [con (get-connection manager (peer-url "localhost" port))] 63 | (is (uuid? (:id (wait-for (get-node con ROOT-ID) 200)))) 64 | (let [q (-> (q/path [s [:music :synths :synth]]) 65 | (q/where (>= (:score 's) 0.6))) 66 | qp (-> q (q/project 's)) 67 | lres (query local q) 68 | res (query con q {} 200) 69 | lchan (lamina/channel-seq (query-channel local qp) 200) 70 | cchan (lamina/channel-seq 71 | (query-channel con qp) 72 | 100)] 73 | (is (= lres res lchan cchan)) 74 | (is (= 2 (count res))) 75 | (is (= #{:bass :kick} (set (map :label (map #(wait-for (get-node con (:id %)) 200) 76 | res))))))) 77 | (finally 78 | (close local))))) 79 | 80 | (deftest proxy-node-test [] 81 | (dosync (alter config* assoc 82 | :peer-port (+ 10000 (rand-int 20000)) 83 | :presence-port (+ 10000 (rand-int 20000)))) 84 | (let [port (+ 1000 (rand-int 10000)) 85 | local (peer {:port port}) 86 | remote (peer {:port (inc port)})] 87 | (try 88 | (reset-peer local) 89 | (reset-peer remote) 90 | ; Add a proxy node to the local graph pointing to the root of the remote 91 | ; graph. 92 | (let [remote-root (:id (get-node remote ROOT-ID))] 93 | (log/to :peer "remote-root: " remote-root) 94 | (construct local 95 | (-> (nodes 96 | [net (q/path [:net]) 97 | remote {:id remote-root 98 | :proxy (peer-url "localhost" (:port remote))}]) 99 | (edges 100 | [net remote :peer]))) 101 | 102 | ; Now issue a query that will traverse over the network 103 | ; through the proxy node. 104 | (let [q (-> (q/path [synth [:net :peer :music :synths :synth]]) 105 | (q/project ['synth :label])) 106 | res (query local q)] 107 | (is (= #{:kick :bass :snare :hat} (set (map :label res)))))) 108 | (finally 109 | (close local) 110 | (close remote))))) 111 | 112 | (deftest many-proxy-node-test 113 | (dosync (alter config* assoc 114 | :peer-port (+ 10000 (rand-int 20000)) 115 | :presence-port (+ 10000 (rand-int 20000)))) 116 | (let [n-peers 10 117 | port (+ 1000 (rand-int 10000)) 118 | local (peer {:port port}) 119 | peers (doall 120 | (map 121 | (fn [n] 122 | (let [p (peer {:port (+ port n 1) 123 | :manager (:manager local)})] 124 | (with-peer-graph p 125 | (clear-graph) 126 | (assoc-node ROOT-ID :peer-id n)) 127 | (construct p 128 | (-> (nodes [root ROOT-ID 129 | net :net 130 | docs :docs 131 | a {:label (str "a-" n) :score 0.1} 132 | b {:label (str "b-" n) :score 0.5} 133 | c {:label (str "c-" n) :score 0.9}]) 134 | (edges [root net :net 135 | root docs :docs 136 | docs a :doc 137 | docs b :doc 138 | docs c :doc]))) 139 | [p (with-peer-graph p (root-node-id)) n])) 140 | (range n-peers)))] 141 | (try 142 | (with-peer-graph local 143 | (clear-graph) 144 | (let [net (make-node {:label :net})] 145 | (make-edge ROOT-ID net {:label :net}) 146 | (doseq [[p peer-root n] peers] 147 | (make-edge net 148 | (make-proxy-node peer-root (peer-url "localhost" (+ port n 1))) 149 | :peer)))) 150 | (let [q (-> (q/path [doc [:net :peer :docs :doc]]) 151 | (q/where (> (:score 'doc) 0.5)) 152 | (q/project ['doc :label :score])) 153 | res (query local q)] 154 | (is (= n-peers (count res)))) 155 | (finally 156 | (close local) 157 | (close-peers (map first peers)))))) 158 | 159 | (defn node-chain 160 | "Create a chain of n nodes starting from src, each one connected 161 | by an edge labeled label. Returns the id of the last node in the 162 | chain." 163 | [src n label] 164 | (let [chain-ids (doall 165 | (take (inc n) (iterate 166 | (fn [src-id] 167 | (let [n (make-node)] 168 | (make-edge src-id n label) 169 | n)) 170 | src)))] 171 | (log/to :peer "----------------------\n" 172 | "chain-ids: " (seq chain-ids)) 173 | (last chain-ids))) 174 | 175 | (deftest iter-n-test 176 | (let [local (peer)] 177 | (try 178 | (let [end-id (with-peer-graph local 179 | (clear-graph) 180 | (let [root-id (root-node-id)] 181 | (log/to :peer "root-id: " root-id) 182 | (node-chain root-id 10 :foo))) 183 | res-chan (iter-n-query local 10 (-> (q/path [f [:foo]]) 184 | (q/project 'f)))] 185 | (is (= end-id 186 | (:id (first (lamina/channel-seq res-chan 200)))))) 187 | (finally 188 | (close local))))) 189 | 190 | (deftest connect-test 191 | (let [local (peer {:port 2342}) 192 | connected (atom [])] 193 | (try 194 | (on-connect local (fn [new-con] (swap! connected #(conj % (:url new-con))))) 195 | (dotimes [i 10] 196 | (let [con (get-connection (connection-manager) (peer-url "localhost" 2342))] 197 | (wait-for (get-node con ROOT-ID) 200) 198 | (close con))) 199 | (is (= 10 (count @connected))) 200 | (finally 201 | (close local))))) 202 | 203 | (deftest connection-handler-test 204 | (let [p1 (peer {:port 2222}) 205 | p2 (peer {:port 3333}) 206 | res (atom [])] 207 | (try 208 | (on-connect (:listener p2) (fn [incoming] 209 | (future 210 | (let [root (wait-for (get-node incoming ROOT-ID) 200)] 211 | (swap! res #(conj % [1 (:id root)])))))) 212 | (on-connect (:listener p2) (fn [incoming] 213 | (future 214 | (let [root (wait-for (get-node incoming ROOT-ID) 200)] 215 | (swap! res #(conj % [2 (:id root)])))))) 216 | (let [con (get-connection (connection-manager) (peer-url "localhost" 3333))] 217 | (setup-peer-query-handlers p1 con) 218 | (Thread/sleep 100) 219 | (let [id (:id (get-node p1 ROOT-ID)) 220 | sres (sort-by first @res)] 221 | (is (= [1 id] (first sres))) 222 | (is (= [2 id] (second sres))))) 223 | (finally 224 | (close p1) 225 | (close p2))))) 226 | 227 | (deftest peer-graph-event-test 228 | (let [port (+ 10000 (rand-int 10000)) 229 | local (peer {:path "db/p1" :port port}) 230 | root-id (:id (get-node local ROOT-ID))] 231 | (try 232 | (reset-peer local) 233 | (let [n-id (with-peer-graph local (make-node)) 234 | con (get-connection (connection-manager) (peer-url "localhost" port)) 235 | n-chan (peer-node-event-channel con n-id) 236 | e-chan (peer-edge-event-channel con n-id :test)] 237 | (Thread/sleep 50) 238 | (with-peer-graph local 239 | (dotimes [i 10] 240 | (assoc-node n-id :val i)) 241 | (dotimes [i 10] 242 | (make-edge n-id (make-node) {:label :test :val i}))) 243 | (let [r1 (lamina/channel-seq n-chan 300) 244 | r2 (lamina/channel-seq e-chan 300)] 245 | (is (= 10 (count r1) (count r2))) 246 | (is (= (range 10) 247 | (map (comp :val :props) r1))) 248 | (is (= (range 10) 249 | (map (comp :val :props) r2))))) 250 | (finally 251 | (close local))))) 252 | 253 | (comment 254 | (def p (peer {:port 1234})) 255 | (def con (get-connection (connection-manager) (peer-url "localhost" 1234))) 256 | (query p (q/path [:net])) 257 | (query con (q/path [:net])) 258 | (query-channel con (q/path [:net])) 259 | ) 260 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE 4 | PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF 5 | THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial code and 12 | documentation distributed under this Agreement, and 13 | 14 | b) in the case of each subsequent Contributor: 15 | 16 | i) changes to the Program, and 17 | 18 | ii) additions to the Program; 19 | 20 | where such changes and/or additions to the Program originate from and 21 | are distributed by that particular Contributor. A Contribution 22 | 'originates' from a Contributor if it was added to the Program by such 23 | Contributor itself or anyone acting on such Contributor's 24 | behalf. Contributions do not include additions to the Program which: 25 | (i) are separate modules of software distributed in conjunction with 26 | the Program under their own license agreement, and (ii) are not 27 | derivative works of the Program. 28 | 29 | "Contributor" means any person or entity that distributes the Program. 30 | 31 | "Licensed Patents" mean patent claims licensable by a Contributor 32 | which are necessarily infringed by the use or sale of its Contribution 33 | alone or when combined with the Program. 34 | 35 | "Program" means the Contributions distributed in accordance with this 36 | Agreement. 37 | 38 | "Recipient" means anyone who receives the Program under this 39 | Agreement, including all Contributors. 40 | 41 | 2. GRANT OF RIGHTS 42 | 43 | a) Subject to the terms of this Agreement, each Contributor hereby 44 | grants Recipient a non-exclusive, worldwide, royalty-free copyright 45 | license to reproduce, prepare derivative works of, publicly display, 46 | publicly perform, distribute and sublicense the Contribution of such 47 | Contributor, if any, and such derivative works, in source code and 48 | object code form. 49 | 50 | b) Subject to the terms of this Agreement, each Contributor hereby 51 | grants Recipient a non-exclusive, worldwide, royalty-free patent 52 | license under Licensed Patents to make, use, sell, offer to sell, 53 | import and otherwise transfer the Contribution of such Contributor, if 54 | any, in source code and object code form. This patent license shall 55 | apply to the combination of the Contribution and the Program if, at 56 | the time the Contribution is added by the Contributor, such addition 57 | of the Contribution causes such combination to be covered by the 58 | Licensed Patents. The patent license shall not apply to any other 59 | combinations which include the Contribution. No hardware per se is 60 | licensed hereunder. 61 | 62 | c) Recipient understands that although each Contributor grants the 63 | licenses to its Contributions set forth herein, no assurances are 64 | provided by any Contributor that the Program does not infringe the 65 | patent or other intellectual property rights of any other entity. Each 66 | Contributor disclaims any liability to Recipient for claims brought by 67 | any other entity based on infringement of intellectual property rights 68 | or otherwise. As a condition to exercising the rights and licenses 69 | granted hereunder, each Recipient hereby assumes sole responsibility 70 | to secure any other intellectual property rights needed, if any. For 71 | example, if a third party patent license is required to allow 72 | Recipient to distribute the Program, it is Recipient's responsibility 73 | to acquire that license before distributing the Program. 74 | 75 | d) Each Contributor represents that to its knowledge it has sufficient 76 | copyright rights in its Contribution, if any, to grant the copyright 77 | license set forth in this Agreement. 78 | 79 | 3. REQUIREMENTS 80 | 81 | A Contributor may choose to distribute the Program in object code form 82 | under its own license agreement, provided that: 83 | 84 | a) it complies with the terms and conditions of this Agreement; and 85 | 86 | b) its license agreement: 87 | 88 | i) effectively disclaims on behalf of all Contributors all warranties 89 | and conditions, express and implied, including warranties or 90 | conditions of title and non-infringement, and implied warranties or 91 | conditions of merchantability and fitness for a particular purpose; 92 | 93 | ii) effectively excludes on behalf of all Contributors all liability 94 | for damages, including direct, indirect, special, incidental and 95 | consequential damages, such as lost profits; 96 | 97 | iii) states that any provisions which differ from this Agreement are 98 | offered by that Contributor alone and not by any other party; and 99 | 100 | iv) states that source code for the Program is available from such 101 | Contributor, and informs licensees how to obtain it in a reasonable 102 | manner on or through a medium customarily used for software exchange. 103 | 104 | When the Program is made available in source code form: 105 | 106 | a) it must be made available under this Agreement; and 107 | 108 | b) a copy of this Agreement must be included with each copy of the Program. 109 | 110 | Contributors may not remove or alter any copyright notices contained 111 | within the Program. 112 | 113 | Each Contributor must identify itself as the originator of its 114 | Contribution, if any, in a manner that reasonably allows subsequent 115 | Recipients to identify the originator of the Contribution. 116 | 117 | 4. COMMERCIAL DISTRIBUTION 118 | 119 | Commercial distributors of software may accept certain 120 | responsibilities with respect to end users, business partners and the 121 | like. While this license is intended to facilitate the commercial use 122 | of the Program, the Contributor who includes the Program in a 123 | commercial product offering should do so in a manner which does not 124 | create potential liability for other Contributors. Therefore, if a 125 | Contributor includes the Program in a commercial product offering, 126 | such Contributor ("Commercial Contributor") hereby agrees to defend 127 | and indemnify every other Contributor ("Indemnified Contributor") 128 | against any losses, damages and costs (collectively "Losses") arising 129 | from claims, lawsuits and other legal actions brought by a third party 130 | against the Indemnified Contributor to the extent caused by the acts 131 | or omissions of such Commercial Contributor in connection with its 132 | distribution of the Program in a commercial product offering. The 133 | obligations in this section do not apply to any claims or Losses 134 | relating to any actual or alleged intellectual property 135 | infringement. In order to qualify, an Indemnified Contributor must: a) 136 | promptly notify the Commercial Contributor in writing of such claim, 137 | and b) allow the Commercial Contributor tocontrol, and cooperate with 138 | the Commercial Contributor in, the defense and any related settlement 139 | negotiations. The Indemnified Contributor may participate in any such 140 | claim at its own expense. 141 | 142 | For example, a Contributor might include the Program in a commercial 143 | product offering, Product X. That Contributor is then a Commercial 144 | Contributor. If that Commercial Contributor then makes performance 145 | claims, or offers warranties related to Product X, those performance 146 | claims and warranties are such Commercial Contributor's responsibility 147 | alone. Under this section, the Commercial Contributor would have to 148 | defend claims against the other Contributors related to those 149 | performance claims and warranties, and if a court requires any other 150 | Contributor to pay any damages as a result, the Commercial Contributor 151 | must pay those damages. 152 | 153 | 5. NO WARRANTY 154 | 155 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS 156 | PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 157 | KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY 158 | WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY 159 | OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely 160 | responsible for determining the appropriateness of using and 161 | distributing the Program and assumes all risks associated with its 162 | exercise of rights under this Agreement , including but not limited to 163 | the risks and costs of program errors, compliance with applicable 164 | laws, damage to or loss of data, programs or equipment, and 165 | unavailability or interruption of operations. 166 | 167 | 6. DISCLAIMER OF LIABILITY 168 | 169 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR 170 | ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, 171 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING 172 | WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF 173 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 174 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR 175 | DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED 176 | HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 177 | 178 | 7. GENERAL 179 | 180 | If any provision of this Agreement is invalid or unenforceable under 181 | applicable law, it shall not affect the validity or enforceability of 182 | the remainder of the terms of this Agreement, and without further 183 | action by the parties hereto, such provision shall be reformed to the 184 | minimum extent necessary to make such provision valid and enforceable. 185 | 186 | If Recipient institutes patent litigation against any entity 187 | (including a cross-claim or counterclaim in a lawsuit) alleging that 188 | the Program itself (excluding combinations of the Program with other 189 | software or hardware) infringes such Recipient's patent(s), then such 190 | Recipient's rights granted under Section 2(b) shall terminate as of 191 | the date such litigation is filed. 192 | 193 | All Recipient's rights under this Agreement shall terminate if it 194 | fails to comply with any of the material terms or conditions of this 195 | Agreement and does not cure such failure in a reasonable period of 196 | time after becoming aware of such noncompliance. If all Recipient's 197 | rights under this Agreement terminate, Recipient agrees to cease use 198 | and distribution of the Program as soon as reasonably 199 | practicable. However, Recipient's obligations under this Agreement and 200 | any licenses granted by Recipient relating to the Program shall 201 | continue and survive. 202 | 203 | Everyone is permitted to copy and distribute copies of this Agreement, 204 | but in order to avoid inconsistency the Agreement is copyrighted and 205 | may only be modified in the following manner. The Agreement Steward 206 | reserves the right to publish new versions (including revisions) of 207 | this Agreement from time to time. No one other than the Agreement 208 | Steward has the right to modify this Agreement. The Eclipse Foundation 209 | is the initial Agreement Steward. The Eclipse Foundation may assign 210 | the responsibility to serve as the Agreement Steward to a suitable 211 | separate entity. Each new version of the Agreement will be given a 212 | distinguishing version number. The Program (including Contributions) 213 | may always be distributed subject to the version of the Agreement 214 | under which it was received. In addition, after a new version of the 215 | Agreement is published, Contributor may elect to distribute the 216 | Program (including its Contributions) under the new version. Except as 217 | expressly stated in Sections 2(a) and 2(b) above, Recipient receives 218 | no rights or licenses to the intellectual property of any Contributor 219 | under this Agreement, whether expressly, by implication, estoppel or 220 | otherwise. All rights in the Program not expressly granted under this 221 | Agreement are reserved. 222 | 223 | This Agreement is governed by the laws of the State of Washington and 224 | the intellectual property laws of the United States of America. No 225 | party to this Agreement will bring a legal action under this Agreement 226 | more than one year after the cause of action arose. Each party waives 227 | its rights to a jury trial in any resulting litigation. 228 | -------------------------------------------------------------------------------- /src/peer/core.clj: -------------------------------------------------------------------------------- 1 | (ns peer.core 2 | (:use [peer config url connection presence rpc] 3 | [plasma util graph remote] 4 | clojure.stacktrace) 5 | (:require [logjam.core :as log] 6 | [lamina.core :as lamina] 7 | [jiraph.graph :as jiraph] 8 | [plasma.construct :as c] 9 | [plasma.query :as q])) 10 | 11 | (defmacro with-peer-graph [p & body] 12 | `(let [g# (:graph ~p)] 13 | (locking g# 14 | (if (= jiraph/*graph* g#) 15 | (do ~@body) 16 | (jiraph/with-graph g# ~@body))))) 17 | 18 | (def *manager* nil) 19 | (def DEFAULT-HTL 50) 20 | 21 | (defprotocol IPeer 22 | (peer-id [this] "Get a peer's ID.")) 23 | 24 | (defprotocol IQueryable 25 | ; TODO: change this to find-node once core and query are refactored... 26 | (get-node 27 | [this id] 28 | "Lookup a node by UUID.") 29 | 30 | (construct 31 | [this spec] 32 | "Construct a graph based on a spec.") 33 | 34 | (query 35 | [this q] [this q params] [this q params timeout] 36 | "Issue a query against the peer's graph.") 37 | 38 | (query-channel 39 | [this q] [this q params] 40 | "Issue a query against the graph and return a channel onto which the 41 | results will be enqueued.") 42 | 43 | (recur-query 44 | [this q] [this pred q] [this pred q params] 45 | "Recursively execute a query.") 46 | 47 | (iter-n-query 48 | [this iq] [this n q] [this n q params] 49 | "Execute a query iteratively, n times. The output of one execution is 50 | used as the input to the iteration.") 51 | ) 52 | 53 | (defrecord GraphPeer 54 | [manager graph url port listener status options] ; peer-id, port, max-peers 55 | IPeer 56 | (peer-id 57 | [this] 58 | (with-peer-graph this (root-node-id))) 59 | 60 | IQueryable 61 | (get-node 62 | [this id] 63 | (with-peer-graph this (find-node id))) 64 | 65 | (construct 66 | [this spec] 67 | (with-peer-graph this 68 | (c/construct* spec))) 69 | 70 | (query 71 | [this q] 72 | (query this q {})) 73 | 74 | (query 75 | [this q params] 76 | (query this q params q/MAX-QUERY-TIME)) 77 | 78 | (query 79 | [this q params timeout] 80 | (binding [*manager* manager] 81 | (with-peer-graph this 82 | (q/query q params timeout)))) 83 | 84 | (query-channel 85 | [this q] 86 | (query-channel this q {})) 87 | 88 | (query-channel 89 | [this q params] 90 | (binding [*manager* manager] 91 | (with-peer-graph this 92 | (q/query-channel q params)))) 93 | 94 | (recur-query 95 | [this pred q] 96 | (recur-query this pred q {})) 97 | 98 | (recur-query 99 | [this pred q params] 100 | (let [params (merge (:params q) params) 101 | iplan (assoc q 102 | :type :recur-query 103 | :src-url (:public-url listener) 104 | :pred pred 105 | :recur-count count 106 | :htl DEFAULT-HTL 107 | :params params)] 108 | (recur-query this iplan))) 109 | 110 | (recur-query 111 | [this q] 112 | (comment let [q (map-fn q :recur-count dec) 113 | res-chan (query-channel q (:params q))] 114 | (lamina/on-closed res-chan 115 | (fn [] 116 | (let [res (lamina/channel-seq res-chan)] 117 | ; Send the result back if we hit the end of the recursion 118 | (if (zero? (:recur-count q)) 119 | (let [src-url (:src-url q) 120 | query-id (:id q) 121 | con (get-connection manager (:src-url q))] 122 | (send-event con query-id res)) 123 | 124 | ; or recur if not 125 | (doseq [n res] 126 | (if (proxy-node? n) 127 | (peer-recur-query 128 | (receive-all res-chan 129 | (fn [v] 130 | (if (proxy-node? v) 131 | (peer-recur q v) 132 | (recur* q v))))))))))))) 133 | 134 | ; TODO: Support binding to a different parameter than the ROOT-ID 135 | ; by passing a {:bind 'my-param} map. 136 | (iter-n-query 137 | [this n q] 138 | (iter-n-query this n q {})) 139 | 140 | (iter-n-query 141 | [this n q params] 142 | (let [iplan (assoc q 143 | :type :iter-n-query 144 | :src-url (:public-url listener) 145 | :iter-n n 146 | :htl DEFAULT-HTL 147 | :iter-params params)] 148 | (iter-n-query this iplan))) 149 | 150 | (iter-n-query 151 | [this q] 152 | (let [final-res (lamina/channel) 153 | iter-fn (fn iter-fn [q] 154 | (log/to :peer "iter-n: " (:iter-n q)) 155 | (let [plan (update-in q [:iter-n] dec) 156 | plan (update-in plan [:htl] dec) 157 | res-chan (query-channel this plan (:iter-params plan))] 158 | (lamina/on-closed res-chan 159 | (fn [] 160 | (cond 161 | (zero? (:iter-n plan)) 162 | (lamina/siphon res-chan final-res) 163 | 164 | (zero? (:htl plan)) 165 | (lamina/enqueue final-res 166 | {:type :error 167 | :msg :htl-reached}) 168 | 169 | :default 170 | (let [res (map :id (lamina/channel-seq res-chan)) 171 | params (assoc (:iter-params plan) ROOT-ID res) 172 | plan (assoc plan :iter-params params)] 173 | (log/to :peer "--------------------\n" 174 | "iter-fn result: " 175 | (seq res) 176 | "\n--------------------------\n") 177 | 178 | (iter-fn plan)))))))] 179 | (iter-fn q) 180 | final-res)) 181 | 182 | IConnectionListener 183 | (on-connect 184 | [this handler] 185 | (on-connect listener handler)) 186 | 187 | IClosable 188 | (close 189 | [this] 190 | (close listener) 191 | (when (:internal-manager options) 192 | (clear-connections manager)) 193 | (reset! status :closed))) 194 | 195 | (defn- net-root 196 | [p] 197 | (with-peer-graph p 198 | (:id (first (q/query (q/path [:net])))))) 199 | 200 | (defn add-peer 201 | [p id url] 202 | (log/to :peer "[add-peer] adding:" url) 203 | (with-peer-graph p 204 | (let [prx (make-proxy-node id url) 205 | net (net-root p)] 206 | (make-edge net prx :peer)))) 207 | 208 | (defn get-peers 209 | [p] 210 | (query p (-> (q/path [peer [:net :peer]]) 211 | (q/project ['peer :id :proxy])))) 212 | 213 | (defn- setup-peer-presence 214 | [p] 215 | (let [p-host (local-addr) 216 | p-port (:port p) 217 | pchan (lamina/filter* #(not (and (= p-host (:host %)) 218 | (= p-port (:port %)))) 219 | (presence-channel))] 220 | (lamina/receive-all pchan 221 | (fn [{:keys [id host port]}] 222 | (add-peer p id (peer-url host port)))) 223 | (presence-broadcaster (peer-id p) p-host p-port (config :presence-period)))) 224 | 225 | (defmulti rpc-handler 226 | "A general purpose rpc multimethod." 227 | (fn [peer req] (:method req))) 228 | 229 | (defmethod rpc-handler 'get-node 230 | [peer req] 231 | (get-node peer (first (:params req)))) 232 | 233 | (defmethod rpc-handler 'construct 234 | [peer req] 235 | (construct peer (first (:params req)))) 236 | 237 | (defmethod rpc-handler 'query 238 | [peer req] 239 | (apply query peer (:params req))) 240 | 241 | (defn- request-handler 242 | [peer [ch req]] 243 | (when req 244 | (log/format :peer "request-handler[%s]: %s" (:id req) (:method req)) 245 | (try 246 | (let [res (rpc-handler peer req) 247 | res (if (seq? res) 248 | (doall res) 249 | res) 250 | rpc-res (rpc-response req res)] 251 | (lamina/enqueue ch rpc-res)) 252 | #_(catch java.lang.IllegalArgumentException e 253 | (lamina/enqueue 254 | ch 255 | (rpc-error req (format "No handler found for method: %s\n\n%s" (:method req) 256 | (with-out-str (.printStackTrace e))) e))) 257 | (catch Exception e 258 | (log/to :peer "error handling request!\n------------------\n" 259 | (with-out-str (print-cause-trace e))) 260 | (.printStackTrace e) 261 | (lamina/enqueue ch 262 | (rpc-error req (str "Exception occured while handling request:\n" (with-out-str (.printStackTrace e))) e)))))) 263 | 264 | (defmulti stream-handler 265 | "A general purpose stream multimethod." 266 | (fn [peer ch req] (:method req))) 267 | 268 | (defmethod stream-handler 'query-channel 269 | [peer ch req] 270 | (log/to :peer "[stream-handler] query-channel: " req) 271 | (let [res-chan (apply query-channel peer (:params req))] 272 | (lamina/siphon res-chan ch) 273 | (lamina/on-drained res-chan 274 | (fn [] 275 | (lamina/close ch) 276 | (log/to :peer "[stream-handler] query-channel: closed"))))) 277 | 278 | (defmethod stream-handler 'node-event-channel 279 | [peer ch req] 280 | (log/to :peer "[stream-handler] node-event-channel: " req) 281 | (let [res-chan (with-peer-graph peer 282 | (apply node-event-channel (:params req)))] 283 | (lamina/siphon res-chan ch) 284 | (lamina/on-drained res-chan 285 | (fn [] 286 | (lamina/close ch) 287 | (log/to :peer "[stream-handler] node-event-channel: closed"))))) 288 | 289 | (defmethod stream-handler 'edge-event-channel 290 | [peer ch req] 291 | (log/to :peer "[stream-handler] edge-event-channel: " req) 292 | (let [res-chan (with-peer-graph peer 293 | (apply edge-event-channel (:params req)))] 294 | (lamina/siphon res-chan ch) 295 | (lamina/on-drained res-chan 296 | (fn [] 297 | (lamina/close ch) 298 | (log/to :peer "[stream-handler] edge-event-channel: closed"))))) 299 | 300 | (defn- stream-request-handler 301 | [peer [ch req]] 302 | (when req 303 | (log/to :peer "stream-request: " (:id req)) 304 | (try 305 | (stream-handler peer ch req) 306 | (catch Exception e 307 | (log/to :peer "error handling stream request!\n" 308 | "-------------------------------\n" 309 | (with-out-str (print-cause-trace e))))))) 310 | 311 | (defn setup-peer-query-handlers 312 | "Hook a connection up to a peer so that it can receive queries." 313 | [peer con] 314 | (log/to :peer "handle-peer-connection new-connection: " (:url con)) 315 | 316 | (lamina/receive-all (lamina/filter* #(not (nil? %)) 317 | (lamina/fork (:chan con))) 318 | (fn [msg] (log/to :peer "incoming msg:" msg))) 319 | 320 | (lamina/receive-all (request-channel con) 321 | (partial request-handler peer)) 322 | (lamina/receive-all (stream-channel con) 323 | (partial stream-request-handler peer))) 324 | 325 | (defn setup-peer-graph 326 | [p] 327 | (with-peer-graph p 328 | (if (empty? (q/query (q/path [:net]))) 329 | (make-edge ROOT-ID (make-node) :net)))) 330 | 331 | (defn peer 332 | "Create a new peer. 333 | 334 | Available options: 335 | :path => path to persistent peer graph (database) 336 | :port => specify port number to listen on" 337 | ([] (peer {})) 338 | ([options] 339 | (let [port (get options :port (config :peer-port)) 340 | [manager options] (if (:manager options) 341 | [(:manager options) options] 342 | [(connection-manager) 343 | (assoc options :internal-manager true)]) 344 | g (if-let [path (:path options)] 345 | (open-graph path) 346 | (open-graph)) 347 | listener (connection-listener manager (config :protocol) port) 348 | status (atom :running) 349 | url (:public-url listener) 350 | p (GraphPeer. manager g url port listener status options)] 351 | (setup-peer-graph p) 352 | (on-connect p (partial setup-peer-query-handlers p)) 353 | 354 | (when (config :presence) 355 | (setup-peer-presence p)) 356 | p))) 357 | 358 | ; TODO: Make this URL checking generic, maybe hooking into some Java URL class? (Ugh...) 359 | (defn peer-connection 360 | "Returns a connection to a remote peer reachable by url, using the local peer p's 361 | connection manager." 362 | [p url] 363 | (assert-url url) 364 | (get-connection (:manager p) url)) 365 | 366 | (defn peer-get-node 367 | "Lookup a node by ID on a remote peer, returns a result-channel." 368 | [con id] 369 | (request con 'get-node [id])) 370 | 371 | (defn peer-construct 372 | [con spec] 373 | (request con 'construct [spec])) 374 | 375 | (defn peer-query-channel 376 | ([con q] 377 | (peer-query-channel con q {})) 378 | ([con q params] 379 | (log/to :peer "[peer-query-channel] starting query: " (:id q)) 380 | (let [s-chan (stream con 'query-channel [q params])] 381 | s-chan))) 382 | 383 | (defn peer-node-event-channel 384 | [con src-id] 385 | (stream con 'node-event-channel [src-id])) 386 | 387 | ; TODO: Use query predicate parser to transmit serialized predicates 388 | (defn peer-edge-event-channel 389 | ([con src-id] (peer-edge-event-channel con src-id nil)) 390 | ([con src-id pred] 391 | (stream con 'edge-event-channel [src-id pred]))) 392 | 393 | (defn peer-query 394 | "Send a query to the given peer. Returns a constant channel 395 | that will get the result of the query when it arrives." 396 | ([con q] 397 | (peer-query con q {})) 398 | ([con q params] 399 | (peer-query con q params q/MAX-QUERY-TIME)) 400 | ([con q params timeout] 401 | (let [q (q/with-result-project q) 402 | rchan (query-channel con q params) 403 | p (promise)] 404 | (lamina/on-closed rchan 405 | (fn [] (deliver p (lamina/channel-seq rchan)))) 406 | (await-promise p (+ timeout q/PROMISE-WAIT-TIME))))) 407 | 408 | (defn peer-recur-query 409 | [con q]) 410 | 411 | (defn peer-iter-n-query 412 | [con q n]) 413 | 414 | (defn peer-peer-id 415 | [con] 416 | (get-node con ROOT-ID)) 417 | 418 | (extend peer.connection.Connection 419 | IQueryable 420 | {:get-node peer-get-node 421 | :construct peer-construct 422 | :query peer-query 423 | :query-channel peer-query-channel 424 | :recur-query peer-recur-query 425 | :iter-n-query peer-iter-n-query} 426 | 427 | IPeer 428 | {:peer-id peer-peer-id}) 429 | 430 | (defmethod remote-query-fn :peer 431 | [url] 432 | (partial peer-query-channel (get-connection *manager* url))) 433 | 434 | (defn peer-event-handler 435 | "Setup an event handler that will be added to each new peer connection. 436 | Takes an event type and a handler function that will be called each time a 437 | matching event message is received. The handler should take 3 arguments 438 | which will be the local peer, the remote-peer connection, and the event map." 439 | [p event handler] 440 | (on-connect p 441 | (fn [con] 442 | (lamina/receive-all (event-channel con event) 443 | #(handler p con %))))) 444 | 445 | 446 | -------------------------------------------------------------------------------- /src/peer/connection.clj: -------------------------------------------------------------------------------- 1 | (ns peer.connection 2 | (:use [peer url config presence rpc] 3 | plasma.util 4 | [aleph object udp]) 5 | (:require [logjam.core :as log] 6 | [lamina.core :as lamina]) 7 | (:import [org.bitlet.weupnp GatewayDiscover PortMappingEntry] 8 | [java.net InetAddress NetworkInterface])) 9 | 10 | (def *connection-timeout* 2000) 11 | (def *cache-keep-ratio* 0.8) 12 | 13 | (defn gateway [] 14 | (try 15 | (.getValidGateway (GatewayDiscover.)) 16 | (catch java.io.IOException _ 17 | nil))) 18 | 19 | ; Running the discovery every time takes too long... 20 | (def find-gateway (memoize gateway)) 21 | 22 | (defrecord NetAddress [local public]) 23 | 24 | (defn local-addr 25 | [] 26 | (let [ifaces (enumeration-seq (NetworkInterface/getNetworkInterfaces)) 27 | addrs (flatten (map #(enumeration-seq (.getInetAddresses %)) ifaces)) 28 | hosts (map #(.substring (.toString %) 1) addrs) 29 | ips (filter #(re-find #"[0-9]+\.[0-9]+\.[0-9]+\.[0-9]" %) hosts) 30 | me (first (remove #{"127.0.0.1"} ips))] 31 | me)) 32 | 33 | (defn local-broadcast-addr 34 | [] 35 | (apply str (concat (re-seq #"[0-9]*\." (local-addr)) ["255"]))) 36 | 37 | (defn net-address 38 | [g] 39 | (if g 40 | (NetAddress. 41 | (.getLocalAddress g) 42 | (.getExternalIPAddress g)) 43 | (let [local (local-addr)] 44 | (NetAddress. local local)))) 45 | 46 | (defn setup-port-forward 47 | "Setup a port forward on the local router using UPNP. Throws an exception 48 | if the operation fails. Proto is either :udp or :tcp, and the service is a 49 | string label that will be used to refer to the port forward on the router. 50 | 51 | (setup-port-forward 4242 :tcp \"super peer chat\") 52 | " 53 | ([port proto service] 54 | (setup-port-forward (find-gateway) port proto service)) 55 | ([g port proto service] 56 | (let [entry (PortMappingEntry.) 57 | {:keys [local-addr public-addr]} (net-address g) 58 | addr (.getHostAddress local-addr)] 59 | (if-not (.getSpecificPortMappingEntry g port (.toUpperCase (name proto)) entry) 60 | (.addPortMapping g port port addr proto service))))) 61 | 62 | (defn clear-port-forward 63 | "Clear a port forward." 64 | ([port] 65 | (clear-port-forward port :tcp)) 66 | ([port proto] 67 | (clear-port-forward (find-gateway) port proto)) 68 | ([gateway port proto] 69 | (let [proto (cond 70 | (string? proto) (.toUpperCase proto) 71 | (keyword? proto) (.toUpperCase (name proto)))] 72 | (.deletePortMapping gateway port proto)))) 73 | 74 | ;(log/repl :con) 75 | 76 | (defn- type-channel 77 | "Returns a channel of incoming messages on chan of only the given type." 78 | [chan type] 79 | (lamina/filter* 80 | (fn [msg] (and (associative? msg) 81 | (= type (:type msg)))) 82 | chan)) 83 | 84 | (defn- matched-response-channel 85 | "Returns a result-channel that will receive a single response matching 86 | the request id." 87 | [chan id] 88 | (let [res (lamina/result-channel) 89 | response-chan (lamina/take* 1 (lamina/filter* #(= id (:id %)) 90 | (type-channel chan :response)))] 91 | (lamina/run-pipeline 92 | response-chan 93 | lamina/read-channel 94 | (fn [msg] 95 | (if (:error msg) 96 | (throw (Exception. (:message (:error msg)))) 97 | (:result msg)))))) 98 | 99 | (defn- wrapped-stream-channel 100 | "Given a channel and a stream-id, returns one side of a channel pair 101 | that can be used to communicate with a matched stream channel on the 102 | other side. Allows for multiplexing many streams over one socket 103 | channel." 104 | [chan id] 105 | (let [s-in-chan (lamina/map* #(:msg %) 106 | (lamina/filter* #(= id (:id %)) 107 | (type-channel chan :stream))) 108 | wrap-chan (lamina/channel) 109 | [snd-chan rcv-chan] (lamina/channel-pair)] 110 | (lamina/on-drained rcv-chan 111 | (fn [] 112 | (log/format :stream "[%s] stream closed locally" id) 113 | (lamina/enqueue chan {:type :stream :id id :msg ::closed}))) 114 | 115 | (lamina/receive-all s-in-chan 116 | (fn [msg] 117 | (if (= ::closed msg) 118 | (do 119 | (lamina/close snd-chan) 120 | (log/format :stream "[%s] stream closed remotely" id)) 121 | (lamina/enqueue rcv-chan msg)))) 122 | 123 | (lamina/siphon (lamina/map* (fn [msg] 124 | {:type :stream 125 | :id id 126 | :msg msg}) 127 | rcv-chan) 128 | chan) 129 | (lamina/receive-all (lamina/fork snd-chan) 130 | #(log/to :stream "send: " %)) 131 | (lamina/receive-all (lamina/fork rcv-chan) 132 | #(log/to :stream "recv: " %)) 133 | 134 | snd-chan)) 135 | 136 | (defprotocol IClosable 137 | (close [this])) 138 | 139 | (defprotocol IConnection 140 | (request 141 | [con method params] 142 | "Send a request over this connection. Returns a result-channel 143 | that will receive a single result message, or an error.") 144 | 145 | (request-channel 146 | [con] 147 | "Returns a channel for incoming requests. The channel will receive 148 | [ch request] pairs, and the rpc-response or rpc-error enqueued on 149 | ch will be sent as the response.") 150 | 151 | (send-event 152 | [con id params] 153 | "Send an event over this connection.") 154 | 155 | (event-channel 156 | [con] [con id] 157 | "Returns a channel for incoming events. If an ID is passed only incoming 158 | events with this ID will be enqueued onto the returned channel.") 159 | 160 | (stream 161 | [con method params] 162 | "Open a stream channel on this connection. Returns a channel that can be 163 | used bi-directionally.") 164 | 165 | (stream-channel 166 | [con] 167 | "Returns a channel for incoming stream requests. The channel will receive 168 | [ch request] pairs, and the ch can be used as a named bi-direction stream.") 169 | 170 | (on-closed 171 | [con handler] 172 | "Register a handler to be called when this connection is closed.")) 173 | 174 | (defrecord Connection 175 | [url chan] 176 | IConnection 177 | 178 | (request 179 | [this method params] 180 | (let [id (uuid) 181 | res (matched-response-channel chan id)] 182 | (lamina/enqueue chan (rpc-request id method params)) 183 | res)) 184 | 185 | (request-channel 186 | [this] 187 | (lamina/map* (fn [request] [chan request]) 188 | (type-channel chan :request))) 189 | 190 | (send-event 191 | [this id params] 192 | (lamina/enqueue chan (rpc-event id params))) 193 | 194 | (event-channel 195 | [this] 196 | (type-channel chan :event)) 197 | 198 | (event-channel 199 | [this id] 200 | (lamina/filter* (fn [req] (= id (:id req))) 201 | (type-channel chan :event))) 202 | 203 | (stream 204 | [this method params] 205 | (let [id (uuid) 206 | req {:type :stream-request 207 | :id id 208 | :method method 209 | :params params}] 210 | (lamina/enqueue chan req) 211 | (wrapped-stream-channel chan id))) 212 | 213 | (stream-channel 214 | [this] 215 | (lamina/map* (fn [s-req] 216 | [(wrapped-stream-channel chan (:id s-req)) s-req]) 217 | (type-channel chan :stream-request))) 218 | 219 | (on-closed 220 | [this handler] 221 | (lamina/on-closed chan handler)) 222 | 223 | IClosable 224 | (close 225 | [this] 226 | (lamina/close chan))) 227 | 228 | (defmulti connection-channel 229 | "Returns a channel representing a network connection to the peer listening at URL." 230 | (fn [url] (keyword (:proto (url-map url))))) 231 | 232 | (defmethod connection-channel :peer 233 | [url] 234 | (let [{:keys [proto host port]} (url-map url) 235 | client (object-client {:host host :port port}) 236 | chan (lamina/wait-for-result client *connection-timeout*)] 237 | chan)) 238 | 239 | (def BASE-UDP-PORT 10000) 240 | 241 | (defn try-with-meta 242 | "Returns obj with the meta-data m if possible, otherwise just returns 243 | obj unmodified." 244 | [obj m] 245 | (if (isa? (type obj) clojure.lang.IObj) 246 | (with-meta obj m) 247 | obj)) 248 | 249 | (defmethod connection-channel :upeer 250 | [url] 251 | (let [in-port (+ BASE-UDP-PORT (rand-int 20000)) 252 | udp-chan @(udp-object-socket {:port in-port}) 253 | {:keys [proto host port]} (url-map url) 254 | [inner outer] (lamina/channel-pair)] 255 | (log/to :con "[udp-connection] connecting to:" url) 256 | 257 | (lamina/receive-all (lamina/fork udp-chan) 258 | (fn [msg] (log/to :con "[udp-con] MSG: " msg "\n\n"))) 259 | 260 | (lamina/siphon 261 | (lamina/map* (fn [obj] 262 | (let [msg {:message obj :host host :port port}] 263 | (log/to :con "[udp-con] sending msg: " msg) 264 | msg)) 265 | outer) 266 | udp-chan) 267 | 268 | (lamina/siphon 269 | (lamina/map* (fn [msg] 270 | (log/to :con "[udp-con] received:" msg) 271 | (try-with-meta (:message msg) 272 | (dissoc msg :message))) 273 | udp-chan) 274 | outer) 275 | 276 | (lamina/on-closed inner #(do 277 | (log/to :con "[udp-con] closed!") 278 | (lamina/close udp-chan))) 279 | inner)) 280 | 281 | (defn- make-connection 282 | [url] 283 | (let [chan (connection-channel url)] 284 | (Connection. url chan))) 285 | 286 | (defprotocol IConnectionCache 287 | "A general purpose PeerConnection cache." 288 | 289 | (get-connection 290 | [this url] 291 | "Returns a connection to the peer listening at URL, using a cached 292 | connection when available.") 293 | 294 | (register-connection 295 | [this con] [this ch url] 296 | "Add a new connection to the cache that will use an existing channel and 297 | URL. Used to register connections initiated remotely. 298 | Returns the Connection.") 299 | 300 | (refresh-connection 301 | [this con] 302 | "Updates the usage timestamp on this connection to keep it from being 303 | removed from the cache.") 304 | 305 | (purge-connections 306 | [this] 307 | "Apply the cache policy to the current set of connections, possibly 308 | removing old or unused connections to make space for new ones. This is 309 | called automatically so it should normally not need to be called manually.") 310 | 311 | (remove-connection 312 | [this con] 313 | "Remove a connection from the cache.") 314 | 315 | (clear-connections 316 | [this] 317 | "Remove all connections from the cache.") 318 | 319 | (connection-count 320 | [this] 321 | "Get the current number of connections in the cache.")) 322 | 323 | (defrecord ConnectionManager 324 | [connections* flush-fn] 325 | 326 | IConnectionCache 327 | 328 | (get-connection 329 | [this url] 330 | (let [con-entry (get @connections* url) 331 | con (if con-entry 332 | (:con con-entry) 333 | (make-connection url))] 334 | (refresh-connection this con))) 335 | 336 | (remove-connection 337 | [this con] 338 | (dosync (alter connections* dissoc (:url con)))) 339 | 340 | (register-connection 341 | [this con] 342 | (log/to :con "register-connection: " (:url con)) 343 | (refresh-connection this con) 344 | (on-closed con #(remove-connection this con)) 345 | con) 346 | 347 | (register-connection 348 | [this url ch] 349 | (register-connection this (Connection. url ch))) 350 | 351 | (refresh-connection 352 | [this con] 353 | (dosync (alter connections* 354 | assoc (:url con) {:last-used (current-time) :con con})) 355 | (when (>= (connection-count this) (config :connection-cache-limit)) 356 | (purge-connections this)) 357 | con) 358 | 359 | (clear-connections 360 | [this] 361 | (dosync 362 | (doseq [con (map :con (vals @connections*))] 363 | (close con)) 364 | (ref-set connections* {}))) 365 | 366 | (purge-connections 367 | [this] 368 | (dosync 369 | (let [n-to-drop (- (connection-count this) 370 | (* (config :connection-cache-limit) 371 | *cache-keep-ratio*))] 372 | (alter connections* 373 | (fn [conn-map] 374 | (let [[to-keep to-drop] (flush-fn (vals conn-map) n-to-drop)] 375 | (doseq [con-entry to-drop] 376 | (close (:con con-entry))) 377 | (zipmap (map #(:url (:con %)) to-keep) to-keep))))))) 378 | 379 | (connection-count 380 | [this] 381 | (count @connections*))) 382 | 383 | (defn- lru-flush 384 | "Remove the least recently used connections." 385 | [connections n-to-drop] 386 | (let [sorted (sort-by :last-used connections) 387 | to-drop (take n-to-drop sorted) 388 | to-keep (drop n-to-drop sorted)] 389 | [to-keep to-drop])) 390 | 391 | ; TODO: support options for the cache size and timeout... 392 | ; * make connections asynchronous and call a callback or something 393 | (defn connection-manager 394 | "Returns a connection cache that can be used to efficiently manage a large 395 | number of network connections, where the least-recently-used connections 396 | are dropped as new connections are made." 397 | [] 398 | (ConnectionManager. (ref {}) lru-flush )) 399 | 400 | (defprotocol IConnectionListener 401 | (on-connect 402 | [this handler] 403 | "Register a handler function to be called on each incoming connection. The 404 | handler will be passed a Connection.")) 405 | 406 | (defrecord ConnectionListener 407 | [server port chan local-addr public-addr public-url] 408 | 409 | IConnectionListener 410 | (on-connect 411 | [this handler] 412 | (lamina/receive-all chan #(when % (handler %)))) 413 | 414 | IClosable 415 | (close 416 | [this] 417 | (server) 418 | (lamina/close chan))) 419 | 420 | (defmulti make-listener 421 | "Create a network socket listener that will call the 422 | (handler chan client-info) 423 | for each incoming connection." 424 | (fn [proto port handler] 425 | (keyword proto))) 426 | 427 | (defmethod make-listener :peer 428 | [proto port handler] 429 | (start-object-server handler {:port port})) 430 | 431 | (defmethod make-listener :upeer 432 | [proto port handler] 433 | (let [known-hosts (ref #{}) 434 | udp-chan @(udp-object-socket {:port port})] 435 | (log/to :con "[udp listener] listening on port: " port) 436 | (lamina/receive-all (lamina/fork udp-chan) 437 | (fn [msg] (log/to :con "[udp listener] MSG: " msg "\n\n"))) 438 | 439 | (log/to :con "[udp listener] setting up receivers...") 440 | (lamina/receive-all udp-chan 441 | (fn [msg] 442 | (log/to :con "[udp listener] top------------------") 443 | (let [host-key (select-keys msg [:host :port]) 444 | new-host? (boolean 445 | (dosync 446 | (if ((ensure known-hosts) host-key) 447 | false 448 | (alter known-hosts conj host-key))))] 449 | (log/to :con "[udp listener] new?:" new-host? " msg: " msg) 450 | (when new-host? 451 | (let [[inner outer] (lamina/channel-pair)] 452 | 453 | (log/to :con "[udp listener] setup incoming") 454 | ; incoming messages with the same host/port go to the outer channel 455 | (lamina/siphon 456 | (lamina/map* 457 | (fn [msg] (try-with-meta (:message msg) 458 | (dissoc msg :message))) 459 | (lamina/filter* 460 | (fn [{:keys [host port]}] (= host-key {:host host :port port})) 461 | udp-chan)) 462 | outer) 463 | 464 | (log/to :con "[udp listener] setup outgoing") 465 | ; messages enqueued on inner get wrapped as udp "packets" and sent 466 | ; to the socket channel 467 | (lamina/siphon 468 | (lamina/map* 469 | (fn [obj] 470 | (log/to :con "[udp listener] sending: " 471 | (assoc host-key :message obj)) 472 | (assoc host-key :message obj)) 473 | outer) 474 | udp-chan) 475 | 476 | (lamina/enqueue outer (try-with-meta (:message msg) 477 | (dissoc msg :message))) 478 | (handler inner host-key)))))) 479 | #(lamina/close udp-chan))) 480 | 481 | (defn connection-listener 482 | "Listen on a port for incoming connections, automatically registering them." 483 | [manager proto port] 484 | (let [connect-chan (lamina/channel) 485 | g (find-gateway) 486 | {:keys [local public]} (net-address g) 487 | public-url (peer-url (or public local "127.0.0.1") port) 488 | listener (make-listener 489 | proto port 490 | (fn [chan client-info] 491 | (log/to :con "handling new connection: " client-info) 492 | (let [{:keys [host port]} client-info 493 | url (url proto host port) 494 | con (register-connection manager url chan)] 495 | (log/to :con "listener new connection: " url con) 496 | (lamina/enqueue connect-chan con))))] 497 | (ConnectionListener. listener port connect-chan local public public-url))) 498 | 499 | --------------------------------------------------------------------------------