Merge pull request #10 from djs55/get_file_size

Use BLKGETSIZE64 to find the size of block devices on Linux

CHANGES

@@ -1,3 +1,7 @@
+0.6.1 (2013-10-30)
+* raw: use BLKGETSIZE64 to query the size if stat(2) reveals we've been given
+  a block device. Otherwise we use a file size of 0 and don't copy anything.
+
 0.6.0 (2013-10-02)
 * move CLI tools to vhd-tool repo
 * can parse and print XenServer 'batmaps'

_oasis

@@ -21,7 +21,7 @@ Library vhd_lwt
   Findlibparent:      vhd
   Modules:            Vhd_lwt, Memory, File
   BuildDepends:       lwt, lwt.unix, cstruct.lwt
-  CSources:           odirect_stubs.c
+  CSources:           odirect_stubs.c, blkgetsize64_stubs.c
 
 Executable disk_to_ocaml
   CompiledObject:     best

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 8f29976a6c79d0207b3554660bcd5338)
+# DO NOT EDIT (digest: f70a1508d9b9c6e553b4bd94403e687b)
 # Ignore VCS directories, you can use the same kind of rule outside 
 # OASIS_START/STOP if you want to exclude directories that contains 
 # useless stuff for the build process
@@ -26,6 +26,9 @@
 "lib/odirect_stubs.c": pkg_lwt
 "lib/odirect_stubs.c": pkg_lwt.unix
 "lib/odirect_stubs.c": pkg_cstruct.lwt
+"lib/blkgetsize64_stubs.c": pkg_lwt
+"lib/blkgetsize64_stubs.c": pkg_lwt.unix
+"lib/blkgetsize64_stubs.c": pkg_cstruct.lwt
 # Executable disk_to_ocaml
 <lib_test/disk_to_ocaml.{native,byte}>: use_vhd
 <lib_test/disk_to_ocaml.{native,byte}>: use_vhd_lwt

lib/blkgetsize64_stubs.c

@@ -0,0 +1,62 @@
+/*
+ * Copyright (C) 2012-2013 Citrix Inc
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#define _GNU_SOURCE
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/ioctl.h>
+
+#include <fcntl.h>
+#include <string.h>
+#include <unistd.h>
+#include <stdint.h>
+
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+#include <caml/bigarray.h>
+
+#include <linux/fs.h>
+
+/* ocaml/ocaml/unixsupport.c */
+extern void uerror(char *cmdname, value cmdarg);
+#define Nothing ((value) 0)
+
+CAMLprim value stub_blkgetsize64(value filename){
+  CAMLparam1(filename);
+  CAMLlocal1(result);
+  uint64_t size_in_bytes;
+  int fd;
+  int success = -1;
+
+  const char *filename_c = strdup(String_val(filename));
+
+  enter_blocking_section();
+  fd = open(filename_c, O_RDONLY, 0);
+  if (ioctl(fd, BLKGETSIZE64, &size_in_bytes) == 0)
+    success = 0;
+  close(fd);
+  leave_blocking_section();
+
+  free((void*)filename_c);
+
+  if (fd == -1) uerror("open", filename);
+  if (success == -1) uerror("BLKGETSIZE64", filename);
+
+  result = caml_copy_int64(size_in_bytes);
+  CAMLreturn(result);
+}

lib/file.ml

@@ -21,5 +21,15 @@ let openfile_buffered filename mode = Unix.openfile filename [ Unix.O_RDWR ] mod
 let openfile filename mode =
   (if !use_unbuffered then openfile_unbuffered else openfile_buffered) filename mode
 
+external blkgetsize64: string -> int64 = "stub_blkgetsize64"
+
+let get_file_size x =
+    let st = Unix.LargeFile.stat x in
+    match st.Unix.LargeFile.st_kind with
+    | Unix.S_REG -> st.Unix.LargeFile.st_size
+    | Unix.S_BLK -> blkgetsize64 x
+    | _ -> failwith (Printf.sprintf "get_file_size: %s not a file or block device" x)
+
+
 external fsync : Unix.file_descr -> unit = "stub_fsync"
 

lib/file.mli

@@ -19,6 +19,10 @@ val openfile: string -> int -> Unix.file_descr
 (** [openfile filename mode] opens [filename] read/write using
     the current global buffering mode *)
 
+val get_file_size: string -> int64
+(** [fet_file_size filename] returns the number of bytes in
+    [filename] *)
+
 val fsync: Unix.file_descr -> unit
 (** [fsync fd] ensures that any buffered data is written to disk
     and throws a Unix_error if any error has been recorded. *)

lib/libvhd_lwt_stubs.clib

@@ -1,4 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 3a6abcfa7c057ed135e78ec83409b74c)
+# DO NOT EDIT (digest: c1076fe4f88bd54552501d43953ee96c)
 odirect_stubs.o
+blkgetsize64_stubs.o
 # OASIS_STOP

lib/vhd_lwt.ml

@@ -142,8 +142,8 @@ module IO = struct
     return (get_vhd_time (st.Lwt_unix.LargeFile.st_mtime))
 
   let get_file_size x =
-    lwt st = Lwt_unix.LargeFile.stat x in
-    return st.Lwt_unix.LargeFile.st_size
+    try return (File.get_file_size x)
+    with e -> fail e
 
   include Fd
   include Memory

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.3.1 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 321da920ea160f52d91533874f34ce51) *)
+(* DO NOT EDIT (digest: 1e2cb7941c9ef51d733897573cffd698) *)
 (*
    Regenerated by OASIS v0.3.0
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -5851,7 +5851,8 @@ let setup_t =
                            FindlibPackage ("cstruct.lwt", None)
                         ];
                       bs_build_tools = [ExternalTool "ocamlbuild"];
-                      bs_c_sources = ["odirect_stubs.c"];
+                      bs_c_sources =
+                        ["odirect_stubs.c"; "blkgetsize64_stubs.c"];
                       bs_data_files = [];
                       bs_ccopt = [(OASISExpr.EBool true, [])];
                       bs_cclib = [(OASISExpr.EBool true, [])];
@@ -5959,14 +5960,14 @@ let setup_t =
           };
      oasis_fn = Some "_oasis";
      oasis_version = "0.3.0";
-     oasis_digest = Some "\156h\209e\018J\167\241\163\247g\255$\197N\027";
+     oasis_digest = Some "X\136J\202\2040\175\219~s\134&B.\024\184";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false;
      };;
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 5971 "setup.ml"
+# 5972 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;