# HG changeset patch
# User Matthias Goergens <matthias.goergens@xxxxxxxxxx>
# Date 1274194687 -3600
# Node ID 161b537a73580b84d61fdecb61403b0b635f121e
# Parent  691698870656a32c63d6b3a6fb63638a0dd7712d
camldm/camldm.ml: camldm_ls is an analogue to dmsetup ls.

Signed-off-by: Matthias Goergens <matthias.goergens@xxxxxxxxxx>

diff --git a/camldm/camldm.ml b/camldm/camldm.ml
--- a/camldm/camldm.ml
+++ b/camldm/camldm.ml
@@ -68,6 +68,7 @@ external _remove : string -> unit = "cam
 external _suspend : string -> unit = "camldm_suspend"
 external _resume : string -> unit = "camldm_resume"
 external _mknod : string -> int -> int -> int -> unit = "camldm_mknod"
+external _ls : unit -> (string list) option = "camldm_ls"
 
 (* Helper to convert from our type to the string*string 
  * type expected by libdevmapper *)
@@ -141,3 +142,4 @@ let mknods = _mknods
 let mknod = _mknod
 let suspend = _suspend
 let resume = _resume 
+let ls = _ls
diff --git a/camldm/camldm.mli b/camldm/camldm.mli
--- a/camldm/camldm.mli
+++ b/camldm/camldm.mli
@@ -50,3 +50,6 @@ val mknod : string -> int -> int -> int 
 val get_sector_pos_of : mapping -> int64 -> (string * string) list -> string * int64
 val to_string : mapping array -> string
 val of_string : string -> mapping array
+
+val rpc_of_status : status -> Rpc.t
+val ls : unit -> (string list) option
diff --git a/camldm/camldm_stubs.c b/camldm/camldm_stubs.c
--- a/camldm/camldm_stubs.c
+++ b/camldm/camldm_stubs.c
@@ -237,3 +237,72 @@ void camldm_mknod(value path, value mode
   mknod(String_val(path),S_IFBLK | Int_val(mode), makedev(Int_val(major),Int_val(minor)));
   CAMLreturn0;
 }
+
+// may leak memory.  who knows?  (Does the c function I copied this
+// from (dmsetup.c) care about memory?  dmsetup exits shortly after executing
+// it.
+#define none Val_int(0)
+#define Tag_some Val_int(0)
+value camldm_ls()
+{
+  CAMLparam0 ();
+  CAMLlocal1 (list);
+  
+  value some (value content) {
+    CAMLparam1 (content);
+    CAMLlocal1 (result);
+    result = caml_alloc (1, Tag_some);
+    Store_field (result, 0, content);
+    CAMLreturn (result);
+  };
+  value cons (value car_value, value cdr_value) {
+    CAMLparam2 (car_value, cdr_value);
+    CAMLlocal1 (cell);
+
+    const int car = 0;
+    const int cdr = 1;
+    cell = caml_alloc (2, Tag_cons);
+    Store_field (cell, car, car_value);
+    Store_field (cell, cdr, cdr_value);
+    
+    CAMLreturn (cell);
+  };
+
+  struct dm_names *names;
+  struct dm_task *dmt;
+
+  if (!(dmt = dm_task_create(DM_DEVICE_LIST)))
+    CAMLreturn(none);
+  
+  if (!dm_task_run(dmt)) {
+    dm_task_destroy(dmt);
+    CAMLreturn(none);
+  }
+  
+  if (!(names = dm_task_get_names(dmt))) {
+    dm_task_destroy(dmt);
+    CAMLreturn(none);
+  }
+  
+  list = Val_emptylist;
+  if (!names->dev) {
+    dm_task_destroy(dmt);
+    CAMLreturn(some(list));
+  }
+
+  unsigned int next = 0;
+
+  do {
+    names = (void *) names + next;
+    //    printf("%s\t(%d, %d)\n", names->name,
+    //	   (int) MAJOR(names->dev), (int) MINOR(names->dev));
+    
+    list = cons (caml_copy_string(names->name), list);
+    
+    printf("%s\t(:Debug only)\n", names->name);
+    next = names->next;
+  } while (next);
+
+  dm_task_destroy(dmt);
+  CAMLreturn(some(list));
+}