Skip to content
Permalink

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also or learn more about diff comparisons.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also . Learn more about diff comparisons here.
base repository: mirage/mirage
Failed to load repositories. Confirm that selected base ref is valid, then try again.
Loading
base: 50cf03a2fc9c
Choose a base ref
...
head repository: mirage/mirage
Failed to load repositories. Confirm that selected head ref is valid, then try again.
Loading
compare: 23f242f2c76f
Choose a head ref
  • 3 commits
  • 34 files changed
  • 1 contributor

Commits on Nov 17, 2018

  1. upper bounds

    hannesm committed Nov 17, 2018
    Copy the full SHA
    a043eb9 View commit details
  2. tigthen bounds

    hannesm committed Nov 17, 2018
    Copy the full SHA
    997dcda View commit details

Commits on Nov 18, 2018

  1. Merge pull request #946 from hannesm/bounds

    upper bounds
    hannesm authored Nov 18, 2018
    Copy the full SHA
    23f242f View commit details
2 changes: 1 addition & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
@@ -9,7 +9,7 @@ env:
global:
- PRE_INSTALL_HOOK="cd /home/opam/opam-repository && git pull origin master && opam update -u -y"
- POST_INSTALL_HOOK="sh ./.travis-ci.sh"
- PINS="mirage.dev:. mirage-types.dev:. mirage-types-lwt.dev:. mirage-runtime.dev:."
- PINS="mirage:. mirage-types:. mirage-types-lwt:. mirage-runtime:."
- EXTRA_REMOTES="https://github.com/mirage/mirage-dev.git"
matrix:
- PACKAGE=mirage DISTRO=debian-testing OCAML_VERSION=4.04 EXTRA_ENV="MODE=xen"
74 changes: 48 additions & 26 deletions lib/mirage.ml
Original file line number Diff line number Diff line change
@@ -32,9 +32,9 @@ include Functoria

(* Mirage implementation backing the target. *)
let backend_predicate = function
| `Xen | `Qubes -> "mirage_xen"
| `Xen | `Qubes -> "mirage_xen"
| `Virtio | `Hvt | `Muen | `Genode -> "mirage_solo5"
| `Unix | `MacOSX -> "mirage_unix"
| `Unix | `MacOSX -> "mirage_unix"

(** {2 Devices} *)

@@ -355,7 +355,8 @@ module Substitutions = struct

let defaults i =
let blocks =
List.map (fun b -> Block b, Fpath.(to_string ((Info.build_dir i) / b.filename)))
List.map
(fun b -> Block b, Fpath.(to_string ((Info.build_dir i) / b.filename)))
(Hashtbl.fold (fun _ v acc -> v :: acc) Mirage_impl_block.all_blocks [])
and networks =
List.mapi (fun i n -> Network n, Fmt.strf "%s%d" detected_bridge_name i)
@@ -657,7 +658,10 @@ let pkg_config pkgs args =
Lazy.force opam_prefix >>= fun prefix ->
(* the order here matters (at least for ancient 0.26, distributed with
ubuntu 14.04 versions): use share before lib! *)
let value = Fmt.strf "%s/share/pkgconfig:%s/lib/pkgconfig%s" prefix prefix pkg_config_fallback in
let value =
Fmt.strf "%s/share/pkgconfig:%s/lib/pkgconfig%s"
prefix prefix pkg_config_fallback
in
Bos.OS.Env.set_var var (Some value) >>= fun () ->
let cmd = Bos.Cmd.(v "pkg-config" % pkgs %% of_list args) in
Bos.OS.Cmd.run_out cmd |> Bos.OS.Cmd.out_string >>| fun (data, _) ->
@@ -696,14 +700,15 @@ let ldpostflags pkg = pkg_config pkg ["--variable=ldpostflags"]
let find_ld pkg =
match pkg_config pkg ["--variable=ld"] with
| Ok (ld::_) ->
Log.info (fun m -> m "using %s as ld (pkg-config %s --variable=ld)" ld pkg) ;
Log.info (fun m -> m "using %s as ld (pkg-config %s --variable=ld)" ld pkg);
ld
| Ok [] ->
Log.warn (fun m -> m "pkg-config %s --variable=ld returned nothing, using ld" pkg) ;
Log.warn
(fun m -> m "pkg-config %s --variable=ld returned nothing, using ld" pkg);
"ld"
| Error msg ->
Log.warn (fun m -> m "error %a while pkg-config %s --variable=ld, using ld"
Rresult.R.pp_msg msg pkg) ;
Rresult.R.pp_msg msg pkg);
"ld"

let solo5_pkg = function
@@ -718,29 +723,35 @@ let link info name target target_debug =
let libs = Info.libraries info in
match target with
| `Unix | `MacOSX ->
Bos.OS.Cmd.run Bos.Cmd.(v "ln" % "-nfs" % "_build/main.native" % name) >>= fun () ->
let link = Bos.Cmd.(v "ln" % "-nfs" % "_build/main.native" % name) in
Bos.OS.Cmd.run link >>= fun () ->
Ok name
| `Xen | `Qubes ->
extra_c_artifacts "xen" libs >>= fun c_artifacts ->
static_libs "mirage-xen" >>= fun static_libs ->
let linker =
Bos.Cmd.(v "ld" % "-d" % "-static" % "-nostdlib" % "_build/main.native.o" %%
of_list c_artifacts %% of_list static_libs)
Bos.Cmd.(v "ld" % "-d" % "-static" % "-nostdlib" %
"_build/main.native.o" %%
of_list c_artifacts %%
of_list static_libs)
in
let out = name ^ ".xen" in
Bos.OS.Cmd.run_out Bos.Cmd.(v "uname" % "-m") |> Bos.OS.Cmd.out_string >>= fun (machine, _) ->
let uname_cmd = Bos.Cmd.(v "uname" % "-m") in
Bos.OS.Cmd.(run_out uname_cmd |> out_string) >>= fun (machine, _) ->
if String.is_prefix ~affix:"arm" machine then begin
(* On ARM:
- we must convert the ELF image to an ARM boot executable zImage,
while on x86 we leave it as it is.
- we need to link libgcc.a (otherwise we get undefined references to:
__aeabi_dcmpge, __aeabi_dadd, ...) *)
Bos.OS.Cmd.run_out Bos.Cmd.(v "gcc" % "-print-libgcc-file-name") |> Bos.OS.Cmd.out_string >>= fun (libgcc, _) ->
let libgcc_cmd = Bos.Cmd.(v "gcc" % "-print-libgcc-file-name") in
Bos.OS.Cmd.(run_out libgcc_cmd |> out_string) >>= fun (libgcc, _) ->
let elf = name ^ ".elf" in
let link = Bos.Cmd.(linker % libgcc % "-o" % elf) in
Log.info (fun m -> m "linking with %a" Bos.Cmd.pp link);
Bos.OS.Cmd.run link >>= fun () ->
Bos.OS.Cmd.run Bos.Cmd.(v "objcopy" % "-O" % "binary" % elf % out) >>= fun () ->
let objcopy_cmd = Bos.Cmd.(v "objcopy" % "-O" % "binary" % elf % out) in
Bos.OS.Cmd.run objcopy_cmd >>= fun () ->
Ok out
end else begin
let link = Bos.Cmd.(linker % "-o" % out) in
@@ -773,8 +784,16 @@ let link info name target target_debug =
in
pkg_config pkg ["--variable=libdir"] >>= function
| [ libdir ] ->
Bos.OS.Cmd.run Bos.Cmd.(v "solo5-hvt-configure" % (libdir ^ "/src") %% of_list tender_mods) >>= fun () ->
Bos.OS.Cmd.run Bos.Cmd.(v "make" % "-f" % "Makefile.solo5-hvt" % "solo5-hvt") >>= fun () ->
let config_cmd =
Bos.Cmd.(v "solo5-hvt-configure" %
(libdir ^ "/src") %%
of_list tender_mods)
in
Bos.OS.Cmd.run config_cmd >>= fun () ->
let make_cmd =
Bos.Cmd.(v "make" % "-f" % "Makefile.solo5-hvt" % "solo5-hvt")
in
Bos.OS.Cmd.run make_cmd >>= fun () ->
Ok out
| _ -> R.error_msg ("pkg-config " ^ pkg ^ " --variable=libdir failed")
else
@@ -866,23 +885,26 @@ module Project = struct
Key.(abstract no_depext);
]
method! packages =
(* XXX: use %%VERSION_NUM%% here instead of hardcoding a version? *)
let min = "3.3.0" and max = "3.4.0" in
let common = [
package ~build:true ~min:"4.04.2" "ocaml";
package "lwt";
(* XXX: use %%VERSION_NUM%% here instead of hardcoding a version? *)
package ~min:"3.2.0" "mirage-types-lwt";
package ~min:"3.2.0" "mirage-types";
package ~min:"3.2.0" "mirage-runtime" ;
package ~min ~max "mirage-types-lwt";
package ~min ~max "mirage-types";
package ~min ~max "mirage-runtime" ;
package ~build:true "ocamlfind" ;
package ~build:true "ocamlbuild" ;
] in
Key.match_ Key.(value target) @@ function
| `Unix | `MacOSX -> [ package ~min:"3.0.0" "mirage-unix" ] @ common
| `Xen | `Qubes -> [ package ~min:"3.0.4" "mirage-xen" ] @ common
| `Unix | `MacOSX ->
package ~min:"3.1.0" ~max:"3.2.0" "mirage-unix" :: common
| `Xen | `Qubes ->
package ~min:"3.1.0" ~max:"3.2.0" "mirage-xen" :: common
| `Virtio | `Hvt | `Muen | `Genode as tgt ->
let pkg, _ = solo5_pkg tgt in
[ package ~min:"0.4.0" ~ocamlfind:[] pkg ;
package ~min:"0.4.0" "mirage-solo5" ] @ common
package ~min:"0.4.0" ~max:"0.5.0" ~ocamlfind:[] (fst (solo5_pkg tgt)) ::
package ~min:"0.5.0" ~max:"0.6.0" "mirage-solo5" ::
common
method! build = build
method! configure = configure
@@ -898,8 +920,8 @@ include Functoria_app.Make (Project)
(** {Custom registration} *)
let (++) acc x = match acc, x with
| _ , None -> acc
| None , Some x -> Some [x]
| _ , None -> acc
| None, Some x -> Some [x]
| Some acc, Some x -> Some (acc @ [x])
(* TODO: ideally we'd combine these *)
9 changes: 6 additions & 3 deletions lib/mirage_impl_argv.ml
Original file line number Diff line number Diff line change
@@ -6,7 +6,8 @@ let argv_unix = impl @@ object
method ty = Functoria_app.argv
method name = "argv_unix"
method module_name = "Bootvar"
method! packages = Key.pure [ package "mirage-bootvar-unix" ]
method! packages =
Key.pure [ package ~min:"0.1.0" ~max:"0.2.0" "mirage-bootvar-unix" ]
method! connect _ _ _ = "Bootvar.argv ()"
end

@@ -15,7 +16,8 @@ let argv_solo5 = impl @@ object
method ty = Functoria_app.argv
method name = "argv_solo5"
method module_name = "Bootvar"
method! packages = Key.pure [ package ~min:"0.3.0" "mirage-bootvar-solo5" ]
method! packages =
Key.pure [ package ~min:"0.3.0" ~max:"0.4.0" "mirage-bootvar-solo5" ]
method! connect _ _ _ = "Bootvar.argv ()"
end

@@ -32,7 +34,8 @@ let argv_xen = impl @@ object
method ty = Functoria_app.argv
method name = "argv_xen"
method module_name = "Bootvar"
method! packages = Key.pure [ package ~min:"0.4.0" "mirage-bootvar-xen" ]
method! packages =
Key.pure [ package ~min:"0.4.0" ~max:"0.5.0" "mirage-bootvar-xen" ]
method! connect _ _ _ = Fmt.strf
(* Some hypervisor configurations try to pass some extra arguments.
* They means well, but we can't do much with them,
6 changes: 4 additions & 2 deletions lib/mirage_impl_arpv4.ml
Original file line number Diff line number Diff line change
@@ -13,7 +13,8 @@ let arpv4_conf = object
method ty = ethernet @-> mclock @-> time @-> arpv4
method name = "arpv4"
method module_name = "Arpv4.Make"
method! packages = Key.pure [ package ~min:"3.5.0" ~sublibs:["arpv4"] "tcpip" ]
method! packages =
Key.pure [ package ~min:"3.5.0" ~max:"3.6.0" ~sublibs:["arpv4"] "tcpip" ]
method! connect _ modname = function
| [ eth ; clock ; _time ] -> Fmt.strf "%s.connect %s %s" modname eth clock
| _ -> failwith (connect_err "arpv4" 3)
@@ -32,7 +33,8 @@ let farp_conf = object
method ty = ethernet @-> mclock @-> time @-> arpv4
method name = "arp"
method module_name = "Arp.Make"
method! packages = Key.pure [ package ~min:"0.2.0" ~sublibs:["mirage"] "arp" ]
method! packages =
Key.pure [ package ~min:"0.2.0" ~max:"0.3.0" ~sublibs:["mirage"] "arp" ]
method! connect _ modname = function
| [ eth ; clock ; _time ] -> Fmt.strf "%s.connect %s %s" modname eth clock
| _ -> failwith (connect_err "arp" 3)
9 changes: 5 additions & 4 deletions lib/mirage_impl_block.ml
Original file line number Diff line number Diff line change
@@ -27,7 +27,7 @@ let make_block_t =
b

let xen_block_packages =
[ package ~min:"1.5.0" ~sublibs:["front"] "mirage-block-xen" ]
[ package ~min:"1.5.0" ~max:"2.0.0" ~sublibs:["front"] "mirage-block-xen" ]

(* this class takes a string rather than an int as `id` to allow the user to
pass stuff like "/dev/xvdi1", which mirage-block-xen also understands *)
@@ -69,8 +69,9 @@ class block_conf file =
Key.match_ Key.(value target) @@ function
| `Xen | `Qubes -> xen_block_packages
| `Virtio | `Hvt | `Muen | `Genode ->
[ package ~min:"0.3.0" "mirage-block-solo5" ]
| `Unix | `MacOSX -> [ package ~min:"2.5.0" "mirage-block-unix" ]
[ package ~min:"0.4.0" ~max:"0.5.0" "mirage-block-solo5" ]
| `Unix | `MacOSX ->
[ package ~min:"2.5.0" ~max:"3.0.0" "mirage-block-unix" ]

method! configure _ =
let _block = make_block_t file in
@@ -133,7 +134,7 @@ let archive_conf = impl @@ object
method name = "archive"
method module_name = "Tar_mirage.Make_KV_RO"
method! packages =
Key.pure [ package ~min:"0.8.0" "tar-mirage" ]
Key.pure [ package ~min:"0.9.0" ~max:"0.10.0" "tar-mirage" ]
method! connect _ modname = function
| [ block ] -> Fmt.strf "%s.connect %s" modname block
| _ -> failwith (connect_err "archive" 1)
5 changes: 1 addition & 4 deletions lib/mirage_impl_conduit.ml
Original file line number Diff line number Diff line change
@@ -10,10 +10,7 @@ let conduit_with_connectors connectors = impl @@ object
method ty = conduit
method name = Functoria_app.Name.create "conduit" ~prefix:"conduit"
method module_name = "Conduit_mirage"
method! packages =
Mirage_key.pure [
package ~min:"3.0.1" "mirage-conduit";
]
method! packages = Mirage_key.pure [ pkg ]
method! deps = abstract nocrypto :: List.map abstract connectors

method! connect _i _ = function
14 changes: 5 additions & 9 deletions lib/mirage_impl_conduit_connector.ml
Original file line number Diff line number Diff line change
@@ -6,15 +6,14 @@ open Mirage_impl_stackv4
type conduit_connector = Conduit_connector
let conduit_connector = Type Conduit_connector

let pkg = package ~min:"3.0.1" ~max:"4.0.0" "mirage-conduit"

let tcp_conduit_connector = impl @@ object
inherit base_configurable
method ty = stackv4 @-> conduit_connector
method name = "tcp_conduit_connector"
method module_name = "Conduit_mirage.With_tcp"
method! packages =
Mirage_key.pure [
package ~min:"3.0.1" "mirage-conduit";
]
method! packages = Mirage_key.pure [ pkg ]
method! connect _ modname = function
| [ stack ] -> Fmt.strf "Lwt.return (%s.connect %s)@;" modname stack
| _ -> failwith (connect_err "tcp conduit" 1)
@@ -27,11 +26,8 @@ let tls_conduit_connector = impl @@ object
method module_name = "Conduit_mirage"
method! packages =
Mirage_key.pure [
package ~min:"0.8.0" ~sublibs:["mirage"] "tls" ;
package "mirage-flow-lwt";
package "mirage-kv-lwt";
package "mirage-clock";
package ~min:"3.0.1" "mirage-conduit" ;
package ~min:"0.9.2" ~max:"0.10.0" ~sublibs:["mirage"] "tls" ;
pkg
]
method! deps = [ abstract nocrypto ]
method! connect _ _ _ = "Lwt.return Conduit_mirage.with_tls"
2 changes: 2 additions & 0 deletions lib/mirage_impl_conduit_connector.mli
Original file line number Diff line number Diff line change
@@ -4,3 +4,5 @@ val tcp_conduit_connector :
(Mirage_impl_stackv4.stackv4 -> conduit_connector) Functoria.impl

val tls_conduit_connector : conduit_connector Functoria.impl

val pkg : Functoria.package
9 changes: 6 additions & 3 deletions lib/mirage_impl_console.ml
Original file line number Diff line number Diff line change
@@ -11,7 +11,8 @@ let console_unix str = impl @@ object
val name = Name.ocamlify @@ "console_unix_" ^ str
method name = name
method module_name = "Console_unix"
method! packages = Key.pure [ package ~min:"2.2.0" "mirage-console-unix" ]
method! packages =
Key.pure [ package ~min:"2.2.0" ~max:"3.0.0" "mirage-console-unix" ]
method! connect _ modname _args = Fmt.strf "%s.connect %S" modname str
end

@@ -21,7 +22,8 @@ let console_xen str = impl @@ object
val name = Name.ocamlify @@ "console_xen_" ^ str
method name = name
method module_name = "Console_xen"
method! packages = Key.pure [ package ~min:"2.2.0" "mirage-console-xen" ]
method! packages =
Key.pure [ package ~min:"2.2.0" ~max:"3.0.0" "mirage-console-xen" ]
method! connect _ modname _args = Fmt.strf "%s.connect %S" modname str
end

@@ -31,7 +33,8 @@ let console_solo5 str = impl @@ object
val name = Name.ocamlify @@ "console_solo5_" ^ str
method name = name
method module_name = "Console_solo5"
method! packages = Key.pure [ package ~min:"0.3.0" "mirage-console-solo5" ]
method! packages =
Key.pure [ package ~min:"0.3.0" ~max:"0.4.0" "mirage-console-solo5" ]
method! connect _ modname _args = Fmt.strf "%s.connect %S" modname str
end

3 changes: 2 additions & 1 deletion lib/mirage_impl_ethernet.ml
Original file line number Diff line number Diff line change
@@ -11,7 +11,8 @@ let ethernet_conf = object
method ty = network @-> ethernet
method name = "ethif"
method module_name = "Ethif.Make"
method! packages = Key.pure [ package ~min:"3.5.0" ~sublibs:["ethif"] "tcpip" ]
method! packages =
Key.pure [ package ~min:"3.5.0" ~max:"3.6.0" ~sublibs:["ethif"] "tcpip" ]
method! connect _ modname = function
| [ eth ] -> Fmt.strf "%s.connect %s" modname eth
| _ -> failwith (connect_err "ethernet" 1)
Loading