athos/echo.html

## echo.html
<html>
    <head>
        <style type="text/css">
            .log {
                color: red;
            }
        </style>
        <script>
            ws = new WebSocket("ws://localhost:8080");
            ws.onopen = function (e) {
                var resultAreaObj = document.getElementById('result');
                resultAreaObj.innerHTML += '<span class="log">onopen</span>' + '<br>'
            };
            ws.onclose = function (e) {
                var resultAreaObj = document.getElementById('result');
                resultAreaObj.innerHTML += '<span class="log">onclose</span>' + '<br>'
            };
            ws.onmessage = function (e) {
                var resultAreaObj = document.getElementById('result');
                resultAreaObj.innerHTML += e.data + '<br>'
            };
            ws.onerror = function () {
                var resultAreaObj = document.getElementById('result');
                resultAreaObj.innerHTML += '<span class="log">onerror</span>' + '<br>'
            };
            send = function () {
                var textFieldObj = document.getElementById('textField');
                var data = textFieldObj.value;
                if (data) {
                    ws.send(data);
                    textFieldObj.value = '';
                }
            };
        </script>
    </head>
    <body>
        <input type='text' id='textField'/>
        <button onclick='send();'>send</button><br>
        <button onclick='ws.close();'>close</button>
        <hr>
        <div id='result'></div>
    </body>
</html>

## websocket.clj
; -*- coding: utf-8 -*-
(ns websocket
  (use [clojure.contrib.server-socket :only (create-server)]
       [clojure.contrib.io :only (reader with-out-writer *byte-array-type*)]
       [clojure.string :only (split lower-case join)]
       [clojure.contrib.command-line :only (with-command-line)]
       [clojure.test :only (deftest are)])
  (require [clojure.contrib.logging :as log])
  (import [java.nio ByteBuffer]
          [java.security MessageDigest]))

(def *origin* nil)
(def *port* nil)
(def *protocol* nil)
(def *resource* nil)

(defn bytes->hex-string [bs]
  (join (map #(format "%02x" (if (< % 0) (+ % 256) %)) (seq bs))))

(defn string->bytes [s]
  (.getBytes s "ISO-8859-1"))

(defn bytes->string
  ([bs] (bytes->string bs (count bs)))
  ([bs size]
     (String. bs 0 size "ISO-8859-1")))

(defn send-data [out x]
  (cond (string? x)
	(.write out (string->bytes x))
	(= (class x) *byte-array-type*)
	(.write out x))
  (.flush out))

(defn read-block [in]
  (let [buf (byte-array 1024)
	size (.read in buf)]
    (if-not (<= size 0)
      (bytes->string buf size))))

(defn read-lines [in]
  (split (read-block in) #"\r\n"))

(defn parse-request [request]
  (loop [[field & fields] request, ret {}]
    (if (= field "")
      [ret (string->bytes (first fields))]
      (let [[name val] (split field #": ")]
        (recur fields (assoc ret (lower-case name) val))))))

(defn decode [key]
  (letfn [(convert [x]
		   (let [MAX Integer/MAX_VALUE]
		     (int (or (and (<= x MAX) x)
			      (- x (* 2 (+ MAX 1)))))))]
    (convert
     (/ (Long/parseLong (join (filter #(Character/isDigit %) key)))
	(reduce #(if (= %2 \space) (inc %1) %1) 0 key)))))

(defn challenge-response [key1 key2 key]
  (let [buf (ByteBuffer/allocate 16)
        md5 (MessageDigest/getInstance "MD5")]
    (doto buf
      (.putInt key1)
      (.putInt key2)
      (.put key))
    (.update md5 (.array buf))
    (.digest md5)))

(defn handshake-response-body [request]
  (let [[fields key] (parse-request request)
        key1 (decode (fields "sec-websocket-key1"))
        key2 (decode (fields "sec-websocket-key2"))]
    (challenge-response key1 key2 key)))

(defn send-handshake [out response-body]
  (let [location (str "ws://localhost"
		      (if *port* (str ":" *port*) "")
		      *resource*)
	header (join `["HTTP/1.1 101 WebSocket Protocol Handshake\r\n"
                       "Upgrade: WebSocket\r\n"
                       "Connection: Upgrade\r\n"
                       "Sec-WebSocket-Origin: " ~*origin* "\r\n"
                       "Sec-WebSocket-Location: " ~location "\r\n"
                       ~@(if *protocol*
                           ["Sec-WebSocket-Protocol: " *protocol* "\r\n"])
                       "\r\n"])]
    (send-data out header)
    (send-data out response-body)))

(defn main-loop [in out]
  (letfn [(disconnect []
		      (log/info "コネクションを切断します")
		      (send-data out "\377\000"))]
    (let [msg (read-block in)]
      (if (nil? msg)
	(disconnect)
	(let [[_ body] (re-matches #"\00(.*)\0377" msg)]
	  (if (nil? body)
	    (disconnect)
	    (do (log/info (format "[%s]" body))
		(send-data out (str "\000" body "\377"))
		(recur in out))))))))

(defn handle-request [in out]
  (let [request (read-lines in)]
    (log/info "ハンドシェイクデータを受信")
    (let [body (handshake-response-body request)]
      (send-handshake out body))
    (main-loop in out)))

(deftest test-challenge-response
  (are [x y] (= (seq x) (seq y))
    (challenge-response (decode "2 76K 348 2  1 Y2 8' #")
			(decode "?120 743 9 9 6 [5")
			(string->bytes "\230\367B\234\377\372R\215"))
    (string->bytes "%\213\233q)!\025$\200N\255\261'KB\375")

    (challenge-response (decode "3y7  $  6  I ,0 25C%Q23I2%")
			(decode "4V14o{2F 2c0Uw 7 09C7")
			(string->bytes "\020\347\210\017\304\264v\267"))
    (string->bytes "?\224\271\201U\2539\0210\0356\375\245m\023!")))

(defn main [args]
  (with-command-line args
    "websocket.clj -- a simple echo server by WebSocket"
    [[port p "ポート番号" "8080"]
      [subprotocol s "サブプロトコル名"]
      [resource r "リソース" "/"]
      args]
     (cond (< (count args) 1)
	   (throw (RuntimeException. "Too few arguments"))
	   (> (count args) 1)
	   (throw (RuntimeException. "Too many arguments")))
     (println "Ctrl-cで終了します")
     (create-server (Integer/parseInt port)
       (fn [in out]
	 (binding [*origin* (first args)
		   *port* port
		   *protocol* subprotocol
		   *resource* resource]
	   (handle-request in out))))))

(main *command-line-args*)
	<html>
	<head>
	<style type="text/css">
	.log {
	color: red;
	}
	</style>
	<script>
	ws = new WebSocket("ws://localhost:8080");
	ws.onopen = function (e) {
	var resultAreaObj = document.getElementById('result');
	resultAreaObj.innerHTML += '<span class="log">onopen</span>' + '<br>'
	};
	ws.onclose = function (e) {
	var resultAreaObj = document.getElementById('result');
	resultAreaObj.innerHTML += '<span class="log">onclose</span>' + '<br>'
	};
	ws.onmessage = function (e) {
	var resultAreaObj = document.getElementById('result');
	resultAreaObj.innerHTML += e.data + '<br>'
	};
	ws.onerror = function () {
	var resultAreaObj = document.getElementById('result');
	resultAreaObj.innerHTML += '<span class="log">onerror</span>' + '<br>'
	};
	send = function () {
	var textFieldObj = document.getElementById('textField');
	var data = textFieldObj.value;
	if (data) {
	ws.send(data);
	textFieldObj.value = '';
	}
	};
	</script>
	</head>
	<body>
	<input type='text' id='textField'/>
	<button onclick='send();'>send</button><br>
	<button onclick='ws.close();'>close</button>
	<hr>
	<div id='result'></div>
	</body>
	</html>
	; -- coding: utf-8 --
	(ns websocket
	(use [clojure.contrib.server-socket :only (create-server)]
	[clojure.contrib.io :only (reader with-out-writer byte-array-type)]
	[clojure.string :only (split lower-case join)]
	[clojure.contrib.command-line :only (with-command-line)]
	[clojure.test :only (deftest are)])
	(require [clojure.contrib.logging :as log])
	(import [java.nio ByteBuffer]
	[java.security MessageDigest]))

	(def origin nil)
	(def port nil)
	(def protocol nil)
	(def resource nil)

	(defn bytes->hex-string [bs]
	(join (map #(format "%02x" (if (< % 0) (+ % 256) %)) (seq bs))))

	(defn string->bytes [s]
	(.getBytes s "ISO-8859-1"))

	(defn bytes->string
	([bs] (bytes->string bs (count bs)))
	([bs size]
	(String. bs 0 size "ISO-8859-1")))

	(defn send-data [out x]
	(cond (string? x)
	(.write out (string->bytes x))
	(= (class x) byte-array-type)
	(.write out x))
	(.flush out))

	(defn read-block [in]
	(let [buf (byte-array 1024)
	size (.read in buf)]
	(if-not (<= size 0)
	(bytes->string buf size))))

	(defn read-lines [in]
	(split (read-block in) #"\r\n"))

	(defn parse-request [request]
	(loop [[field & fields] request, ret {}]
	(if (= field "")
	[ret (string->bytes (first fields))]
	(let [[name val] (split field #": ")]
	(recur fields (assoc ret (lower-case name) val))))))

	(defn decode [key]
	(letfn [(convert [x]
	(let [MAX Integer/MAX_VALUE]
	(int (or (and (<= x MAX) x)
	(- x (* 2 (+ MAX 1)))))))]
	(convert
	(/ (Long/parseLong (join (filter #(Character/isDigit %) key)))
	(reduce #(if (= %2 \space) (inc %1) %1) 0 key)))))

	(defn challenge-response [key1 key2 key]
	(let [buf (ByteBuffer/allocate 16)
	md5 (MessageDigest/getInstance "MD5")]
	(doto buf
	(.putInt key1)
	(.putInt key2)
	(.put key))
	(.update md5 (.array buf))
	(.digest md5)))

	(defn handshake-response-body [request]
	(let [[fields key] (parse-request request)
	key1 (decode (fields "sec-websocket-key1"))
	key2 (decode (fields "sec-websocket-key2"))]
	(challenge-response key1 key2 key)))

	(defn send-handshake [out response-body]
	(let [location (str "ws://localhost"
	(if port (str ":" port) "")
	resource)
	header (join `["HTTP/1.1 101 WebSocket Protocol Handshake\r\n"
	"Upgrade: WebSocket\r\n"
	"Connection: Upgrade\r\n"
	"Sec-WebSocket-Origin: " ~origin "\r\n"
	"Sec-WebSocket-Location: " ~location "\r\n"
	~@(if protocol
	["Sec-WebSocket-Protocol: " protocol "\r\n"])
	"\r\n"])]
	(send-data out header)
	(send-data out response-body)))

	(defn main-loop [in out]
	(letfn [(disconnect []
	(log/info "コネクションを切断します")
	(send-data out "\377\000"))]
	(let [msg (read-block in)]
	(if (nil? msg)
	(disconnect)
	(let [[_ body] (re-matches #"\00(.*)\0377" msg)]
	(if (nil? body)
	(disconnect)
	(do (log/info (format "[%s]" body))
	(send-data out (str "\000" body "\377"))
	(recur in out))))))))

	(defn handle-request [in out]
	(let [request (read-lines in)]
	(log/info "ハンドシェイクデータを受信")
	(let [body (handshake-response-body request)]
	(send-handshake out body))
	(main-loop in out)))

	(deftest test-challenge-response
	(are [x y] (= (seq x) (seq y))
	(challenge-response (decode "2 76K 348 2 1 Y2 8' #")
	(decode "?120 743 9 9 6 [5")
	(string->bytes "\230\367B\234\377\372R\215"))
	(string->bytes "%\213\233q)!\025$\200N\255\261'KB\375")

	(challenge-response (decode "3y7 $ 6 I ,0 25C%Q23I2%")
	(decode "4V14o{2F 2c0Uw 7 09C7")
	(string->bytes "\020\347\210\017\304\264v\267"))
	(string->bytes "?\224\271\201U\2539\0210\0356\375\245m\023!")))

	(defn main [args]
	(with-command-line args
	"websocket.clj -- a simple echo server by WebSocket"
	[[port p "ポート番号" "8080"]
	[subprotocol s "サブプロトコル名"]
	[resource r "リソース" "/"]
	args]
	(cond (< (count args) 1)
	(throw (RuntimeException. "Too few arguments"))
	(> (count args) 1)
	(throw (RuntimeException. "Too many arguments")))
	(println "Ctrl-cで終了します")
	(create-server (Integer/parseInt port)
	(fn [in out]
	(binding [origin (first args)
	port port
	protocol subprotocol
	resource resource]
	(handle-request in out))))))

	(main command-line-args)