mirage · Mar 14, 2016 · Mar 14, 2016 · Mar 14, 2016 · Mar 14, 2016 · Mar 14, 2016
Showing with 117 additions and 107 deletions.

+1 −0 .merlin

+12 −0 CHANGES.md

+2 −2 _oasis

+4 −1 _tags

+4 −4 lib/META

+57 −57 lib/mirage.ml

+11 −38 lib/mirage_key.ml

+3 −0 lib/mirage_key.mli

+15 −0 mirage-types-lwt.opam

+3 −0 mirage.opam

+5 −5 setup.ml
diff --git a/.merlin b/.merlin
@@ -3,6 +3,7 @@ S lib/*
 S lib_runtime/*
 S lib_test/*
 PKG ipaddr unix dynlink lwt cmdliner mirage-types.lwt functoria rresult fmt
+PKG astring
 
 FLG -w +A-4-6-7-9-40-42-44-48
 FLG -strict_sequence -safe_string
diff --git a/CHANGES.md b/CHANGES.md
@@ -1,3 +1,15 @@
+### 2.7.1 (trunk)
+
+* Improve the Dockerfile (#507, by @avsm)
+* Use Astring
+* Clean-up dependencies automatically added by the tool
+  - do not require `lwt.syntax`, `cstruct.syntax` and `sexplib`, which
+    should make the default unikernels camlp4-free (#510, #515 by @samoht)
+  - always require `mirage-platform` (#512, by @talex5)
+  - ensure that `mirage-types` >= 2.6.0 and `mirage-types-lwt` are
+    installed
+* Check that the OCaml compiler is at least 4.02.3
+
 ### 2.7.0 (2016-02-17)
 
 The mirage tool is now based on functoria. (#441 #450, by @drup @samoht)

diff --git a/_oasis b/_oasis
@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        mirage
-Version:     2.7.0
+Version:     2.7.1
 Synopsis:    Mirage configuration tool
 Authors:     Thomas Gazagnaire, Anil Madhavapeddy, Dave Scott, Thomas Leonard
 License:     ISC
@@ -12,7 +12,7 @@ Library "mirage-runtime"
   Findlibparent:      mirage
   Findlibname:        runtime
   Modules:            Mirage_runtime, Mirage_info
-  BuildDepends:       functoria.runtime, ipaddr
+  BuildDepends:       functoria.runtime, ipaddr, astring
 
 Library mirage
   CompiledObject:     best

diff --git a/_tags b/_tags
@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: c50d20c5631ef5b982eb1c6ead8daad3)
+# DO NOT EDIT (digest: 4e91f4fbdf06d99d4c740d67793a5f80)
 # 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
@@ -16,17 +16,20 @@ true: annot, bin_annot
 "_darcs": not_hygienic
 # Library mirage-runtime
 "lib_runtime/mirage-runtime.cmxs": use_mirage-runtime
+<lib_runtime/*.ml{,i,y}>: pkg_astring
 <lib_runtime/*.ml{,i,y}>: pkg_functoria.runtime
 <lib_runtime/*.ml{,i,y}>: pkg_ipaddr
 # Library mirage
 "lib/mirage.cmxs": use_mirage
 # Executable mirage
+<lib/main.{native,byte}>: pkg_astring
 <lib/main.{native,byte}>: pkg_functoria
 <lib/main.{native,byte}>: pkg_functoria.app
 <lib/main.{native,byte}>: pkg_functoria.runtime
 <lib/main.{native,byte}>: pkg_ipaddr
 <lib/main.{native,byte}>: use_mirage
 <lib/main.{native,byte}>: use_mirage-runtime
+<lib/*.ml{,i,y}>: pkg_astring
 <lib/*.ml{,i,y}>: pkg_functoria
 <lib/*.ml{,i,y}>: pkg_functoria.app
 <lib/*.ml{,i,y}>: pkg_functoria.runtime

diff --git a/lib/META b/lib/META
@@ -1,6 +1,6 @@
 # OASIS_START
-# DO NOT EDIT (digest: 5e8298e9163c1abb10551d46f791dbf5)
-version = "2.7.0"
+# DO NOT EDIT (digest: cfb5d21d70868ed8792bac8b338cab74)
+version = "2.7.1"
 description = "Mirage configuration tool"
 requires = "ipaddr functoria mirage.runtime functoria.app"
 archive(byte) = "mirage.cma"
@@ -9,9 +9,9 @@ archive(native) = "mirage.cmxa"
 archive(native, plugin) = "mirage.cmxs"
 exists_if = "mirage.cma"
 package "runtime" (
- version = "2.7.0"
+ version = "2.7.1"
  description = "Mirage configuration tool"
- requires = "functoria.runtime ipaddr"
+ requires = "functoria.runtime ipaddr astring"
  archive(byte) = "mirage-runtime.cma"
  archive(byte, plugin) = "mirage-runtime.cma"
  archive(native) = "mirage-runtime.cmxa"

diff --git a/lib/mirage.ml b/lib/mirage.ml
@@ -16,6 +16,9 @@
  *)
 
 open Rresult
+open Astring
+
+let mirage_types_version = ">=2.6.0"
 
 module Key = Mirage_key
 module Name = Functoria_app.Name
@@ -47,7 +50,6 @@ end
 
 let default_io_page = impl io_page_conf
 
-
 type time = TIME
 let time = Type TIME
 
@@ -129,7 +131,7 @@ let crunch dirname = impl @@ object
     method ty = kv_ro
     val name = Name.create ("static" ^ dirname) ~prefix:"static"
     method name = name
-    method module_name = String.capitalize name
+    method module_name = String.Ascii.capitalize name
     method packages = Key.pure [ "mirage-types"; "lwt"; "cstruct"; "crunch" ]
     method libraries = Key.pure [ "mirage-types"; "lwt"; "cstruct" ]
     method deps = [ abstract default_io_page ]
@@ -1126,13 +1128,15 @@ let configure_main_xl ?substitutions ext i =
         let (/) = Pervasives.(/) in
         let high, low = x / 26 - 1, x mod 26 + 1 in
         let high' = if high = -1 then "" else string_of_int26 high in
-        let low' = String.make 1 (char_of_int (low + (int_of_char 'a') - 1)) in
+        let low' =
+          String.v 1 (fun _ -> char_of_int (low + (int_of_char 'a') - 1))
+        in
         high' ^ low' in
       let vdev = Printf.sprintf "xvd%s" (string_of_int26 b.number) in
       let path = lookup substitutions (Block b) in
       Printf.sprintf "'format=raw, vdev=%s, access=rw, target=%s'" vdev path
     ) (Hashtbl.fold (fun _ v acc -> v :: acc) all_blocks []) in
-  append fmt "disk = [ %s ]" (String.concat ", " blocks);
+  append fmt "disk = [ %s ]" (String.concat ~sep:", " blocks);
   newline fmt;
   let networks = List.map (fun n ->
       Printf.sprintf "'bridge=%s'" (lookup substitutions (Network n))
@@ -1142,7 +1146,7 @@ let configure_main_xl ?substitutions ext i =
   append fmt "#     vif.default.script=\"vif-openvswitch\"";
   append fmt "# or add \"script=vif-openvswitch,\" before the \"bridge=\" \
               below:";
-  append fmt "vif = [ %s ]" (String.concat ", " networks);
+  append fmt "vif = [ %s ]" (String.concat ~sep:", " networks);
   ()
 
 let clean_main_xl ~root ~name ext = Cmd.remove (root / name ^ ext)
@@ -1206,66 +1210,30 @@ let configure_main_xe ~root ~name =
 
 let clean_main_xe ~root ~name = Cmd.remove (root / name ^ ".xe")
 
-(* FIXME: replace by Astring *)
-module X = struct
-  let strip str =
-    let p = ref 0 in
-    let l = String.length str in
-    let fn = function
-      | ' ' | '\t' | '\r' | '\n' -> true
-      | _ -> false in
-    while !p < l && fn (String.unsafe_get str !p) do
-      incr p;
-    done;
-    let p = !p in
-    let l = ref (l - 1) in
-    while !l >= p && fn (String.unsafe_get str !l) do
-      decr l;
-    done;
-    String.sub str p (!l - p + 1)
-
-  let cut_at s sep =
-    try
-      let i = String.index s sep in
-      let name = String.sub s 0 i in
-      let version = String.sub s (i+1) (String.length s - i - 1) in
-      Some (name, version)
-    with _ ->
-      None
-
-  let split s sep =
-    let rec aux acc r =
-      match cut_at r sep with
-      | None       -> List.rev (r :: acc)
-      | Some (h,t) -> aux (strip h :: acc) t in
-    aux [] s
-
-end
-
 (* Implement something similar to the @name/file extended names of findlib. *)
 let rec expand_name ~lib param =
-  match X.cut_at param '@' with
+  match String.cut param ~sep:"@" with
   | None -> param
-  | Some (prefix, name) -> match X.cut_at name '/' with
+  | Some (prefix, name) -> match String.cut name ~sep:"/" with
     | None              -> prefix ^ lib / name
     | Some (name, rest) -> prefix ^ lib / name / expand_name ~lib rest
 
 (* Get the linker flags for any extra C objects we depend on.
  * This is needed when building a Xen image as we do the link manually. *)
 let get_extra_ld_flags pkgs =
   Cmd.read "opam config var lib" >>= fun s ->
-  let lib = X.strip s in
+  let lib = String.trim s in
   Cmd.read
     "ocamlfind query -r -format '%%d\t%%(xen_linkopts)' -predicates native %s"
-    (String.concat " " pkgs) >>| fun output ->
-  X.split output '\n'
+    (String.concat ~sep:" " pkgs) >>| fun output ->
+  String.cuts output ~sep:"\n"
   |> List.fold_left (fun acc line ->
-      match X.cut_at line '\t' with
+      match String.cut line ~sep:"\t" with
       | None -> acc
       | Some (dir, ldflags) ->
-        let ldflags = X.split ldflags ' ' in
+        let ldflags = String.cuts ldflags ~sep:" " in
         let ldflags = List.map (expand_name ~lib) ldflags in
-        let ldflags = String.concat " " ldflags in
+        let ldflags = String.concat ~sep:" " ldflags in
         Printf.sprintf "-L%s %s" dir ldflags :: acc
     ) []
 
@@ -1329,7 +1297,7 @@ let configure_makefile ~target ~root ~name info =
   append fmt "PKGS   = %s" packages;
   let default_tags =
     "warn_error(+1..49),warn(A-4-41-44),debug,bin_annot,\
-     strict_sequence,principal"
+     strict_sequence,principal,safe_string"
   in
   begin match target with
     | `Xen  ->
@@ -1370,7 +1338,7 @@ let configure_makefile ~target ~root ~name info =
     let need_zImage =
       match Cmd.uname_m () with
       | Some machine ->
-        String.length machine > 2 && String.sub machine 0 3 = "arm"
+        String.length machine > 2 && String.is_prefix ~affix:"arm" machine
       | None -> failwith "uname -m failed; can't determine target machine type!"
     in
     if need_zImage then (
@@ -1384,7 +1352,7 @@ let configure_makefile ~target ~root ~name info =
   begin match target with
     | `Xen ->
       get_extra_ld_flags libs
-      >>| String.concat " \\\n\t  "
+      >>| String.concat ~sep:" \\\n\t  "
       >>= fun extra_c_archives ->
       append fmt "build:: main.native.o";
       let pkg_config_deps = "mirage-xen" in
@@ -1412,10 +1380,42 @@ let configure_makefile ~target ~root ~name info =
 
 let clean_makefile ~root = Cmd.remove (root / "Makefile")
 
+let check_ocaml_version () =
+  (* Similar to [Functoria_app.Cmd.ocaml_version] but with the patch number *)
+  let ocaml_version =
+    let version =
+      let v = Sys.ocaml_version in
+      match String.cut v ~sep:"+" with None -> v | Some (v, _) -> v
+    in
+    match String.cuts version ~sep:"." with
+    | [major; minor; patch] ->
+      begin
+        try int_of_string major, int_of_string minor, int_of_string patch
+        with _ -> 0, 0, 0
+      end
+    | _ -> 0, 0, 0
+  in
+  let major, minor, patch = ocaml_version in
+  if major < 4 ||
+     (major = 4 && minor < 2) ||
+     (major = 4 && minor = 2 && patch < 3)
+  then (
+    Log.error
+      "Your version of OCaml (%d.%02d.%d) is not supported. Please upgrade to\n\
+       at least OCaml 4.02.3 or use `--no-ocaml-version-check`."
+      major minor patch
+  ) else
+    R.ok ()
+
 let configure i =
   let name = Info.name i in
   let root = Info.root i in
   let target = Key.(get (Info.context i) target) in
+  let ocaml_check = not (Key.(get (Info.context i) no_ocaml_check)) in
+  begin
+    if ocaml_check then check_ocaml_version ()
+    else R.ok ()
+  end >>= fun () ->
   check_entropy @@ Info.libraries i >>= fun () ->
   Log.info "%a %a" Log.blue "Configuring for target:" Key.pp_target target ;
   Cmd.in_dir root (fun () ->
@@ -1458,17 +1458,17 @@ module Project = struct
         Key.(abstract target);
         Key.(abstract unix);
         Key.(abstract xen);
+        Key.(abstract no_ocaml_check);
       ]
 
       method packages =
-        let l = [ "lwt"; "sexplib" ] in
+        let l = [
+          "lwt"; "mirage-types" ^ mirage_types_version; "mirage-types-lwt"
+        ] in
         Key.(if_ is_xen) ("mirage-xen" :: l) ("mirage-unix" :: l)
 
       method libraries =
-        let l = [
-          "lwt.syntax" ; "mirage.runtime" ;
-          "mirage-types.lwt" ; "sexplib"
-        ] in
+        let l = [ "mirage.runtime"; "mirage-types.lwt" ] in
         Key.(if_ is_xen) ("mirage-xen" :: l) ("mirage-unix" :: l)
 
       method configure = configure

diff --git a/lib/mirage_key.ml b/lib/mirage_key.ml
@@ -16,42 +16,7 @@
 
 module Key = Functoria_key
 module Alias = Key.Alias
-
-(* FIXME: replace by Astring *)
-module X = struct
-  let strip str =
-    let p = ref 0 in
-    let l = String.length str in
-    let fn = function
-      | ' ' | '\t' | '\r' | '\n' -> true
-      | _ -> false in
-    while !p < l && fn (String.unsafe_get str !p) do
-      incr p;
-    done;
-    let p = !p in
-    let l = ref (l - 1) in
-    while !l >= p && fn (String.unsafe_get str !l) do
-      decr l;
-    done;
-    String.sub str p (!l - p + 1)
-
-  let cut_at s sep =
-    try
-      let i = String.index s sep in
-      let name = String.sub s 0 i in
-      let version = String.sub s (i+1) (String.length s - i - 1) in
-      Some (name, version)
-    with _ ->
-      None
-
-  let split s sep =
-    let rec aux acc r =
-      match cut_at r sep with
-      | None       -> List.rev (r :: acc)
-      | Some (h,t) -> aux (strip h :: acc) t in
-    aux [] s
-
-end
+open Astring
 
 (** {2 Custom Descriptions} *)
 
@@ -120,7 +85,7 @@ let default_unix = lazy (
         match Functoria_app.Cmd.uname_r () with
         | None -> false
         | Some vs ->
-          match X.split vs '.' with
+          match String.cuts vs ~sep:"." with
           | [] -> false
           | hd::_ -> begin
               let v = try int_of_string hd with _ -> 0 in
@@ -175,6 +140,14 @@ let xen =
   let alias = Alias.add target setter alias in
   Key.alias "xen" alias
 
+let no_ocaml_check =
+  let doc = "Bypass the OCaml compiler version checks." in
+  let doc =
+    Arg.info ~docs:mirage_section ~docv:"BOOL" ~doc ["no-ocaml-version-check"]
+  in
+  let key = Arg.flag ~stage:`Configure doc in
+  Key.create "ocaml_version_check" key
+
 (** {3 Tracing} *)
 
 let tracing_size default =
@@ -188,7 +161,7 @@ let tracing_size default =
 let create_simple ?(group="") ?(stage=`Both) ~doc ~default conv name =
   let prefix = if group = "" then group else group^"-" in
   let doc =
-    Arg.info ~docs:unikernel_section ~docv:(String.uppercase name) ~doc
+    Arg.info ~docs:unikernel_section ~docv:(String.Ascii.uppercase name) ~doc
       [prefix ^ name]
   in
   let key = Arg.opt ~stage conv default doc in

diff --git a/lib/mirage_key.mli b/lib/mirage_key.mli
@@ -44,6 +44,9 @@ val unix: bool key
 val xen: bool key
 (** [--xen]. Set {!target} to [`Xen]. *)
 
+val no_ocaml_check: bool key
+(** [--no-ocaml-check]. Do not check the version of the compiler. *)
+
 val tracing_size: int -> int key
 (** [--tracing-size]: Key setting the tracing ring buffer size. *)