tests/test_ocaml_plugin.ml

   1 (* nbdkit
   2  * Copyright Red Hat
   3  *
   4  * Redistribution and use in source and binary forms, with or without
   5  * modification, are permitted provided that the following conditions are
   6  * met:
   7  *
   8  * * Redistributions of source code must retain the above copyright
   9  * notice, this list of conditions and the following disclaimer.
  10  *
  11  * * Redistributions in binary form must reproduce the above copyright
  12  * notice, this list of conditions and the following disclaimer in the
  13  * documentation and/or other materials provided with the distribution.
  14  *
  15  * * Neither the name of Red Hat nor the names of its contributors may be
  16  * used to endorse or promote products derived from this software without
  17  * specific prior written permission.
  18  *
  19  * THIS SOFTWARE IS PROVIDED BY RED HAT AND CONTRIBUTORS ''AS IS'' AND
  20  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
  21  * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
  22  * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL RED HAT OR
  23  * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  24  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  25  * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
  26  * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  27  * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  28  * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
  29  * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  30  * SUCH DAMAGE.
  31  *)
  32
  33 let sector_size = 512
  34 let nr_sectors = 2048
  35
  36 let disk = Bytes.make (nr_sectors*sector_size) '\000' (* disk image *)
  37 let sparse = Bytes.make nr_sectors '\000' (* sparseness bitmap *)
  38
  39 (* Test parse_* functions. *)
  40 let () =
  41   assert (NBDKit.parse_size "1M" = Int64.of_int (1024*1024));
  42   assert (NBDKit.parse_bool "true" = true);
  43   assert (NBDKit.parse_bool "0" = false)
  44
  45 (* Test the realpath function. *)
  46 let () =
  47   let isdir d = try Sys.is_directory d with Sys_error _ -> false in
  48   let test_dir = "/usr/bin" in
  49   if isdir test_dir then
  50     (* We don't know what the answer will be, but it must surely
  51      * be a directory.
  52      *)
  53     assert (isdir (NBDKit.realpath test_dir))
  54
  55 (* Test [NBDKit.version ()] returns a sensible looking string. *)
  56 let () =
  57   let ver = NBDKit.version () in
  58   assert (String.length ver > 2);
  59   assert (String.sub ver 0 2 = "1.")
  60
  61 (* Test [NBDKit.api_version ()]. *)
  62 let () =
  63   assert (NBDKit.api_version () = 2)
  64
  65 let load () =
  66   NBDKit.debug "test ocaml plugin loaded"
  67
  68 let unload () =
  69   (* A good way to find memory bugs: *)
  70   Gc.compact ();
  71   NBDKit.debug "test ocaml plugin unloaded"
  72
  73 let params = ref []
  74
  75 let config k v =
  76   params := (k, v) :: !params
  77
  78 let config_complete () =
  79   let params = List.rev !params in
  80   assert (params = [ "a", "1"; "b", "2"; "c", "3"; "d", "4" ])
  81
  82 let get_ready () =
  83   (* We could allocate the disk here, but it's easier to allocate
  84    * it statically above.
  85    *)
  86   NBDKit.debug "test ocaml plugin getting ready"
  87
  88 let after_fork () =
  89   NBDKit.debug "test ocaml plugin after fork"
  90
  91 let cleanup () =
  92   NBDKit.debug "test ocaml plugin cleaning up"
  93
  94 (* Test the handle is received by callbacks. *)
  95 type handle = {
  96   h_id : int;
  97   h_sentinel : string;
  98 }
  99
 100 let id = ref 0
 101 let open_connection readonly =
 102   let export_name = NBDKit.export_name () in
 103   NBDKit.debug "test ocaml plugin handle opened readonly=%b export=%S"
 104     readonly export_name;
 105   incr id;
 106   { h_id = !id; h_sentinel = "TESTING" }
 107
 108 let close h =
 109   NBDKit.debug "test ocaml plugin closing handle id=%d" h.h_id;
 110   assert (h.h_id > 0);
 111   assert (h.h_sentinel = "TESTING");
 112   ()
 113
 114 let list_exports _ _ =
 115   [ { NBDKit.name = "name1"; description = Some "desc1" };
 116     { name = "name2"; description = None } ]
 117
 118 let default_export _ _ = "name1"
 119
 120 let get_size h =
 121   NBDKit.debug "test ocaml plugin get_size handle id=%d" h.h_id;
 122   assert (h.h_id > 0);
 123   assert (h.h_sentinel = "TESTING");
 124   Int64.of_int (Bytes.length disk)
 125
 126 let block_size _ = (1, 4096, -1L)
 127
 128 let pread h count offset _ =
 129   assert (h.h_id > 0);
 130   assert (h.h_sentinel = "TESTING");
 131   let buf = Bytes.create count in
 132   Bytes.blit disk (Int64.to_int offset) buf 0 count;
 133   Bytes.unsafe_to_string buf
 134
 135 let set_non_sparse offset len =
 136   Bytes.fill sparse (offset/sector_size) ((len-1)/sector_size) '\001'
 137
 138 let pwrite h buf offset _ =
 139   assert (h.h_id > 0);
 140   assert (h.h_sentinel = "TESTING");
 141   let len = String.length buf in
 142   let offset = Int64.to_int offset in
 143   String.blit buf 0 disk offset len;
 144   set_non_sparse offset len
 145
 146 let extents _ count offset _ =
 147   let extents = Array.init nr_sectors (
 148     fun sector ->
 149       { NBDKit.offset = Int64.of_int (sector*sector_size);
 150         length = Int64.of_int sector_size;
 151         is_hole = true; is_zero = false }
 152   ) in
 153   Bytes.iteri (
 154     fun i c ->
 155       if c = '\001' then (* not sparse *)
 156         extents.(i) <- { extents.(i) with is_hole = false }
 157   ) sparse;
 158   Array.to_list extents
 159
 160 let thread_model () =
 161   NBDKit.THREAD_MODEL_SERIALIZE_ALL_REQUESTS
 162
 163 let () =
 164   NBDKit.register_plugin
 165     ~name:   "testocaml"
 166     ~version: (NBDKit.version ())
 167
 168     ~load
 169     ~get_ready
 170     ~after_fork
 171     ~cleanup
 172     ~unload
 173
 174     ~config
 175     ~config_complete
 176     ~thread_model
 177     ~magic_config_key: "d"
 178
 179     ~open_connection
 180     ~close
 181     ~get_size
 182     ~block_size
 183     ~pread
 184     ~pwrite
 185     ~extents
 186
 187     ~list_exports
 188     ~default_export
 189     ()