Commits

Alexey Kishkin committed 2ef106d

initial release

Comments (0)

Files changed (1)

+(***********************************************************************)
+(*                                                                     *)
+(* Memcached Client library module (binary protocol)                   *)
+(*                                                                     *)
+(***********************************************************************)
+
+type operation =
+   | Get
+   | Set
+   | Add
+   | Replace
+   | Delete
+   | Increment
+   | Decrement
+   | Quit
+   | Flush
+   | GetQ
+   | Noop
+   | Version
+   | GetK
+   | GetKQ
+   | Append
+   | Prepend
+   | Stat
+   | SetQ
+   | AddQ
+   | ReplaceQ
+   | DeleteQ
+   | IncrementQ
+   | DecrementQ
+   | QuitQ
+   | FlushQ
+   | AppendQ
+   | PrependQ;;
+
+type magic = Request | Response;;
+
+type response_status =
+      MC_No_error
+   | MC_Key_not_found
+   | MC_Key_exists
+   | MC_Value_too_large
+   | MC_Invalid_argument
+   | MC_Item_not_stored
+   | MC_Unknown_comamnd
+   | MC_Out_of_memory;;
+
+exception Bad_memcache_format of string;;
+
+let set_i8 buffer i =
+   Buffer.add_char buffer (Char.chr (i land 0xff));;
+
+let set_i16 buffer i =
+   let badd = Buffer.add_char buffer in
+   let ex x shift = (Char.chr ( (x lsr shift) land 0xff)) in
+   badd (ex i 8);
+   badd (ex i 0);;
+
+let set_i32 buffer i =
+   let badd = Buffer.add_char buffer in
+   let ex x shift = (Char.chr ( (x lsr shift) land 0xff)) in
+   badd (ex i 24);
+   badd (ex i 16);
+   badd (ex i 8);
+   badd (ex i 0);;
+
+let set_int32 buffer i =
+   let badd = Buffer.add_char buffer in
+   let ex x shift = (Char.chr ( Int32.to_int ( Int32.logand (Int32.shift_right x shift) 0xffl))) in
+   badd (ex i 24);
+   badd (ex i 16);
+   badd (ex i 8);
+   badd (ex i 0);;
+
+let set_int64 buffer i =
+   let badd = Buffer.add_char buffer in
+   let ex x shift = (Char.chr ( Int64.to_int ( Int64.logand (Int64.shift_right x shift) 0xffL))) in
+   badd (ex i 56);
+   badd (ex i 48);
+   badd (ex i 40);
+   badd (ex i 32);
+   badd (ex i 24);
+   badd (ex i 16);
+   badd (ex i 8);
+   badd (ex i 0);;
+
+let get_i8 str n = Char.code(str.[n]);;
+
+let get_i16 str n =
+   let b1 = Char.code str.[n] and b2 = Char.code str.[n + 1] in
+   (b1 lsl 8) lor b2;;
+
+let get_i32 str n =
+   let b1 = Char.code str.[n] and b2 = Char.code str.[n + 1] and b3 = Char.code str.[n + 2] and b4 = Char.code str.[n + 3] in
+   (b1 lsl 24) lor (b2 lsl 16) lor (b3 lsl 8) lor b4;;
+
+let get_int32 str n =
+   let b1 = Int32.shift_left (Int32.of_int (Char.code str.[n])) 24
+   and b2 = Int32.shift_left (Int32.of_int (Char.code str.[n + 1])) 16
+   and b3 = Int32.shift_left (Int32.of_int (Char.code str.[n + 2])) 8
+   and b4 = Int32.of_int (Char.code str.[n + 3]) in
+   Int32.logor (Int32.logor b1 b2) (Int32.logor b3 b4);;
+
+let get_int64 str n =
+   let b1 = Int64.shift_left (Int64.of_int (Char.code str.[n])) 56
+   and b2 = Int64.shift_left (Int64.of_int (Char.code str.[n + 1])) 48
+   and b3 = Int64.shift_left (Int64.of_int (Char.code str.[n + 2])) 40
+   and b4 = Int64.shift_left (Int64.of_int (Char.code str.[n + 3])) 32
+   and b5 = Int64.shift_left (Int64.of_int (Char.code str.[n + 4])) 24
+   and b6 = Int64.shift_left (Int64.of_int (Char.code str.[n + 5])) 16
+   and b7 = Int64.shift_left (Int64.of_int (Char.code str.[n + 6])) 8
+   and b8 = Int64.of_int (Char.code str.[n + 7]) in
+   Int64.logor (Int64.logor (Int64.logor b1 b2) (Int64.logor b3 b4)) (Int64.logor (Int64.logor b5 b6) (Int64.logor b7 b8));;
+
+class memcache_connector (host: string) (port: int) =
+object(self)
+   val host = host
+   val port = port
+   val mutable i_channel = IO.input_channel stdin
+   val mutable o_channel = IO.output_channel stdout
+   method operation_encode = function
+      | Get -> 0x00
+      | Set -> 0x01
+      | Add -> 0x02
+      | Replace -> 0x03
+      | Delete -> 0x04
+      | Increment -> 0x05
+      | Decrement -> 0x06
+      | Quit -> 0x07
+      | Flush -> 0x08
+      | GetQ -> 0x09
+      | Noop -> 0x0a
+      | Version -> 0x0b
+      | GetK -> 0x0c
+      | GetKQ -> 0x0d
+      | Append -> 0x0e
+      | Prepend -> 0x0f
+      | Stat -> 0x10
+      | SetQ -> 0x11
+      | AddQ -> 0x12
+      | ReplaceQ -> 0x13
+      | DeleteQ -> 0x14
+      | IncrementQ -> 0x15
+      | DecrementQ -> 0x16
+      | QuitQ -> 0x17
+      | FlushQ -> 0x18
+      | AppendQ -> 0x19
+      | PrependQ -> 0x1a
+   
+   method magic_code_encode = function
+      | Request -> 0x80
+      | Response -> 0x81
+   
+   method magic_code_decode = function
+      | 0x80 -> Request
+      | 0x81 -> Response
+      | _ -> raise (Bad_memcache_format "memcache wrong magic code")
+   
+   method response_status_decode = function
+      | 0x0000 -> MC_No_error
+      | 0x0001 -> MC_Key_not_found
+      | 0x0002 -> MC_Key_exists
+      | 0x0003 -> MC_Value_too_large
+      | 0x0004 -> MC_Invalid_argument
+      | 0x0005 -> MC_Item_not_stored
+      | 0x0081 -> MC_Unknown_comamnd
+      | 0x0082 -> MC_Out_of_memory
+      | _ -> raise (Bad_memcache_format "memcache wrong response status")
+   
+   method encode_packet op key extras vl opaque cas =
+      let keylen = String.length key and
+      extralen = String.length extras and
+      vllen = String.length vl in
+      if (keylen > 0xFFFE ) || (extralen > 0xFE) then
+         raise (Bad_memcache_format "too big key or extra")
+      else
+         let buffer = Buffer.create (24 + vllen + keylen + extralen) in
+         set_i8 buffer (self#magic_code_encode Request);           (* 0 *)
+         set_i8 buffer (self#operation_encode op);                 (* 1 *)
+         set_i16 buffer keylen;                                    (*2 3*)
+         set_i8 buffer extralen;                                   (* 4 *)
+         set_i8 buffer 0;                                          (* 5 *) (* RAW data type *)
+         set_i16 buffer 0;                                         (*6 7*) (* RESERVED *)
+         set_i32 buffer vllen;                                     (*8 9 10 11*)
+         set_i32 buffer opaque;                                    (*12 13 14 15*)
+         set_int64 buffer cas;                                     (*16 17 18 19 20 21 22 23*)
+         if extralen > 0 then (Buffer.add_string buffer extras);
+         if keylen > 0 then (Buffer.add_string buffer key);
+         if vllen > 0 then (Buffer.add_string buffer vl);
+         Buffer.contents buffer
+   
+   method decode_packet pct =
+      try
+         let magic = self#magic_code_decode (get_i8 pct 0) in        (* 0 *)
+         (*      let _ = get_i8 pct 1 in *)                          (* 1 *)
+         let keylength = get_i16 pct 2 in                            (*2 3*)
+         let extralength = get_i8 pct 4 in                           (* 4 *)
+         let datatype = get_i8 pct 5 in                              (* 5 *)
+         let status = self#response_status_decode (get_i16 pct 6) in (*6 7*)
+         let total_body_lentgh = get_i32 pct 8 in                    (*8 9 10 11*)
+         let opaque = get_i32 pct 12 in                              (*12 13 14 15*)
+         let cas = get_int64 pct 16 in                               (*16 17 18 19 20 21 22 23*)
+         begin
+            if (magic <> Response) then raise (Bad_memcache_format "magic is not response");
+            if (datatype <> 0) then raise (Bad_memcache_format "datatype is not RAW");
+            let extras = (if extralength > 0 then String.sub pct 24 extralength else "") in
+            let key = (if keylength > 0 then String.sub pct (24 + extralength) keylength else "") in
+            let valuelength = total_body_lentgh - keylength - extralength in
+            let value = (if valuelength > 0 then String.sub pct (24 + extralength + keylength) valuelength else "") in
+            (status, key, extras, value, opaque, cas)
+         end
+      with
+      | Invalid_argument _ -> raise (Bad_memcache_format "packet too short")
+   
+end;;