diff options
author | Yorhel <git@yorhel.nl> | 2010-12-04 14:55:05 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2010-12-04 14:55:05 +0100 |
commit | 26dee6703f180bd471fca367fb07a7e826be13d8 (patch) | |
tree | 4d826b8094acb2c53f3c27d9a71449861645c375 /vndbApi.ml |
Initial commit
Diffstat (limited to 'vndbApi.ml')
-rw-r--r-- | vndbApi.ml | 160 |
1 files changed, 160 insertions, 0 deletions
diff --git a/vndbApi.ml b/vndbApi.ml new file mode 100644 index 0000000..dac59d0 --- /dev/null +++ b/vndbApi.ml @@ -0,0 +1,160 @@ + +open Unix + + +type reply = + RInvalid of string (* unable to parse reply for some reason (string=raw reply) *) + | ROK + | RResults of (int * bool * Json.json list) (* num, more, items *) + | RError of (string * string * Json.json) (* id, msg, json obj *) + + +class connection + (pollfunc : file_descr -> bool -> (unit -> unit) -> unit) + (waitfunc : int -> (unit -> unit) -> unit) + = object (self) + val mutable s_sock = (None : file_descr option) (* None when disconnected *) + val mutable s_host = "beta.vndb.org" + val mutable s_port = 19534 + val mutable s_addr = (None : inet_addr option) + val mutable linefunc = (None : (bool -> string -> unit) option) + val cmd_queue = (Queue.create () : (string * (reply -> unit)) Queue.t) + val mutable cmd_running = false + + + method get_host = s_host + method set_host h = s_host <- h + method get_port = s_port + method set_port p = s_port <- p + method get_addr = s_addr + method set_linefunc f = linefunc <- f + method connected = match s_sock with None -> false | Some _ -> true + + + method private parsereply str = + try + (* space and newline are always ignored with scanf, so no need to check + * for that. (this parser is rather lazy, and may accept incorrect input) *) + let name, value = + Scanf.sscanf str "%[\r\t] %[a-z] %[\r\t] %[^\004]" (fun _ a _ b -> (a,b)) in + match name with + | "ok" -> ROK + | "error" -> + let obj = Json.json_of_string value in + RError ( + Json.get_string (Json.get_value obj "id"), + Json.get_string (Json.get_value obj "msg"), + obj + ) + | "results" -> + let obj = Json.json_of_string value in + RResults ( + int_of_string (Json.get_int (Json.get_value obj "num")), + Json.get_bool (Json.get_value obj "more"), + Json.get_array (Json.get_value obj "items") + ) + | _ -> raise (Failure "Incorrect reply code") + with _ -> RInvalid str + (* the above try .. throws away any info on why it was invalid. but oh well, + * it's not like the server will send invalid data anytime soon anyway *) + + + method private docmd () = + if (not cmd_running && not (Queue.is_empty cmd_queue) && s_sock <> None) then ( + cmd_running <- true; + let cmd, recvcb = Queue.peek cmd_queue in + let s = match s_sock with None -> assert false | Some x -> x in + let reply = ref "" in + let buf = String.create 8192 in + let finish () = + reply := String.sub !reply 0 (String.rindex !reply '\004'); + (match linefunc with None -> () | Some f -> f false !reply); + let preply = self#parsereply !reply in + match preply with + (* Oops! throttled error, let's wait a few seconds and try again *) + | RError ("throttled", _, obj) -> ( + let wait = match Json.get_value obj "minwait" with + | Json.Int i -> int_of_string i + | Json.Number n -> int_of_float (ceil (float_of_string n)) + | _ -> assert false in + waitfunc wait (fun () -> + cmd_running <- false; + self#docmd () + )) + (* Not throttled, so consider this command as finished *) + | _ -> + ignore (Queue.pop cmd_queue); + self#docmd (); + recvcb preply + in + let rec dorecv () = + let cnt = recv s buf 0 (String.length buf) [] in + reply := !reply ^ (String.sub buf 0 cnt); + match String.contains !reply '\004' with + | true -> finish () + | false -> pollfunc s true dorecv + in + let dosend () = + (* assumes the command can be sent with a single call *) + let _ = send s + (cmd ^ (String.make 1 (char_of_int 4))) + 0 (String.length cmd + 1) [] in + match linefunc with None -> () | Some f -> f true cmd; + pollfunc s true dorecv + in + pollfunc s false dosend + ) + + + method addcmd cmd recvcb = + Queue.push (cmd, recvcb) cmd_queue; + self#docmd () + + + (* TODO: keep monitoring connection after successful connect *) + method connect cf ff = + (* get IP (blocks!) *) + let ip = match s_addr with + | Some x -> x + | None -> (gethostbyname s_host).h_addr_list.(0) in + (* create socket *) + let s = socket PF_INET SOCK_STREAM 0 in + (* and connect *) + let success () = + clear_nonblock s; + s_sock <- Some s; + s_addr <- Some ip; + cf ip s_port in + let failure a b c = + close s; + ff a b c in + set_nonblock s; + try + ignore (connect s (ADDR_INET (ip, s_port))); + (* no error? assume this was a successfull blocking connect *) + success () + (* non-blocking connect, poll for the result *) + with Unix_error (EINPROGRESS, _, _) -> + pollfunc s false (fun () -> + clear_nonblock s; + match getsockopt_error s with + | None -> success () + | Some e -> failure e "connect" (error_message e) + ) + (* blocking connect, but failed *) + | Unix_error (a, b, c) -> failure a b c + + + method login user pass recvcb = + let o = Json.Object [ + ("protocol", Json.Int "1"); + ("client", Json.String "Serika"); + ("clientver", Json.Number "0.1"); + ("username", Json.String user); + ("password", Json.String pass) + ] in + self#addcmd ("login " ^ (Json.string_of_json o)) recvcb + +end + + |