1. Alexey Kishkin
  2. omcbp

Source

omcbp / memcache.ml

(***********************************************************************)
(*                                                                     *)
(* Memcached Client library module (binary protocol)                   *)
(*                                                           *)
(* @author Alexey Kishkin odobenus-rosmarus@ya.ru           *)
(***********************************************************************)

(* Low level operations *)
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;;

(*packet header*)
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 =  stdin
   val mutable o_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;;