Merge pull request #3 from djs55/partition

Add a Partition V1_LWT.BLOCK device

.gitignore

@@ -9,3 +9,4 @@
 *.cmxa
 _build
 setup.*
+main.native

.travis-ci.sh

@@ -1,5 +1,5 @@
 # OPAM packages needed to build tests.
-OPAM_PACKAGES="cstruct ounit lwt cstruct cmdliner re"
+OPAM_PACKAGES="cstruct ounit lwt cstruct cmdliner re mirage-types ipaddr io-page"
 
 
 case "$OCAML_VERSION,$OPAM_VERSION" in

CHANGES.md

@@ -0,0 +1,4 @@
+v0.2 (unreleased)
+* add Mbr_partition: V1_LWT.BLOCK, for easy access to partitions via
+  the standard Mirage block interface.
+* use a polymorphic variant result type [`Ok of 'a | `Error of 'b]

README.md

@@ -8,6 +8,35 @@ primary purposes of this library are:
   2. for mirage kernels to read the partition tables on
      attached disks
 
+Usage
+-----
+Define a single partition as follows:
+```
+    let disk_length_bytes = Int32.(mul (mul 16l 1024l) 1024l) in
+    let disk_length_sectors = Int32.(div disk_length_bytes 512l) in
+
+    let start_sector = 2048l in
+    let length_sectors = Int32.sub disk_length_sectors start_sector in
+    let partition = Mbr.Partition.make ~active:true ~ty:6 start_sector length_sectors in
+    let mbr = Mbr.make [ partition ] in
+```
+You can write the MBR to sector zero of a block device ```B``` as follows:
+```
+    B.connect id >>|= fun device ->
+    let sector = Cstruct.create 512 in
+    Mbr.marshal sector mbr;
+    B.write device 0L [ sector ] >>|= fun () ->
+```
+You can then create a Partition block device as follows:
+```
+    let module Partition = Mbr_partition.Make(B) in
+    Partition.connect {
+      Partition.b = device;
+      start_sector = Int64.of_int32 start_sector;
+      length_sectors = Int64.of_int32 length_sectors;
+    } >>= fun partition_or_error ->
+```
+
 To do items
 -----------
 

_oasis

@@ -3,7 +3,7 @@ Name:        mbr-format
 Version:     0.0.1
 Synopsis:    Manipulate MBR
 Authors:     David Scott
-License:     LGPL-2.1 with OCaml linking exception
+License:     ISC
 Plugins:     META (0.3)
 BuildTools:  ocamlbuild
 
@@ -22,6 +22,14 @@ Library mbr_lwt
   Modules:            Mbr_lwt
   BuildDepends:       lwt, lwt.unix, cstruct.lwt, oUnit, mbr-format
 
+Library mbr_mirage
+  CompiledObject:     best
+  Path:               lib
+  Findlibname:        mirage
+  Findlibparent:      mbr
+  Modules:            Mbr_partition
+  BuildDepends:       mirage-types.lwt, mbr-format
+
 Executable mbr_tool
   CompiledObject:     best
   Path:               cli

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 269525f6ec1de80056a7295624a8ed02)
+# DO NOT EDIT (digest: 7d9c60693a2f903e02c5afece637a435)
 # 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
@@ -17,11 +17,14 @@
 "lib/mbr.cmxs": use_mbr
 # Library mbr_lwt
 "lib/mbr_lwt.cmxs": use_mbr_lwt
-<lib/*.ml{,i}>: use_mbr
 <lib/*.ml{,i}>: pkg_lwt
 <lib/*.ml{,i}>: pkg_lwt.unix
 <lib/*.ml{,i}>: pkg_cstruct.lwt
 <lib/*.ml{,i}>: pkg_oUnit
+# Library mbr_mirage
+"lib/mbr_mirage.cmxs": use_mbr_mirage
+<lib/*.ml{,i}>: use_mbr
+<lib/*.ml{,i}>: pkg_mirage-types.lwt
 <lib/*.ml{,i}>: pkg_cstruct
 <lib/*.ml{,i}>: pkg_re.str
 # Executable mbr_tool

cli/common.ml

@@ -1,15 +1,17 @@
 (*
  * Copyright (C) 2011-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.
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
  *
- * 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.
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
 type t = {

cli/impl.ml

@@ -1,15 +1,17 @@
 (*
  * Copyright (C) 2011-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.
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
  *
- * 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.
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
 open Common
@@ -28,10 +30,10 @@ let info common filename =
       Lwt_unix.openfile filename [ Lwt_unix.O_RDONLY ] 0o0 >>= fun fd ->
       Mbr_lwt.really_read fd mbr >>= fun () ->
       let mbr = match Mbr.unmarshal mbr with
-      | Mbr.Error reason ->
+      | `Error reason ->
         Printf.fprintf stderr "Failed to unmarshal MBR: %s\n%!" reason;
         exit 1
-      | Mbr.Ok x -> x in
+      | `Ok x -> x in
       let all = List.map (fun f ->
         match Mbr.get mbr f with
         | Some v -> [ f; v ]

cli/main.ml

@@ -1,15 +1,17 @@
 (*
  * Copyright (C) 2011-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.
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
  *
- * 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.
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
 let project_url = "http://github.com/djs55/ocaml-mbr"

lib/META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 7116af57da2d7446eef73d18415b7aa6)
+# DO NOT EDIT (digest: 8498b8b1c43505627a1e698b3cdb7fc8)
 version = "0.0.1"
 description = "Manipulate MBR"
 requires = "cstruct re.str"
@@ -8,6 +8,17 @@ archive(byte, plugin) = "mbr.cma"
 archive(native) = "mbr.cmxa"
 archive(native, plugin) = "mbr.cmxs"
 exists_if = "mbr.cma"
+package "mirage" (
+ version = "0.0.1"
+ description = "Manipulate MBR"
+ requires = "mirage-types.lwt mbr-format"
+ archive(byte) = "mbr_mirage.cma"
+ archive(byte, plugin) = "mbr_mirage.cma"
+ archive(native) = "mbr_mirage.cmxa"
+ archive(native, plugin) = "mbr_mirage.cmxs"
+ exists_if = "mbr_mirage.cma"
+)
+
 package "lwt" (
  version = "0.0.1"
  description = "Manipulate MBR"

lib/mbr.ml

@@ -1,27 +1,30 @@
 (*
  * Copyright (C) 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.
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
  *
- * 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.
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-type ('a, 'b) result =
-  | Ok of 'a
-  | Error of 'b
+type ('a, 'b) result = [
+  | `Ok of 'a
+  | `Error of 'b
+]
 
 let ( >>= ) x f = match x with
-  | Error y -> Error y
-  | Ok z -> f z
+  | `Error y -> `Error y
+  | `Ok z -> f z
 
-let return x = Ok x
-let fail y = Error y
+let return x = `Ok x
+let fail y = `Error y
 
 let kib = 1024L
 let mib = Int64.mul kib 1024L

lib/mbr.mli

@@ -1,20 +1,23 @@
 (*
  * Copyright (C) 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.
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
  *
- * 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.
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-type ('a, 'b) result =
-  | Ok of 'a
-  | Error of 'b
+type ('a, 'b) result = [
+  | `Ok of 'a
+  | `Error of 'b
+]
 
 module Geometry : sig
   type t = {

lib/mbr_lwt.ml

@@ -1,15 +1,17 @@
 (*
  * Copyright (C) 2011-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.
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
  *
- * 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.
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
 let complete op fd buffer =

lib/mbr_mirage.mllib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: e3ebb1abe7bc4e1039c976805958e7ff)
+Mbr_partition
+# OASIS_STOP