Skip to content

Commit 869ca9c

Browse files
djs55djs55
committed
Merge pull request #129 from xapi-project/better-debug
Log all the metadata reads/writes from/to the rings
2 parents 2625000 + f2542e8 commit 869ca9c

File tree

6 files changed

+38
-26
lines changed

6 files changed

+38
-26
lines changed

‎idl/log.ml‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,27 @@
1+
open Sexplib.Std
2+
3+
type traced_operation = [
4+
| `Set of string * string * [ `Producer | `Consumer | `Suspend | `Suspend_ack ] * [ `Int64 of int64 | `Bool of bool ]
5+
| `Get of string * string * [ `Producer | `Consumer | `Suspend | `Suspend_ack ] * [ `Int64 of int64 | `Bool of bool ]
6+
] with sexp
7+
type traced_operation_list = traced_operation list with sexp
8+
19
let debug fmt = Printf.ksprintf (fun s -> print_endline s) fmt
210
let info fmt = Printf.ksprintf (fun s -> print_endline s) fmt
311
let error fmt = Printf.ksprintf (fun s -> print_endline s) fmt
12+
13+
let trace ts =
14+
let string_of_key = function
15+
| `Producer -> "producer"
16+
| `Consumer -> "consumer"
17+
| `Suspend -> "suspend"
18+
| `Suspend_ack -> "suspend_ack" in
19+
let string_of_value = function
20+
| `Int64 x -> Int64.to_string x
21+
| `Bool b -> string_of_bool b in
22+
let one = function
23+
| `Set (_, queue, key, value) ->
24+
Printf.sprintf "%s.%s := %s" queue (string_of_key key) (string_of_value value)
25+
| `Get (__, queue, key, value) ->
26+
Printf.sprintf "%s.%s == %s" queue (string_of_key key) (string_of_value value) in
27+
info "%s" (String.concat ", " (List.map one ts))

‎idl/xenvm_interface.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,7 @@ external shutdown : unit -> int = ""
4242
type queue = {
4343
lv: string;
4444
suspended: bool;
45+
debug_info: (string * string) list;
4546
}
4647

4748
type connection_state =

‎test/common.ml‎

Lines changed: 0 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -20,12 +20,6 @@ open Lwt
2020
(* Mock kernel devices so we can run as a regular user *)
2121
let use_mock = ref true
2222

23-
module Log = struct
24-
let debug fmt = Printf.ksprintf (fun s -> print_endline s) fmt
25-
let info fmt = Printf.ksprintf (fun s -> print_endline s) fmt
26-
let error fmt = Printf.ksprintf (fun s -> print_endline s) fmt
27-
end
28-
2923
module Time = struct
3024
type 'a io = 'a Lwt.t
3125
let sleep = Lwt_unix.sleep

‎xenvm-local-allocator/local_allocator.ml‎

Lines changed: 1 addition & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,6 @@ let rec try_forever msg f =
2828
>>= function
2929
| `Ok x -> return (`Ok x)
3030
| `Error `Retry ->
31-
debug "%s: retrying after 5s" msg;
3231
Lwt_unix.sleep 5.
3332
>>= fun () ->
3433
try_forever msg f
@@ -85,7 +84,6 @@ module FromLVM = struct
8584
>>= function
8685
| `Suspended -> return ()
8786
| `Running ->
88-
debug "FromLVM.suspend got `Running; sleeping";
8987
Lwt_unix.sleep 5.
9088
>>= fun () ->
9189
wait () in
@@ -99,7 +97,6 @@ module FromLVM = struct
9997
fatal_error "reading state of FromLVM" (R.Consumer.state t)
10098
>>= function
10199
| `Suspended ->
102-
debug "FromLVM.resume got `Suspended; sleeping";
103100
Lwt_unix.sleep 5.
104101
>>= fun () ->
105102
wait ()
@@ -122,15 +119,13 @@ module ToLVM = struct
122119
>>= function
123120
| `Ok x -> return x
124121
| _ ->
125-
debug "ToLVM.attach got `Error; sleeping";
126122
Lwt_unix.sleep 5.
127123
>>= fun () ->
128124
attach ~disk ()
129125
let state t =
130126
fatal_error "querying ToLVM state" (R.Producer.state t)
131127
let rec push t item = R.Producer.push ~t ~item () >>= function
132128
| `Error (`Retry | `Suspended) ->
133-
debug "ToLVM.push got `Error; sleeping";
134129
Lwt_unix.sleep 5.
135130
>>= fun () ->
136131
push t item
@@ -216,7 +211,6 @@ module FreePool = struct
216211
>>= fun (pos, ts) ->
217212
let open FreeAllocation in
218213
( if ts = [] then begin
219-
debug "No free blocks, sleeping for 5s";
220214
Lwt_unix.sleep 5.
221215
end else return ()
222216
) >>= fun () ->
@@ -390,7 +384,7 @@ let main use_mock config daemon socket journal fromLVM toLVM =
390384
) >>= fun device ->
391385

392386
(* We must replay the journal before resynchronising free blocks *)
393-
J.start device perform
387+
J.start ~client:"xenvm-local-allocator" ~name:"local allocator journal" device perform
394388
>>|= fun j ->
395389

396390
FreePool.start config vg

‎xenvm/xenvm.ml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -112,7 +112,7 @@ let host_list copts (vg_name,_) =
112112
let table_of_queue q = [
113113
[ "lv"; q.lv ];
114114
[ "suspended"; string_of_bool q.suspended ]
115-
] in
115+
] @ (List.map (fun (k, v) -> [ k; v ]) q.debug_info) in
116116
let table_of_host h =
117117
let connection_state = [ "state"; match h.connection_state with Some x -> Jsonrpc.to_string (rpc_of_connection_state x) | None -> "None" ] in
118118
let fromLVM = add_prefix "fromLVM" (table_of_queue h.fromLVM) in

‎xenvmd/xenvmd.ml‎

Lines changed: 11 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -47,13 +47,14 @@ module ToLVM = struct
4747
fatal_error "attaching to ToLVM queue" (R.Consumer.attach ~queue:(name ^ " ToLVM Consumer") ~client:"xenvmd" ~disk ())
4848
let state t =
4949
fatal_error "querying ToLVM state" (R.Consumer.state t)
50+
let debug_info t =
51+
fatal_error "querying ToLVM debug_info" (R.Consumer.debug_info t)
5052
let rec suspend t =
5153
R.Consumer.suspend t
5254
>>= function
5355
| `Error (`Msg msg) -> fatal_error_t msg
5456
| `Error `Suspended -> return ()
5557
| `Error `Retry ->
56-
debug "ToLVM.suspend got `Retry; sleeping";
5758
Lwt_unix.sleep 5.
5859
>>= fun () ->
5960
suspend t
@@ -63,7 +64,6 @@ module ToLVM = struct
6364
>>= function
6465
| `Error _ -> fatal_error_t "reading state of ToLVM"
6566
| `Ok `Running ->
66-
debug "ToLVM.suspend got `Running; sleeping";
6767
Lwt_unix.sleep 5.
6868
>>= fun () ->
6969
wait ()
@@ -74,7 +74,6 @@ module ToLVM = struct
7474
>>= function
7575
| `Error (`Msg msg) -> fatal_error_t msg
7676
| `Error `Retry ->
77-
debug "ToLVM.resume got `Retry; sleeping";
7877
Lwt_unix.sleep 5.
7978
>>= fun () ->
8079
resume t
@@ -85,7 +84,6 @@ module ToLVM = struct
8584
>>= function
8685
| `Error _ -> fatal_error_t "reading state of ToLVM"
8786
| `Ok `Suspended ->
88-
debug "ToLVM.resume got `Suspended; sleeping";
8987
Lwt_unix.sleep 5.
9088
>>= fun () ->
9189
wait ()
@@ -108,7 +106,6 @@ module FromLVM = struct
108106
let initial_state = ref `Running in
109107
let rec loop () = R.Producer.attach ~queue:(name ^ " FromLVM Producer") ~client:"xenvmd" ~disk () >>= function
110108
| `Error `Suspended ->
111-
debug "FromLVM.attach got `Suspended; sleeping";
112109
Lwt_unix.sleep 5.
113110
>>= fun () ->
114111
initial_state := `Suspended;
@@ -118,15 +115,15 @@ module FromLVM = struct
118115
>>= fun x ->
119116
return (!initial_state, x)
120117
let state t = fatal_error "FromLVM.state" (R.Producer.state t)
118+
let debug_info t =
119+
fatal_error "querying FromLVM debug_info" (R.Producer.debug_info t)
121120
let rec push t item = R.Producer.push ~t ~item () >>= function
122121
| `Error (`Msg x) -> fatal_error_t (Printf.sprintf "Error pushing to the FromLVM queue: %s" x)
123122
| `Error `Retry ->
124-
debug "FromLVM.push got `Retry; sleeping";
125123
Lwt_unix.sleep 5.
126124
>>= fun () ->
127125
push t item
128126
| `Error `Suspended ->
129-
debug "FromLVM.push got `Suspended; sleeping";
130127
Lwt_unix.sleep 5.
131128
>>= fun () ->
132129
push t item
@@ -435,13 +432,17 @@ module VolumeManager = struct
435432
( ToLVM.state t >>= function
436433
| `Suspended -> return true
437434
| `Running -> return false ) >>= fun suspended ->
438-
let toLVM = { Xenvm_interface.lv; suspended } in
435+
ToLVM.debug_info t
436+
>>= fun debug_info ->
437+
let toLVM = { Xenvm_interface.lv; suspended; debug_info } in
439438
let lv = fromLVM name in
440439
let t = List.assoc name !from_LVMs in
441440
( FromLVM.state t >>= function
442441
| `Suspended -> return true
443442
| `Running -> return false ) >>= fun suspended ->
444-
let fromLVM = { Xenvm_interface.lv; suspended } in
443+
FromLVM.debug_info t
444+
>>= fun debug_info ->
445+
let fromLVM = { Xenvm_interface.lv; suspended; debug_info } in
445446
read (fun vg ->
446447
try
447448
let lv = Lvm.Vg.LVs.find_by_name (freeLVM name) vg.Lvm.Vg.lvs in
@@ -537,7 +538,7 @@ module FreePool = struct
537538
| `Error _ -> fatal_error_t ("open " ^ name)
538539
| `Ok x -> return x )
539540
>>= fun device ->
540-
J.start device perform
541+
J.start ~client:"xenvmd" ~name:"allocation journal" device perform
541542
>>|= fun j' ->
542543
journal := Some j';
543544
return ()
@@ -570,7 +571,6 @@ module FreePool = struct
570571
FromLVM.state from_lvm
571572
>>= function
572573
| `Suspended ->
573-
debug "FromLVM.state got `Suspended; sleeping";
574574
Lwt_unix.sleep 5.
575575
>>= fun () ->
576576
wait ()
@@ -753,7 +753,6 @@ let run port sock_path config =
753753
VolumeManager.flush_all ()
754754
>>= fun () ->
755755

756-
debug "sleeping for 5s";
757756
Lwt_unix.sleep 5.
758757
>>= fun () ->
759758
service_queues () in

0 commit comments

Comments
 (0)