...
 
Commits (7)
......@@ -5,3 +5,5 @@
/src/lib/.merlin
/habust.install
/src/lib/jbuild
/src/examples/.merlin
/src/examples/jbuild
\ No newline at end of file
......@@ -9,3 +9,26 @@ Build locally:
ocaml configure.ml
jbuild build @install
Or to install it more globally:
opam pin add habust . -kgit
Test/Run
--------
`_build/default/src/app/main.exe` (installed as `habust`) is the main
application, see `--help`.
There are a few test examples that the
`_build/default/src/examples/main.exe` executable can output.
_build/default/src/examples/main.exe owrttpd > /tmp/owr.json
_build/default/src/app/main.exe -i /tmp/owr.json -o /tmp/habowr -S 10001
Generates a `/tmp/habowr` directory, with a “master” `Makefile`
(and a `_scripts/` directory), see:
make help
`make start` will download files into `./_cache/` before starting `qemu`;
`make run` when successful will put its results in `./_results/`.
......@@ -15,25 +15,48 @@ let main_libs = [
"nonstd";
"bos";
"genspio";
"yojson";
"atdgen";
]
let config_merlin = "S ." :: List.map main_libs ~f:(sprintf "PKG %s")
let main_jbuilder = [
";; Generated by `configure.ml`";
"(jbuild_version 1)";
sprintf
"(executable ((name main) (libraries (%s habust))))"
(String.concat main_libs ~sep:" ");
"(install ((section bin) (files ((main.exe as habust)))))";
]
let lib_jbuilder = [
let jbuild l = [
";; Generated by `configure.ml`";
"(jbuild_version 1)";
] @ l
let executable ~name ~libraries =
sprintf
"(library ((name habust) (libraries (%s)) (preprocess (pps (ppx_jane))) (public_name habust)))"
(String.concat main_libs ~sep:" ");
]
"(executable ((name %s) (libraries (%s))))" name
(String.concat libraries ~sep:" ")
let main_jbuilder = jbuild [
executable ~name:"main" ~libraries:("habust" :: main_libs);
"(install ((section bin) (files ((main.exe as habust)))))";
]
let atd_file = "build_format.atd"
let lib_jbuilder = jbuild [
sprintf "(rule (\
(targets (%s))\
(deps (%s))\
(action (progn %s))\
))"
(List.map ["_t.mli"; "_t.ml"; "_j.ml"; "_j.mli"]
~f:(strf "build_format%s")
|> String.concat ~sep:" ")
atd_file
(List.map ["-j-std -j-defaults -j"; "-t"]
~f:(fun opts -> strf "(run atdgen %s %s)" opts atd_file)
|> String.concat ~sep:" ");
sprintf
"(library ((name habust) (libraries (%s)) (public_name habust)))"
(String.concat main_libs ~sep:" ");
]
let examples_jbuilder =
jbuild [
executable ~name:"main" ~libraries:("habust" :: main_libs);
]
type file = {
path : string;
content : string list;
......@@ -44,6 +67,7 @@ let files = [
file ".merlin" config_merlin;
file "src/app/jbuild" main_jbuilder;
file "src/lib/jbuild" lib_jbuilder;
file "src/examples/jbuild" examples_jbuilder;
]
let cmdf fmt =
......
......@@ -11,8 +11,10 @@ build: [
["jbuilder" "build" "--only" "habust" "--root" "." "-j" jobs "@install"]
]
depends: [
"base"
"ppx_jane"
"nonstd"
"astring"
"bos"
"atdgen"
"jbuilder" {build}
"ocamlfind" {build}
]
\ No newline at end of file
......@@ -88,7 +88,7 @@ module Shell_script = struct
let rec compile ({name; content; dependencies} as s) =
let filename = path s in
let dep_scripts = List.map ~f:compile dependencies in
dbg "name %s filename: %s" name filename;
(* dbg "name %s filename: %s" name filename; *)
{
files =
(filename,
......@@ -144,7 +144,7 @@ module Prepare_environment = struct
let open Shell_script in
let open Genspio.EDSL in
let grouped_cmds =
let open Build_definition.Action in
let open Build_definition in
List.fold ~init:[] recipe ~f:begin fun prev act ->
match act, prev with
| Exec l, `Execs ll :: more -> `Execs (l :: ll) :: more
......@@ -191,7 +191,7 @@ module Prepare_environment = struct
let make ?(ssh_port = 10_000) =
let open Build_definition in
function
| {environment = Environment.Qemu (`Arm, `Openwrt); recipe} ->
| {environment = Qemu (Arm, Openwrt); recipe} ->
let setup =
let open Build_definition.Action in
[
......@@ -213,8 +213,7 @@ module Prepare_environment = struct
root_password = None;
run = compile_recipe ~ssh_port (setup @ recipe);
}
| {environment = Environment.Qemu (`Arm, `Debian_wheezy);
recipe} ->
| {environment = Qemu (Arm, Debian_wheezy); recipe} ->
(**
See {{:https://people.debian.org/~aurel32/qemu/armhf/}}.
*)
......@@ -368,7 +367,6 @@ module Prepare_environment = struct
let to_directory ~path =
function
| Qemu_ssh q as qemu ->
(* Bos.OS. *)
let open Rresult.R in
Bos.OS.Cmd.run Bos.Cmd.(v "mkdir" % "-p" % path)
>>= fun () ->
......@@ -383,38 +381,40 @@ module Prepare_environment = struct
end
let examples =
let open Habust in
[
10_001,
"/tmp/habust_qemu_arm_owrt",
Build_definition.{
environment = Environment.Qemu (`Arm, `Openwrt);
recipe = Action.[
Exec ["opkg"; "install"; "lighttpd"];
Get_file ("/usr/sbin/lighttpd", "lighttpd-armv7l-bin");
]
};
10_000,
"/tmp/habust_qemu_arm_debzy",
Build_definition.{
environment = Environment.Qemu (`Arm, `Debian_wheezy);
recipe = Action.[
Exec ["apt-get"; "update"];
Exec ["apt-get"; "install"; "--yes"; "emacs23"];
Get_file ("/usr/bin/emacs", "emacs-armv7l-bin");
]
}
]
let () =
let open Rresult.R in
List.fold ~init:(return ()) examples ~f:begin
fun prev (ssh_port, path, example) ->
prev >>= fun () ->
printf "Habust: In %s: %s\n%!"
path (Habust.Build_definition.to_string_hum example);
Prepare_environment.(make ~ssh_port example |> to_directory ~path)
begin
let open Bos.OS.Arg in
let path =
opt ["o"; "output-path"] (string)
~docv:"PATH"
~absent:"/tmp/habust"
~doc:"The output directory to generate."
in
let ssh_port =
opt ["S"; "ssh-port"] int
~docv:"PORT"
~absent:2022
~doc:"The SSH port to use to communicate with the VM."
in
let file_opt =
opt ["i"; "input"] (some string)
~docv:"PATH"
~absent:None
~doc:"The build-definition JSON file to parse (required)."
in
let () =
parse_opts ~doc:"The Habust generator" ~usage:"<args>" () in
let open Rresult.R in
let file =
Option.value_exn file_opt
~msg:"Option --input is actually required"
in
Bos.OS.File.read Fpath.(v file)
>>= fun file_contents ->
let def = Build_definition.deserialize_exn file_contents in
printf "Habust: In %s: %s\n%!"
path (Habust.Build_definition.to_string_hum def);
Prepare_environment.(make ~ssh_port def |> to_directory ~path)
end
|> begin function
| Ok () -> ()
......
open Nonstd
open Astring
open Habust
let (//) = Filename.concat
let dbg fmt = ksprintf (eprintf "Hadbg: %s\n%!") fmt
let examples =
[
"owrttpd",
Build_definition.{
environment = Environment.(qemu_arm openwrt);
recipe = Action.[
Exec ["opkg"; "install"; "lighttpd"];
Get_file ("/usr/sbin/lighttpd", "lighttpd-armv7l-bin");
]
};
"debzymacs",
Build_definition.{
environment = Environment.(qemu_arm debian_wheezy);
recipe = Action.[
Exec ["apt-get"; "update"];
Exec ["apt-get"; "install"; "--yes"; "emacs23"];
Get_file ("/usr/bin/emacs", "emacs-armv7l-bin");
]
}
]
let usage () =
printf "usage: %s {%s}\n%!" Sys.argv.(0)
(List.map examples ~f:(fun (n, _) -> n) |> String.concat ~sep:",");
()
let () =
match (Sys.argv |> Array.to_list |> List.tl_exn) with
| [] -> usage (); exit 0
| more ->
List.iter more ~f:begin fun affix ->
match
List.find examples ~f:(fun ex -> String.is_prefix ~affix (fst ex))
with
| Some (_, v) ->
let s = Build_definition.serialize v in
printf "%s\n%!" s
| None ->
usage ();
exit 1
end
open Nonstd
open Astring
include Build_format_t
module Environment = struct
type t =
| Qemu of [ `Arm ] * [ `Openwrt | `Debian_wheezy ]
type t = environment
let openwrt = Openwrt
let debian_wheezy = Debian_wheezy
let qemu_arm v = Qemu (Arm, v)
let to_string_hum =
function
| Qemu (_, _) -> "Qemu-arm-owrt"
| Qemu (_,Openwrt ) -> "Qemu-arm-owrt"
| Qemu (_,Debian_wheezy ) -> "Qemu-arm-debzy"
end
module Action = struct
type t =
| Exec of string list
| Get_file of string * string
type t = action
let to_string_hum =
function
| Exec l -> strf "exec: {%s}" (String.concat ~sep:" " l)
| Get_file (p, a) -> strf "get: '%s' as '%s'" p a
end
type t = {
environment: Environment.t;
recipe: Action.t list;
}
type t = build
let serialize: t -> string = Build_format_j.string_of_build
let deserialize_exn: string -> t = Build_format_j.build_of_string
let to_string_hum {environment; recipe} =
strf "On %s, [%s]"
......
type architecture = [ Arm ]
<ocaml repr="classic">
type operating_system = [ Openwrt | Debian_wheezy ]
<ocaml repr="classic">
type environment = [
| Qemu of (architecture * operating_system)
] <ocaml repr="classic">
type action = [
| Exec of string list
| Get_file of (string * string)
] <ocaml repr="classic">
type build = {
environment: environment;
recipe: action list;
}