縦書き文庫の開発日誌

　Ocaml で memcached client を作ってみようと思って作りかけていたのですが、似たような仕組みでOcaml純正の素晴らしげなものがリリースされてしまったので、多分終了。悔しいので、コードだけ晒しておきます。

　あんまり良くわかっていないのですが、get/set だけできたらいいよねーというノリで作ったものです。

　Ｃ＃のクライアントとかを眺めると、結構面倒くさそうなことをしてるのですが、きちんとしようとすると色々あるんでしょうね。

open Unix

type operation_result =
    | Timeout of float
    | Failed of string
    | Connected
    | SetOK
    | GetOK of string
;;

let (@@) f x = f x
;;

let flush () =
  flush Pervasives.stdout
;;

let spf = Printf.sprintf
;;

let primary_buffer = String.create 8192
;;

let input_buffer = Buffer.create 8192
;;

let add_crlf data =
  spf "%s\r\n" data
;;

let set_cmd key flgs exp len =
  add_crlf @@ spf "set %s %d %d %d" key flgs exp len
;;

let get_cmd key =
  add_crlf @@ spf "get %s" key
;;

let read_line sock =
  let s1 = String.create 1 in
  let buff = Buffer.create 1024 in
  let rec iter () =
    let nr = Unix.read sock s1 0 1 in
      match nr, s1 with
	| 1, "\r" ->
	    iter ()
	| 1, "\n" ->
	    Buffer.contents buff
	| 1, other ->
	    Buffer.add_string buff s1;
	    iter ()
	| _, _ ->
	    Buffer.contents buff in
    iter ()
;;

let read_bytes sock bytes =
  let () = Buffer.clear input_buffer in
  let rec iter rest =
    if rest > 0 then
      let nr = Unix.read sock primary_buffer 0 rest in
      let () = Buffer.add_substring input_buffer primary_buffer 0 nr in
	iter (rest - nr)
    else
      Buffer.contents input_buffer in
    iter bytes
;;

let start_connect sock addr =
  let ch = Event.new_channel () in
  let _ =
    Thread.create
      (fun () ->
	Unix.connect sock addr;
	Event.sync @@ Event.send ch Connected)
      () in

    Event.receive ch
;;

let start_set sock key data =
  let ch = Event.new_channel () in
  let _ =
    Thread.create
      (fun () ->
	let cmd = set_cmd key 0 0 (String.length data) in
	let _ = Unix.write sock cmd  0 (String.length cmd) in
	let data_crlf = add_crlf data in
	let _ = Unix.write sock data_crlf 0 (String.length data_crlf) in
	  match read_line sock with
	    | "STORED" -> Event.sync (Event.send ch SetOK)
	    | line -> Event.sync (Event.send ch @@ (Failed (spf "set(invalid rsp %s)" line))))
      () in

    Event.receive ch
;;

let start_get sock key =
  let ch = Event.new_channel () in
  let _ =
    Thread.create
      (fun () ->
	let cmd = get_cmd key in
	let _ = Unix.write sock cmd 0 (String.length cmd) in
	let line = read_line sock in
	  match Str.split (Str.regexp " ") line with
	    | ["VALUE"; k; flags; bytes] ->
		let data = read_bytes sock @@ int_of_string bytes in
		let _ = read_line sock in (* \r\n *)
		let _ = read_line sock in (* END *)
		  Event.sync (Event.send ch (GetOK data))
	    | _ ->
		Event.sync (Event.send ch (Failed(spf "get(invalid rsp %s)" line))))
      () in
    
    Event.receive ch
;;

let start_wdt second =
  let ch = Event.new_channel () in
  let _ =
    Thread.create
      (fun () ->
	Thread.delay second;
	Event.sync (Event.send ch (Timeout second)))
      () in

    Event.receive ch
;;

let wait_event time channel =
  Event.sync @@ Event.choose [channel; start_wdt time]
;;

let connect ?(timeout=3.00) sock addr =
  wait_event timeout (start_connect sock addr)
;;

let set ?(timeout=3.00) sock ~key ~value =
  wait_event timeout (start_set sock key value)
;;

let get ?(timeout=3.00) sock key =
  wait_event timeout (start_get sock key)
;;

socket はリンクするアプリケーションで管理してもらうことになるのですが、Ｃ＃のクライアントをみると、ライブラリがソケット管理も吸収する作りになっているみたい。