Lots of changes, added many new functions to the applet.

7 files changed, 271 insertions, 79 deletions

diff --git a/src/org/gnu/clojure/gnunet/crypto.clj b/src/org/gnu/clojure/gnunet/crypto.clj
index b9e7693..a0e9808 100644
--- a/src/org/gnu/clojure/gnunet/crypto.clj
+++ b/src/org/gnu/clojure/gnunet/crypto.clj
@@ -1,15 +1,18 @@
 (ns org.gnu.clojure.gnunet.crypto
-  (:use (org.gnu.clojure.gnunet parser message primes)
-    clojure.contrib.monads clojure.test)
+  (:use clojure.contrib.monads
+    clojure.test
+    (org.gnu.clojure.gnunet message parser primes))
   (:import java.math.BigInteger
+    (java.security KeyFactory KeyPairGenerator MessageDigest Signature)
+    (java.security.spec PKCS8EncodedKeySpec RSAKeyGenParameterSpec
+      RSAPrivateCrtKeySpec RSAPublicKeySpec)
+    java.util.Locale
     java.util.zip.CRC32
-    (java.security KeyPairGenerator KeyFactory MessageDigest Signature)
-    (java.security.spec RSAKeyGenParameterSpec RSAPublicKeySpec
-                        RSAPrivateCrtKeySpec)
-    (javax.crypto Cipher KeyGenerator SecretKeyFactory Mac)
-    (javax.crypto.spec SecretKeySpec IvParameterSpec)))
+    (javax.crypto Cipher KeyGenerator Mac SecretKeyFactory)
+    (javax.crypto.spec IvParameterSpec SecretKeySpec)))
 
 (def hash-size 64)
+(def ascii-hash-size (quot (+ 4 (* 64 8)) 5))
 (def signature-size 256)
 (def aes-key-size 32)
 (def aes-iv-size (/ aes-key-size 2))
@@ -19,6 +22,64 @@
   [byte-seq]
   (.digest (MessageDigest/getInstance "SHA-512") (byte-array byte-seq)))
 
+(with-test
+(defn encode-ascii-hash
+  [byte-seq]
+  (let [padded (concat byte-seq [(byte 0)])
+        uint (decode-uint padded)
+        base32 (.toString uint 32)
+        unpadded (.substring base32 0 (dec (.length base32)))
+        upper (.toUpperCase unpadded Locale/ENGLISH)
+        padded2 (concat (repeat (- ascii-hash-size (.length upper)) \0) upper)]
+    (String. (char-array padded2))))
+(is (= (encode-ascii-hash (repeat hash-size (byte 0)))
+      (String. (char-array (repeat ascii-hash-size \0)))))
+(is (= (encode-ascii-hash
+         (map #(.byteValue %)
+           [   0    0    0    0    0
+              -1   -1   -1   -1   -1
+               0    0    0    0    1
+            -128    0    0    0    0
+               0   68   50   20  -57
+              66   84  -74   53  -49
+            -124  101   58   86  -41
+             -58  117  -66  119  -33
+              40   41   42   43   44
+              45   46   47   48   49
+              50   51   52   53   54
+              55   56   57   58   59
+              60   61   62   63]))
+      "00000000VVVVVVVV00000001G00000000123456789ABCDEFGHIJKLMNOPQRSTUV50KIKAPC5KN2UC1H68PJ8D9M6SS3IEHR7GUJSFO")))
+         
+(with-test
+(defn decode-ascii-hash
+  [string]
+  (let [padded (concat string "0")
+        uint (BigInteger. (String. (char-array padded)) 32)
+        binary (encode-int uint)
+        unpadded (butlast binary)
+        padded2 (concat (repeat (- hash-size (count unpadded)) (byte 0))
+                  unpadded)]
+    (vec padded2)))
+(is (= (decode-ascii-hash (String. (char-array (repeat ascii-hash-size \0))))
+      (repeat hash-size (byte 0))))
+(is (= (decode-ascii-hash
+         "00000000VVVVVVVV00000001G00000000123456789ABCDEFGHIJKLMNOPQRSTUV50KIKAPC5KN2UC1H68PJ8D9M6SS3IEHR7GUJSFO")
+      (map #(.byteValue %)
+        [   0    0    0    0    0
+           -1   -1   -1   -1   -1
+            0    0    0    0    1
+         -128    0    0    0    0
+            0   68   50   20  -57
+           66   84  -74   53  -49
+         -124  101   58   86  -41
+          -58  117  -66  119  -33
+           40   41   42   43   44
+           45   46   47   48   49
+           50   51   52   53   54
+           55   56   57   58   59
+           60   61   62   63]))))
+
 (defn hmac-sha-512
   [key-seq byte-seq]
   (let [hmac-key (SecretKeySpec. (byte-array key-seq) "HmacSHA512")
@@ -185,12 +246,16 @@
     (.generatePublic keyfactory keyspec)))
 
 (defn make-rsa-private-key
-  "Make an RSA private key from PKCS#1 values."
-  [e n p q d u dp dq]
-  (let [keyfactory (KeyFactory/getInstance "RSA")
-        ;; Swap p and q, in java q < p
-        keyspec (RSAPrivateCrtKeySpec. n e d q p dq dp u)]
-    (.generatePrivate keyfactory keyspec)))
+  "Make an RSA private key from PKCS#1 values or PKCS#8 encoded."
+  ([e n p q d u dp dq]
+    (let [keyfactory (KeyFactory/getInstance "RSA")
+          ;; Swap p and q, in java q < p
+          keyspec (RSAPrivateCrtKeySpec. n e d q p dq dp u)]
+      (.generatePrivate keyfactory keyspec)))
+  ([byte-seq]
+    (let [keyfactory (KeyFactory/getInstance "RSA")
+          keyspec (PKCS8EncodedKeySpec. (byte-array byte-seq))]
+      (.generatePrivate keyfactory keyspec))))
 
 (defn rsa-sign
   [private-key byte-seq]
diff --git a/src/org/gnu/clojure/gnunet/filesharing.clj b/src/org/gnu/clojure/gnunet/filesharing.clj
index 53fee2a..c05c36c 100644
--- a/src/org/gnu/clojure/gnunet/filesharing.clj
+++ b/src/org/gnu/clojure/gnunet/filesharing.clj
@@ -75,7 +75,7 @@
      :let [load-limit (+ (network-load peer) (cpu-load peer) (disk-load peer))]
      :let [priority (if (== 0 load-limit)
                       (do
-                        (metric-add peer "Filesharing requests done for free" 1)
+                        (metric-add! peer "Filesharing requests done for free" 1)
                         0)
                       priority)]
      trust (fetch-val :trust 0)
@@ -88,7 +88,7 @@
             %))
      :when (if (<= load-limit priority)
              true
-             (do (metric-add peer
+             (do (metric-add! peer
                    "Filesharing requests dropped, priority insufficient" 1)
                false))
      _ (set-val :trust (- trust priority))]
@@ -119,7 +119,7 @@
                    (partial forward-request! peer query-id return-to-id)
                    (get-processing-delay! peer)
                    TimeUnit/MILLISECONDS)
-               (metric-add peer
+               (metric-add! peer
                  "Filesharing requests delayed, no suitable destination" 1)
                false)
              true)]
@@ -156,7 +156,7 @@
      :when (if (:is-connected (deref (:state-agent return-to)))
              true
              ;; TODO: try connect
-             (do (metric-add peer
+             (do (metric-add! peer
                    "Filesharing requests dropped, missing reverse route" 1)
                false))
      priority (bound-priority peer (:priority get-message))
@@ -171,7 +171,7 @@
        :let [duplicate (query (:id return-to))]
        :when (if (nil? duplicate)
                true
-               (do (metric-add peer "Filehsaring requests dropped, duplicate" 1)
+               (do (metric-add! peer "Filehsaring requests dropped, duplicate" 1)
                  false))
        :let [queries (assoc queries (:query get-message)
                        (assoc query (:id return-to)
@@ -184,7 +184,7 @@
        ttl-queue (fetch-val :ttl-queue (PriorityQueue. 1 ttl-comparator))
        :let [_ (.add ttl-queue (with-meta [(:query get-message) (:id return-to)]
                                  {:ttl (+ ttl (.getTime start-time))}))]
-       :let [_ (metric-set peer
+       :let [_ (metric-set! peer
                  "Filesharing pending requests" (.size ttl-queue))]
        :let [expired (when (< max-pending-requests (.size ttl-queue))
                        (.poll ttl-queue))]
diff --git a/src/org/gnu/clojure/gnunet/metrics.clj b/src/org/gnu/clojure/gnunet/metrics.clj
index 6aa12f1..3daad3b 100644
--- a/src/org/gnu/clojure/gnunet/metrics.clj
+++ b/src/org/gnu/clojure/gnunet/metrics.clj
@@ -1,14 +1,14 @@
 (ns org.gnu.clojure.gnunet.metrics)
 
-(defn metric-set
+(defn metric-set!
   [peer metric value]
   (send (:metrics-agent peer)
     (fn [metrics]
       (assoc metrics metric value))))
 
-(defn metric-add
+(defn metric-add!
   ([peer metric value]
-    (metric-add peer metric value 0))
+    (metric-add! peer metric value 0))
   ([peer metric value zero]
     (send (:metrics-agent peer)
       (fn [metrics]
diff --git a/src/org/gnu/clojure/gnunet/peer.clj b/src/org/gnu/clojure/gnunet/peer.clj
index 0619088..adb7a2b 100644
--- a/src/org/gnu/clojure/gnunet/peer.clj
+++ b/src/org/gnu/clojure/gnunet/peer.clj
@@ -137,11 +137,11 @@
         disk-bound-executor (ThreadPoolExecutor. 0 1 60 TimeUnit/SECONDS
                               disk-bound-queue)]
     (struct-map peer-struct
-      :public-key-atom (atom (.getPublic (:keypair options)))
-      :id (generate-id (.getPublic (:keypair options)))
+      :public-key-atom (atom (:public-key options))
+      :id (generate-id (:public-key options))
       :transport-addresses-agent (agent {})
       :state-agent (agent {})
-      :private-key (.getPrivate (:keypair options))
+      :private-key (:private-key options)
       :remote-peers-agent (agent {})
       :transports-agent (agent {})
       :dispatch-agent (agent {})
diff --git a/src/org/gnu/clojure/gnunet/transport.clj b/src/org/gnu/clojure/gnunet/transport.clj
index 651aa06..25d1511 100644
--- a/src/org/gnu/clojure/gnunet/transport.clj
+++ b/src/org/gnu/clojure/gnunet/transport.clj
@@ -153,7 +153,7 @@
     (expire-transport-addresses (Date.)
       (concat (list-transport-addresses addresses) new-addresses))))
 
-(defn update-remote-peers
+(defn update-remote-peers!
   [remote-peers peer-id hello]
   (let [remote-peer (remote-peers peer-id)]
     (if remote-peer
@@ -174,7 +174,7 @@
                                          (:transport-addresses hello)))
           :state-agent (agent {:is-connected false}))))))
 
-(defn verify-transport-address
+(defn verify-transport-address!
   [peer remote-peer address]
   (second
     ((domonad exception-m
@@ -193,17 +193,17 @@
          [(hello-for-peer-message peer)
           (ping-message remote-peer address challenge)])) address)))
 
-(defn verify-transport-addresses
+(defn verify-transport-addresses!
   [addresses peer remote-peer]
   (merge-transport-addresses {}
-    (map (partial verify-transport-address peer remote-peer)
+    (map (partial verify-transport-address! peer remote-peer)
       (list-transport-addresses addresses))))
 
-(defn verify-remote-peers
+(defn verify-remote-peers!
   [remote-peers peer]
   (doseq [[_ remote-peer] remote-peers]
     (send (:transport-addresses-agent remote-peer)
-      verify-transport-addresses peer remote-peer))
+      verify-transport-addresses! peer remote-peer))
   remote-peers)
 
 (defn admit-hello!
@@ -212,8 +212,8 @@
   (let [peer-id (generate-id (:public-key hello))]
     (if (not (= peer-id (:id peer)))
       (let [remote-peers-agent (:remote-peers-agent peer)]
-        (send remote-peers-agent update-remote-peers peer-id hello)
-        (send remote-peers-agent verify-remote-peers peer)))))
+        (send remote-peers-agent update-remote-peers! peer-id hello)
+        (send remote-peers-agent verify-remote-peers! peer)))))
 
 (defn handle-hello!
   [peer message]
@@ -309,7 +309,7 @@
                  {:expiration (hello-address-expiration)
                   :latency (- (.getTime (Date.))
                              (.getTime (:send-time address)))}))]
-          (metric-add peer "Peer addresses considered valid" 1))))))
+          (metric-add! peer "Peer addresses considered valid" 1))))))
 
 (defn handle-pong-using!
   [peer remote-peer pong]
@@ -345,7 +345,7 @@
   ;; (.write *out* (str "Received " message "\n"))
   (send (:remote-peers-agent peer)
     (fn [remote-peers]
-      (let [remote-peers (update-remote-peers remote-peers
+      (let [remote-peers (update-remote-peers! remote-peers
                            sender-id {:transport-addresses [address]})
             remote-peer (remote-peers sender-id)]
         (condp = (:message-type message)
diff --git a/src/org/gnu/clojure/gnunetapplet/applet.clj b/src/org/gnu/clojure/gnunetapplet/applet.clj
index 86e9b80..ded04ae 100644
--- a/src/org/gnu/clojure/gnunetapplet/applet.clj
+++ b/src/org/gnu/clojure/gnunetapplet/applet.clj
@@ -1,12 +1,15 @@
 (ns org.gnu.clojure.gnunetapplet.applet
-  (:use clojure.contrib.monads
+  (:use (clojure.contrib json monads)
     [clojure.main :only (repl)]
-    (org.gnu.clojure.gnunet crypto exception))
+    (org.gnu.clojure.gnunet crypto hostlist inet peer tcp transport)
+    org.gnu.clojure.gnunetapplet.base64)
   (:import
     clojure.lang.LineNumberingPushbackReader
     (java.io InputStreamReader OutputStreamWriter
       PipedInputStream PipedOutputStream PrintWriter)
-    (netscape.javascript JSObject JSException))
+    java.security.SecureRandom
+    java.util.concurrent.Executors
+    netscape.javascript.JSObject)
   (:gen-class
    :extends java.applet.Applet
    :state state
@@ -14,7 +17,16 @@
    :main false
    :set-context-classloader true
    :methods [[ver [] String]
-             [write [String] Void]]))
+             [repl [netscape.javascript.JSObject
+                    netscape.javascript.JSObject]
+              java.io.PipedOutputStream]
+             [write [java.io.PipedOutputStream String] Void]
+             [generateKey [netscape.javascript.JSObject] Void]
+             [startPeer [String netscape.javascript.JSObject] Void]
+             [configureTCP [clojure.lang.APersistentMap Integer] Void]
+             [watchPeers [clojure.lang.APersistentMap
+                          netscape.javascript.JSObject] Void]
+             [fetchHostlist [clojure.lang.APersistentMap String] Void]]))
 
 (def applet-ns *ns*)
 
@@ -22,54 +34,157 @@
   "The job of this constructor is to initialize state. The rest of the
    initalization happens in the Applet init method."
   []
-  [[] (agent {})])
+  ;; Instead of (set! *warn-on-reflection* true)
+  ;;(push-thread-bindings {#'*warn-on-reflection* true})
+  [[] (ref {})])
 
-(defn jscall
+(defn jscall-wait
   [applet f & args]
   (try
     (.call (JSObject/getWindow applet) f (object-array args))
-    (catch JSException e
-      (.printStackTrace e))))
+    (catch Exception e
+      (.printStackTrace e (System/err)))))
+  
+(defn jscall
+  "Call a javascript function named f with args."
+  [applet f & args]
+  (.execute (:js-executor @(.state applet))
+    #(apply jscall-wait applet f args))) 
 
-(defn my-repl
-  [applet]
-  (.setContextClassLoader (Thread/currentThread)
-    (.getClassLoader (.getClass applet)))
-  (let [input (PipedOutputStream.)
-        in (LineNumberingPushbackReader.
-             (InputStreamReader. (PipedInputStream. input)))
-        out (OutputStreamWriter.
-              (proxy [java.io.ByteArrayOutputStream] []
-                (flush []
-                  (jscall applet "out" (str this))
-                  (.reset this))))
-        err (PrintWriter.
-              (OutputStreamWriter.
-                (proxy [java.io.ByteArrayOutputStream] []
-                  (flush []
-                    (jscall applet "err" (str this))
-                    (.reset this))))
-              true)]
-    (send (.state applet) #(assoc % :input input))
-    (declare *applet*)
-    (with-bindings {#'*in* in
-                    #'*out* out
-                    #'*err* err
-                    #'*ns* applet-ns
-                    #'*applet* applet}
-      (repl))))
+(defn jsobject-call
+  "Call a javascript function f with args."
+  [applet ^JSObject f & args]
+  (.execute (:js-executor @(.state applet))
+    (fn []
+      (try
+        (.call f "call" (object-array (cons nil args)))
+        (catch Exception e
+          (.printStackTrace e (System/err)))))))
 
 (defn -init
-  [this]
-  (let [thread (Thread. (partial my-repl this))]
-    (.start thread)
-    (send (.state this) #(assoc % :repl-thread thread))))
+  "Initialize applet."
+  [applet]
+  (let [js-executor (Executors/newSingleThreadExecutor)
+        priv-executor (Executors/newSingleThreadExecutor)
+        random (SecureRandom.)]
+    (dosync
+      (alter (.state applet) conj
+        {:js-executor js-executor
+         :priv-executor priv-executor
+         :random random}))
+    ;; Prime the priv-executor
+    (.execute priv-executor
+      #(jscall applet "gnunetInit"))))
 
 (defn -ver
-  [this]
-  "0.12")
+  "Returns the version of this applet. Mainly for debugging."
+  [applet]
+  "0.22")
+
+(defn my-repl
+  [applet stdin stdout stderr]
+  (.setContextClassLoader (Thread/currentThread)
+    (.getClassLoader (.getClass applet)))
+  (declare *applet*)
+  (with-bindings {#'*in* stdin
+                  #'*out* stdout
+                  #'*err* stderr
+                  #'*ns* applet-ns
+                  #'*applet* applet}
+    (repl)))
+
+(defn -repl
+  "Creates a REPL thread which calls the javascript functions out and err.
+   Returns a PipedOutputStream for input to the REPL."
+  [applet out err]
+  (let [input (PipedOutputStream.)]
+    (.execute (:priv-executor @(.state applet))
+      (fn []
+        (let [stdin (LineNumberingPushbackReader.
+                      (InputStreamReader. (PipedInputStream. input)))
+              stdout (OutputStreamWriter.
+                       (proxy [java.io.ByteArrayOutputStream] []
+                         (flush []
+                           (jsobject-call applet out (str this))
+                           (.reset this))))
+              stderr (PrintWriter.
+                       (OutputStreamWriter.
+                         (proxy [java.io.ByteArrayOutputStream] []
+                           (flush []
+                             (jsobject-call applet err (str this))
+                             (.reset this))))
+                       true)
+              thread (Thread. (partial my-repl applet stdin stdout stderr))]
+          (.start thread))))
+    input))
 
 (defn -write
-  [this string]
-  (when-let [input (:input (deref (.state this)))]
-    (.write input (.getBytes string))))
+  "Write a string to the given stream."
+  [applet stream string]
+  (.write stream (.getBytes string)))
+
+(defn -generateKey
+  [applet f]
+  (.execute (:priv-executor @(.state applet))
+    (fn []
+      (let [keypair (generate-rsa-keypair! (:random @(.state applet)))
+            pkcs8 (.getEncoded (.getPrivate keypair))]
+        (jsobject-call applet f (base64-encode pkcs8))))))
+
+(defn -startPeer
+  [applet b64key f]
+  (.execute (:priv-executor @(.state applet))
+    (fn []
+      (let [pkcs8 (base64-decode b64key)
+            private-key (make-rsa-private-key pkcs8)
+            public-key (make-rsa-public-key (.getModulus private-key)
+                         (.getPublicExponent private-key))
+            peer (new-peer {:random (:random @(.state applet))
+                            :public-key public-key
+                            :private-key private-key})]
+        (.start (:selector-thread peer))
+        (jsobject-call applet f peer)))))
+
+(defn -configureTCP
+  [applet peer port]
+  ;; TODO: make TCP reconfigurable
+  (.execute (:priv-executor @(.state applet))
+    (fn []
+      (activate-tcp! peer port)
+      (configure-inet-addresses! peer "tcp" (get-local-addresses) port))))
+
+(defn transport-addresses-watcher
+  [applet peer f watched-agent old-state new-state]
+  )
+
+(defn remote-peers-watcher
+  [applet f watched-agent old-state new-state]
+  (try
+  (let [peers-added (apply dissoc new-state (keys old-state))
+        peers-removed (apply dissoc old-state (keys new-state))]
+    (doseq [peer (vals peers-added)]
+      (add-watch (:transport-addresses-agent peer) f
+        (partial transport-addresses-watcher applet peer)))
+    (jsobject-call applet f
+      (json-str
+        {"peersAdded" (map encode-ascii-hash (keys peers-added))
+         "peersRemoved" (map encode-ascii-hash (keys peers-removed))})))
+  (catch Exception e (.printStackTrace e (System/err)))))
+
+(defn -watchPeers
+  [applet peer f]
+  (.execute (:priv-executor @(.state applet))
+    (fn []
+      (add-watch (:remote-peers-agent peer) f
+        (partial remote-peers-watcher applet))
+      (doseq [remote-peer @(:remote-peers-agent peer)]
+        (add-watch (:transport-addresses-agent remote-peer) f
+          (partial transport-addresses-watcher applet remote-peer)))
+      (add-watch (:transport-addresses-agent peer) f
+        (partial transport-addresses-watcher applet peer)))))
+
+(defn -fetchHostlist
+  [applet peer url]
+  (.execute (:priv-executor @(.state applet))
+    (fn []
+      (download-hostlist! (partial admit-hello! peer) url))))
diff --git a/src/org/gnu/clojure/gnunetapplet/base64.clj b/src/org/gnu/clojure/gnunetapplet/base64.clj
new file mode 100644
index 0000000..9b6dfb3
--- /dev/null
+++ b/src/org/gnu/clojure/gnunetapplet/base64.clj
@@ -0,0 +1,12 @@
+(ns org.gnu.clojure.gnunetapplet.base64
+  (:import (sun.misc BASE64Encoder BASE64Decoder)))
+
+(defn base64-encode
+  [byte-seq]
+  (let [b64 (BASE64Encoder.)]
+    (.encode b64 (byte-array byte-seq))))
+
+(defn base64-decode
+  [string]
+  (let [b64 (BASE64Decoder.)]
+    (.decodeBuffer b64 string)))