Merge pull request #61 from mseri/jbuilder

xen-api-client: depend on xapi-types and xapi-client and drop the need to autogenerate the bindings for xen-api

.travis.yml

@@ -1,14 +1,16 @@
 language: c
 sudo: required
 install:
-  - wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh
+  - wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh
 script:
-  - bash -ex .travis-opam.sh
+  - bash -ex .travis-docker.sh
 env:
   global:
-    - OCAML_VERSION=4.04
+    - OCAML_VERSION=4.04.2
     - PINS="xen-api-client:."
     - PACKAGE=xen-api-client
+    - DISTRO="debian-unstable"
+    - PRE_INSTALL_HOOK="echo 'ulimit -s 16384' > /etc/profile.d/custom.sh"
   matrix:
     - BASE_REMOTE=git://github.com/xapi-project/xs-opam POST_INSTALL_HOOK="env TRAVIS=$TRAVIS TRAVIS_JOB_ID=$TRAVIS_JOB_ID bash -ex .coverage.sh"
     - PACKAGE=xen-api-client-async BASE_REMOTE=git://github.com/xapi-project/xs-opam POST_INSTALL_HOOK="make async-examples"

Makefile

@@ -37,23 +37,3 @@ gh-pages:
 reindent:
 	git ls-files '*.ml' '*.mli' | xargs ocp-indent --syntax cstruct -i
 
-regenerate-files:
-	opam install --deps-only xapi -y
-	git clone --single-branch --branch $(BRANCH) $(URL) .xapi
-	# Generate and copy over files
-	cd .xapi ; \
-	jbuilder build _build/default/ocaml/idl/ocaml_backend/gen_api_main.exe ; \
-	cp ocaml/xapi-consts/api_errors.ml   ../lib/api_errors.ml   ; \
-	cp ocaml/xapi-consts/api_messages.ml ../lib/api_messages.ml ; \
-	cp ocaml/xapi-client/event_helper.ml ../lib/event_helper.ml ; \
-	cp ocaml/xapi-types/event_types.ml   ../lib/event_types.ml  ; \
-	_build/default/ocaml/idl/ocaml_backend/gen_api_main.exe  -mode api -filterinternal true -filter closed > aPI.ml       ; \
-	_build/default/ocaml/idl/ocaml_backend/gen_api_main.exe  -mode client -filterinternal true -filter closed > client.ml ; \
-	cp aPI.ml    ../lib/aPI.ml    ; \
-	cp client.ml ../lib/client.ml
-	# Update definitions in aPI.ml and drop stdext
-	python2 .update_api.py
-	# cleanup
-	rm -rf .xapi
-
-regenerate: regenerate-files reindent

async/xen_api_async_unix.ml

@@ -22,15 +22,13 @@ module IO = struct
 
   type 'a t = 'a Deferred.t
   let (>>=) = Deferred.(>>=)
-  let (>>) m n = m >>= fun _ -> n
+  (* let (>>) m n = m >>= fun _ -> n *)
   let return = Deferred.return
 
   type ic = (unit -> unit Deferred.t) * Reader.t
   type oc = (unit -> unit Deferred.t) * Writer.t
   type conn = unit
 
-  let iter fn x = Deferred.List.iter x ~f:fn
-
   let read_line (_, ic) =
     Reader.read_line ic
     >>| function
@@ -43,21 +41,21 @@ module IO = struct
     | `Ok len' -> String.sub buf ~pos:0 ~len:len'
     | `Eof -> ""
 
-  let read_exactly (_, ic) len =
+  (* let read_exactly (_, ic) len =
     let buf = String.create len in
     Reader.really_read ic ~pos:0 ~len buf >>=
     function
     |`Ok -> return (Some buf)
-    |`Eof _ -> return None
+    |`Eof _ -> return None *)
 
   let write (_, oc) buf =
     Writer.write oc buf;
     return ()
 
-  let write_line (_, oc) buf =
+  (* let write_line (_, oc) buf =
     Writer.write oc buf;
     Writer.write oc "\r\n";
-    return ()
+    return () *)
 
   let flush (_, oc) =
     Async.Std.Writer.flushed oc
@@ -110,10 +108,14 @@ let do_it uri string =
     )
     ~finally:(fun () -> M.disconnect connection)
 
+(* TODO: modify do_it to accept the timeout and remove the warnings *)
+
+[@@@ocaml.warning "-27"]
 let make ?(timeout=30.) uri call =
   let req = Xmlrpc.string_of_call call in
   do_it uri req >>| Xmlrpc.response_of_string
 
+[@@@ocaml.warning "-27"]
 let make_json ?(timeout=30.) uri call =
   let req = Jsonrpc.string_of_call call in
   do_it uri req >>| Jsonrpc.response_of_string

async_examples/event_test.ml

@@ -15,7 +15,6 @@
 open Core.Std
 open Async.Std
 
-open Xen_api
 open Xen_api_async_unix
 
 let uri = ref "http://127.0.0.1/"
@@ -41,10 +40,11 @@ let info fmt =
     (fun txt ->
        eprintf "%s\n%!" txt
     ) fmt
+
 let exn_to_string = function
   | Api_errors.Server_error(code, params) ->
     Printf.sprintf "%s %s" code (String.concat ~sep:" " params)
-  | e -> failwith "XXX: figure out core/async error handling"
+  | e -> failwith (Printf.sprintf "Unexpected error: %s" (Exn.to_string e))
 
 let watch_events rpc session_id =
   let open Event_types in
@@ -74,15 +74,15 @@ let watch_events rpc session_id =
 
   let compare () =
     let open Event_types in
-    Event.from rpc session_id ["*"] "" 0. >>= fun rpc ->
+    Event.from ~rpc ~session_id ~classes:["*"] ~token:"" ~timeout:0. >>= fun rpc ->
     let e = event_from_of_rpc rpc in
     if e.events = [] then error "Empty list of events";
     let current = List.fold_left ~init:StringMap.empty ~f:update e.events in
     Sequence.iter ~f:(fun (key, diff) -> match key, diff with
         | key, `Left _ -> error "Replica has extra table: %s" key
         | key, `Right _ -> error "Replica has missing table: %s" key
         | _, `Unequal(_,_) -> ()
-      ) (StringMap.symmetric_diff !root current (fun _ _ -> true));
+      ) (StringMap.symmetric_diff !root current ~data_equal:(fun _ _ -> true));
     List.iter ~f:(fun key ->
         match StringMap.find !root key with
         | None ->
@@ -93,12 +93,12 @@ let watch_events rpc session_id =
               | r, `Left rpc -> error "Replica has extra object: %s: %s" r (Jsonrpc.to_string rpc)
               | r, `Right rpc -> error "Replica has missing object: %s: %s" r (Jsonrpc.to_string rpc)
               | r, `Unequal(rpc1, rpc2) -> error "Replica has out-of-sync object: %s: %s <> %s" r (Jsonrpc.to_string rpc1) (Jsonrpc.to_string rpc2)
-            ) (StringMap.symmetric_diff root_table current_table (fun a b -> a = b))
+            ) (StringMap.symmetric_diff root_table current_table ~data_equal:(fun a b -> a = b))
       ) (StringMap.keys current);
     return () in
 
   let rec loop token =
-    Event.from rpc session_id ["*"] token 30. >>= fun rpc ->
+    Event.from ~rpc ~session_id ~classes:["*"] ~token ~timeout:30. >>= fun rpc ->
     debug "received event: %s" (Jsonrpc.to_string rpc);
     let e = event_from_of_rpc rpc in
     List.iter ~f:(fun ev -> root := update !root ev) e.events;
@@ -111,13 +111,13 @@ let watch_events rpc session_id =
 
 let main () =
   let rpc = make !uri in
-  Session.login_with_password rpc !username !password "1.0" "event_test"
+  Session.login_with_password ~rpc ~uname:!username ~pwd:!password ~version:"1.0" ~originator:"event_test"
   >>= fun session_id ->
   let a = watch_events rpc session_id in
   let b = watch_events rpc session_id in
   a >>= fun () ->
   b >>= fun () ->
-  Session.logout rpc session_id
+  Session.logout ~rpc ~session_id
   >>= fun () ->
   shutdown 0;
   return ()

async_examples/list_vms.ml

@@ -15,7 +15,6 @@
 open Core.Std
 open Async.Std
 
-open Xen_api
 open Xen_api_async_unix
 
 let uri = ref "http://127.0.0.1/"
@@ -25,19 +24,19 @@ let password = ref "password"
 let exn_to_string = function
   | Api_errors.Server_error(code, params) ->
     Printf.sprintf "%s %s" code (String.concat ~sep:" " params)
-  | e -> failwith "XXX: figure out core/async error handling"
+  | e -> failwith (Printf.sprintf "Unhandled exception: %s" (Exn.to_string e))
 
 let main () =
   let rpc = make !uri in
-  Session.login_with_password rpc !username !password "1.0" "list_vms"
+  Session.login_with_password ~rpc ~uname:!username ~pwd:!password ~version:"1.0" ~originator:"list_vms"
   >>= fun session_id ->
-  VM.get_all_records rpc session_id
+  VM.get_all_records ~rpc ~session_id
   >>= fun vms ->
   List.iter
-    ~f:(fun (vm, vm_rec) ->
+    ~f:(fun (_, vm_rec) ->
         printf "VM %s\n%!" vm_rec.API.vM_name_label
       ) vms;
-  Session.logout rpc session_id
+  Session.logout ~rpc ~session_id
   >>= fun () ->
   shutdown 0;
   return ()