Permalink
Browse files

fix netstring bug with embedded commas. collapse encode/decode-messag…

…e into frame
  • Loading branch information...
1 parent c7a9c4f commit b47128852dd2f1faf71218414034a0d97b680b05 @ninjudd ninjudd committed May 13, 2011
Showing with 24 additions and 37 deletions.
  1. +1 −1 src/clj/portal/client.clj
  2. +5 −18 src/clj/portal/core.clj
  3. +1 −1 src/clj/portal/io.clj
  4. +17 −17 src/clj/portal/server.clj
@@ -2,4 +2,4 @@
(:use portal.core lamina.core aleph.tcp))
(defn connect [port & [host]]
- (tcp-client {:host (or host "localhost") :port port, :frame netstring}))
+ (tcp-client {:host (or host "localhost") :port port, :frame message}))
@@ -2,11 +2,6 @@
(:use gloss.core lamina.core
[clojure.string :only [join split]]))
-(def netstring
- (finite-frame
- (prefix (string-integer :ascii :delimiters [":"]) inc dec)
- (string :utf-8 :delimiters [","])))
-
(defn read-seq [string]
(with-in-str string
(loop [forms []]
@@ -15,16 +10,8 @@
forms
(recur (conj forms form)))))))
-(defn decode-message [string]
- (split (str string) #" " 3))
-
-(defn encode-message [id type data]
- (str id " " type " "
- (case type
- "result" (join (map prn-str data))
- "error" (str (.getName (class data)) " " (.getMessage data))
- "read-error" (.getMessage data)
- data)))
-
-(defn enqueue-message [ch id [type data]]
- (enqueue ch (encode-message id type data)))
+(def message
+ (compile-frame
+ (string :utf-8 :length (prefix (string-integer :ascii :delimiters [":"]) inc dec))
+ #(str (join " " %) ",")
+ #(split (apply str (butlast %)) #" " 3)))
@@ -26,4 +26,4 @@
(flush []
(let [string (join (channel-seq data))]
(doseq [ch (channels)]
- (enqueue-message ch id [type string]))))))))
+ (enqueue ch [id type string]))))))))
@@ -41,28 +41,28 @@
(dissoc contexts id)
contexts)))
-(defn read-eval [data]
+(defn read-eval-print [data]
(try (let [forms (read-seq data)]
- (try ["result" (doall (map eval forms))]
+ (try ["result" (apply str (map (comp prn-str eval) forms))]
(catch Exception e
- ["error" (root-cause e)])))
+ (let [e (root-cause e)]
+ ["error" (str (.getName (class e)) " " (.getMessage e))]))))
(catch LispReader$ReaderException e
- ["read-error" (root-cause e)])))
+ ["read-error" (.getMessage (root-cause e))])))
(defn handler [channel client-info]
(receive-all channel
- (fn [frame]
- (let [[id type data] (decode-message frame)]
- (case type
- "stdin" (binding [*out* (get @(get-context id) #'*pipe*)]
- (print data)
- (flush))
- "eval" (with-context channel id
- (enqueue-message channel id (read-eval data)))
- "fork" (swap! contexts
- #(assoc % data (get % id)))
- "clear" (swap! contexts clear-context channel id)
- (enqueue-message channel id ["invalid" type]))))))
+ (fn [[id type data]]
+ (case type
+ "stdin" (binding [*out* (get @(get-context id) #'*pipe*)]
+ (print data)
+ (flush))
+ "eval" (with-context channel id
+ (enqueue channel (apply vector id (read-eval-print data))))
+ "fork" (swap! contexts
+ #(assoc % data (get % id)))
+ "clear" (swap! contexts clear-context channel id)
+ (enqueue channel [id "invalid" type])))))
(defn start [port]
- (start-tcp-server handler {:port port, :frame netstring}))
+ (start-tcp-server handler {:port port, :frame message}))

0 comments on commit b471288

Please sign in to comment.