Tag Archives: ocaml

Why is virt-builder written in OCaml?

Docker is written in Go. virt-builder is written in OCaml. Why? (Or as someone at work asked me — apparently seriously — why did you write it in a language which only you can use?)

Virt-builder is a fairly thin wrapper around libguestfs and libguestfs has bindings for a dozen languages, and I’m pretty handy in most programming languages, so it could have been done in Python or C or even Go. In this case there are reasons why OCaml is a much better choice:

  • It’s a language I’m familiar with and happy programming in. Never underestimate how much that matters.
  • OCaml is strongly typed, helping to eliminate many errors. If it had been written in Python we’d be running into bugs at customer sites that could have been eliminated by the compiler before anything shipped. That doesn’t mean virt-builder is bug free, but if the compiler can help to remove a bug, why not have the compiler do that?
  • Virt-builder has to be fast, and OCaml is fast. Python is fucking slow.
  • I had some C code for doing parallel xzcat and with OCaml I can just link the C code and the OCaml code together directly into a single native binary. Literally you just mix C object files and OCaml object files together on the linker command line. Doing this in, say, Perl/Python/Ruby would be far more hassle. We would have ended up with either a slow interpreted implementation, or having to ship a separate .so file and have the virt-builder program find it and dynamically load it. Ugh.
  • There was a little bit of common code used by another utility called virt-sysprep which started out as a shell script but is now also written in OCaml. Virt-sysprep regularly gets outside contributions, despite being written in OCaml. I could have written the small amount of common code in C to get around this, but every little helps.

Is OCaml a language that only I can understand? Judge for yourself by looking at the source code. I think if you cannot understand that enough to at least make small changes, you should hand in your programmer’s card at the door.

Edit: Hacker News discussion of this article.


Filed under Uncategorized

Goaljobs, part 4

In part 3 I described how to write targets which can access network resources, and how to use memoization to make them run fast. In this (last) part of the series, I’ll describe the final feature of goaljobs — periodic jobs.

If you wanted to use make to monitor a git repository and do a build when a new commit appears there would I guess be three choices: You could just run the make command manually over and over again. You could have a git hook that runs make. Or you have a cron job the periodically checks the git repository.

The git hook is the ideal solution for goaljobs too, but goaljobs also has cron-like periodic jobs built in, and they are very easy to use:

every 30 minutes (fun () ->
  let commit =
    shout "cd %s && git rev-parse HEAD" repo in
  require (git_commit_tested commit)

every 30 minutes is self-explanatory (right?). The function that runs every half-an-hour is two lines of code. The first line uses shout to run a shell command and capture the output. In this case git prints the current commit. The second command requires that the git_commit_tested goal is reached for this commit.

One way to implement this goal would be:

let goal git_commit_tested commit =
  let key = sprintf "repo-tested-%s" commit in
  target (memory_exists key);

  sh "
      git clone %s test
      cd test
      make check
  " repo_url;

  memory_set key "1"

This code clones the repository and runs make check to test it. It uses the Memory (ie. memoization) to ensure that the tests are run at most once per commit.

Actually this is not quite true: the tests run successfully once, but if the test fails, it will keep running every 30 minutes and nag you about it. It’s trivial to change the memoization to remember failures as well as successes, or you could consider the repeated nagging to be a feature not a bug …

That’s it! The goaljobs website will be this (I’ve not uploaded it yet, but will do in the next day or two):


You can also download the code from the git repository and the goals I’ve written from this repository.

Leave a comment

Filed under Uncategorized

Goaljobs, part 3

In part 2 I introduced an example goaljobs script that can rebuild a set of packages in Fedora in the right order.

It’s time to take a closer look at targets — the promise that you make that some condition will be true by the time a goal has run.

In the Fedora rebuild script the goal targets looked like this:

let goal rebuilt pkg =
  target (koji_build_state (fedora_verrel pkg branch)
               == `Complete);

koji_build_state is a regular function. It’s implemented using the koji buildinfo command line tool for querying the Koji build system. (The koji command line tool is annoyingly hard to automate, but as we’ve got a complete programming language available — not just bash — the implementation of koji_build_state is tedious and long, but doable).

Querying Koji takes a few seconds and we don’t want to do it every time we check a goal. Goaljobs offers a feature called “The Memory” which lets you memoize functions. “The Memory” is just a fancy name for a key/value store which is kept in ~/.goaljobs-memory and persists across goaljobs sessions:

let koji_build_state verrel =
  let key = sprintf "koji_build_complete_%s" verrel in
  if memory_exists key then
  else (
    (* tedious code to query koji *)
    if state == `Complete then
      memory_set key "1";

With strategic use of memoization, evaluating goaljobs goals can be very fast and doesn’t change the fundamental contract of targets.

Finally in this part: a note on how targets are implemented.

A target is a boolean expression which is evaluated once near the beginning of the goal. If it evaluates to true at the beginning of the goal then the rest of the goal can be skipped because the goal has already been achieved / doesn’t need to be repeated.

And since targets are just general expressions, they can be anything at all, from accessing a remote server (as here) to checking the existence of a local file (like make). As long as something can be tested quickly, or can be tested slowly and memoized, it’s suitable to be a target.

1 Comment

Filed under Uncategorized

Goaljobs, part 2

In part 1 I showed how a simple make rule could be converted to a special “goal” function and I hinted that we were not limited to just the “file is older than” semantics implicit in make.

So let’s have a look at the goals I wrote to automate the recent OCaml rebuild in Fedora.

Recall from part 1: Targets are a contractual promise that you make in goaljobs. They are a promise that some condition will be true after running the goal. Requirements are conditions that must be true before the goal can start running.

For a Fedora package to achieve the goal of being rebuilt, the target is that the Koji build state of the current release must be “Completed”. The requirements are that every dependency of the package has been rebuilt. So:

let goal rebuilt pkg =
  target (koji_build_state (fedora_verrel pkg branch)
               == `Complete);

  (* Require the rebuild to have started: *)
  require (rebuild_started pkg);

  ... some code to wait for the build to finish ...

The above code is not complete (it’s a complex, real-world working example after all).

I split the rebuilt goal into two separate goals for reasons that will become clear later. But the first goal above says that the package rebuild must have been started off, and we’ll wait for the package build to complete.

Note that once the build is complete, the target promise is true.

The subgoal rebuild_started is defined like this:

let goal rebuild_started pkg =
  (* The dependencies of this package: *)
  let deps = List.assoc pkg pkg_deps in

  target (
     match koji_build_state (fedora_verrel pkg branch) with
          | `Building | `Complete -> true
          | _ -> false

  (* All dependent packages must have been fully rebuilt: *)
  List.iter (fun dep -> require (rebuilt dep)) deps;

  (* Rebuild the package in Koji. *)
  koji_build pkg branch

It’s saying that the target (promise) will be that the Koji package will either be building or may even be complete. And that we first of all require that every build dependency of this package has been completely, successfully rebuilt. If those requirements are met, we tell Koji to start building the package (but in this goal we don’t need to wait for it to complete).

Why did I split the goal into two parts?

The reason is that I want to define a make-like all goal:

let goal all () =
  List.iter (fun pkg -> require (rebuild_started pkg))

This iterates over all my source packages and starts rebuilding them.

Note it doesn’t wait for each one to be rebuilt … unless they are required as dependencies of another package, in which case the require (rebuilt dep) will kick in and wait for them before rebuilding the dependent package.

In other words, this code automatically resolves dependencies, waiting where necessary, but otherwise just kicking off builds, which is exactly what I wanted.

Finally a bit about how you use a goaljobs script. Unlike make you have to compile the script into a binary. To compile the script, use the convenient wrapper goaljobs (it’s a simple shell script that invokes the OCaml compiler):

goaljobs fedora_ocaml_rebuild.ml

This makes a binary called fedora_ocaml_rebuild which is the program for mass-rebuilding the whole of Fedora’s OCaml subset.

When you run it with no arguments, it searches for a goal called all and “requires” that goal (just like make).

You can also run other goals directly. Any goal which is “published” can be run from the command line. All goals that have no parameters — such as all — are published automatically.

For goals that take parameters, if you want to use them from the command line you have to publish them manually. The reason is that you have to provide a small code snippet to convert the command line parameters to goal parameters, which may involve type conversion or other checks (since OCaml is strongly typed and parameters can be any type, not just strings or filenames).

1 Comment

Filed under Uncategorized

Goaljobs, part 1

A little more than a year ago I released whenjobs which was an attempt to create a practical language for automating complex “business rules”. The kind of thing I’m talking about is managing the many diverse steps between me tagging a libguestfs commit with a version number and a fully tested tarball appearing on the website. Or the hundreds of steps that go into 100 OCaml packages being updated and rebuilt for Rawhide.

Whenjobs wasn’t the right answer. Goaljobs [very early alpha] might possibly be.

What I need is something which is flexible, can deal with failures (both hard and intermittent), and can be killed and restarted at any point.

The first observation is that make is nearly the right tool. It’s goal-based, meaning that you set down a target that you want to have happen, and some rules to make that happen, and this lets you break down a problem from the larger goal (“build my program!”) to smaller subgoals (“compile this source file”).

program: main.o utils.o
  cc $^ -o $@

The goal is “program is built”. There are some requirements (main.o, utils.o), and there’s a recipe (run cc). You can also kill make in the middle and restart it, and it’ll usually continue from where it left off.

Make also lets you parameterize goals, although only in very simple ways:

%.o: %.c
  cc -c $< -o $@

Implicit in the “:” (colon) character is make’s one simple rule, which is roughly this: “if the target file doesn’t exist, or the prerequisite files are newer than the target, run the recipe below”.

In fact you could translate the first make rule into an ordinary function which would look something like this:

function build_program ()
  if (!file_exists ("program") ||
      file_older ("program", "main.o") ||
      file_older ("program", "utils.o")) {
    shell ("cc -c %s -o %s", "main.o utils.o",

Some points arise here:

  • Why can’t we change the target test to something other than “file exists or is newer”?
    How about “remote URL exists” (and if not, we need to upload a file)?
    How about “Koji build completed successfully” (and if not we need to do a Fedora build)?
  • What could happen if we could add parameters to build_program?

Goaljobs attempts to answer these questions by turning make-style rules into “goals”, where goals are specialized functions similar to the one above that have a target, requirement(s), a recipe to implement them, and any number of parameters.

For example, a “compile *.c to *.o” goal looks like this:

let goal compiled c_file =
  (* convert c_file "foo.c" -> "foo.o": *)
  let o_file = change_file_extension "o" c_file in

  target (more_recent [o_file] [c_file]);

  sh "
    cd $builddir
    cc -c %s -o %s
  " c_file o_file

The goal is called compiled and it has exactly one parameter, the name of the C source file that must be compiled.

The target is a promise that after the recipe has been run the *.o file will be more recent than the *.c file. The target is both a check used to skip the rule if it’s already true, but also a contractual promise that the developer makes (and which is checked by goaljobs) that some condition holds true at the end of the goal.

sh is a lightweight way to run a shell script fragment, with printf-like semantics.

And the whole thing is wrapped in a proper programming language (preprocessed OCaml) so you can do things which are more complicated than are easily done in shell.


Filed under Uncategorized

OCaml 4.01.0 entering Rawhide

After using OCaml for around 10 years it is still my favourite language, and it’s amazing how far ahead of other programming languages it remains to this day.

OCaml 4.01.0 was released on Thursday and I’m putting it into Fedora Rawhide over this weekend.

Debuginfo is now (partially) enabled. The OCaml code generator has produced good quality DWARF information for a while, and now you are able to debug OCaml programs in gdb under Fedora:

$ sudo debuginfo-install ocaml ocaml-findlib
$ gdb /usr/bin/ocamlfind
Reading symbols from /usr/bin/ocamlfind...
Reading symbols from /usr/lib/debug/usr/bin/ocamlfind.debug...done.
(gdb) break frontend.ml:469
Breakpoint 1 at 0x432500: file frontend.ml, line 469.
(gdb) run query findlib -l
Starting program: /usr/bin/ocamlfind query findlib -l

Breakpoint 1, camlFrontend__query_package_1199 () at frontend.ml:469
469	let query_package () =
(gdb) bt
#0  camlFrontend__query_package_1199 () at frontend.ml:469
#1  0x000000000043a4b4 in camlFrontend__main_1670 () at frontend.ml:2231
#2  0x000000000043aa86 in camlFrontend__entry () at frontend.ml:2283
#3  0x000000000042adc9 in caml_program ()
#4  0x00000000004834be in caml_start_program ()
#5  0x000000000048365d in __libc_csu_init ()
#6  0x0000003979821b75 in __libc_start_main (main=0x42aa60 <main>, argc=4, 
    ubp_av=0x7fffffffde38, init=<optimized out>, fini=<optimized out>, 
    rtld_fini=<optimized out>, stack_end=0x7fffffffde28) at libc-start.c:258
#7  0x000000000042aaa9 in _start ()
(gdb) list
464	;;
467	(************************** QUERY SUBCOMMAND ***************************)
469	let query_package () =
471	  let long_format =
472	    "package:     %p\ndescription: %D\nversion:     %v\narchive(s):  %A\nlinkopts:    %O\nlocation:    %d\n" in
473	  let i_format =

GDB only understands location data at the moment, so you can’t yet query variables (although I understand OCaml generates the correct DWARF info for this, GDB just doesn’t know how to print OCaml expressions).

There will also be some limitations on the debuginfo built at first. At the moment it doesn’t include debuginfo for OCaml libraries called from an OCaml program, because of problems that need to be worked out with the toolchain. Mixed OCaml binary / C library debuginfo does work.


Filed under Uncategorized

More static analysis with CIL

Years ago I played around with CIL to analyze libvirt. More recently Dan used CIL to analyze libvirt’s locking code.

We didn’t get so far either time, but I’ve been taking a deeper look at CIL in an attempt to verify error handling in libguestfs.

Here is my partly working code so far.

 * Analyse libguestfs APIs to find error overwriting.
 * Copyright (C) 2008-2013 Red Hat, Inc.
 * This library 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; either
 * version 2.1 of the License, or (at your option) any later version.
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * Lesser General Public License for more details.
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library.  If not, see
 * <http://www.gnu.org/licenses/>.
 * Author: Daniel P. Berrange <berrange@redhat.com>
 * Author: Richard W.M. Jones <rjones@redhat.com>

open Unix
open Printf

open Cil

let debug = ref false

(* Set of ints. *)
module IntSet = Set.Make (struct type t = int let compare = compare end)

(* A module for storing any set (unordered list) of functions. *)
module FunctionSet = Set.Make (
    type t = varinfo
    let compare v1 v2 = compare v1.vid v2.vid

(* Directed graph of functions.
 * Function = a node in the graph
 * FunctionDigraph = the directed graph
 * FunctionPathChecker = path checker module using Dijkstra's algorithm
module Function =
  type t = varinfo
  let compare f1 f2 = compare f1.vid f2.vid
  let hash f = Hashtbl.hash f.vid
  let equal f1 f2 = f1.vid = f2.vid
module FunctionDigraph = Graph.Imperative.Digraph.Concrete (Function)
module FunctionPathChecker = Graph.Path.Check (FunctionDigraph)

(* Module used to analyze the paths through each function. *)
module ErrorCounter =
  let name = "ErrorCounter"
  let debug = debug

  (* Our current state is very simple, just the number of error
   * function calls did encountered up to this statement.
  type t = int

  let copy errcalls = errcalls

  (* Start data for each statement. *)
  let stmtStartData = Inthash.create 97

  let printable errcalls = sprintf "(errcalls=%d)" errcalls

  let pretty () t = Pretty.text (printable t)

  let computeFirstPredecessor stmt x = x (* XXX??? *)

  let combinePredecessors stmt ~old:old_t new_t =
    if old_t = new_t then None
    else Some new_t

  (* This will be initialized after we have calculated the set of all
   * functions which can call an error function, in main() below.
  let error_functions_set = ref FunctionSet.empty

  (* Handle a Cil.Instr. *)
  let doInstr instr _ =
    match instr with
    (* A call to an error function. *)
    | Call (_, Lval (Var callee, _), _, _)
        when FunctionSet.mem callee !error_functions_set ->
      Dataflow.Post (fun errcalls -> errcalls+1)

    | _ -> Dataflow.Default

  (* Handle a Cil.Stmt. *)
  let doStmt _ _ = Dataflow.SDefault

  (* Handle a Cil.Guard. *)
  let doGuard _ _ = Dataflow.GDefault

  (* Filter statements we've seen already to prevent loops. *)
  let filter_set = ref IntSet.empty
  let filterStmt { sid = sid } =
    if IntSet.mem sid !filter_set then false
    else (
      filter_set := IntSet.add sid !filter_set;

  (* Initialize the module before each function that we examine. *)
  let init stmts =
    filter_set := IntSet.empty;
    Inthash.clear stmtStartData;
    (* Add the initial statement(s) to the hash. *)
    List.iter (fun stmt -> Inthash.add stmtStartData stmt.sid 0) stmts

module ForwardsErrorCounter = Dataflow.ForwardsDataFlow (ErrorCounter)

(* The always useful filter + map function. *)
let rec filter_map f = function
  | [] -> []
  | x :: xs ->
      match f x with
      | Some y -> y :: filter_map f xs
      | None -> filter_map f xs

let rec main () =
  (* Read the list of input C files. *)
  let files =
    let chan = open_process_in "find src -name '*.i' | sort" in
    let files = input_chan chan in
    if close_process_in chan <> WEXITED 0 then
      failwith "failed to read input list of files";
    if files = [] then
      failwith "no input files; is the program running from the top directory? did you compile with make -C src CFLAGS=\"-save-temps\"?";
    files in

  (* Load and parse each input file. *)
  let files =
    List.map (
      fun filename ->
        printf "loading %s\n%!" filename;
        Frontc.parse filename ()
    ) files in

  (* Merge the files. *)
  printf "merging files\n%!";
  let sourcecode = Mergecil.merge files "libguestfs" in

  (* CFG analysis. *)
  printf "computing control flow\n%!";
  Cfg.computeFileCFG sourcecode;

  let functions =
    filter_map (function GFun (f, loc) -> Some (f, loc) | _ -> None)
      sourcecode.globals in

  (* Examine which functions directly call which other functions. *)
  printf "computing call graph\n%!";
  let call_graph = make_call_graph functions in
  FunctionDigraph.iter_edges (
    fun caller callee ->
      printf "%s calls %s\n" caller.vname callee.vname
  ) call_graph;

  (* The libguestfs error functions.  These are global function names,
   * but to be any use to us we have to look these up in the list of
   * all global functions (ie. 'functions') and turn them into the
   * corresponding varinfo structures.
  let error_function_names = [ "guestfs_error_errno";
                               "guestfs_perrorf" ] in

  let find_function name =
    try List.find (fun ({ svar = { vname = n }}, _) -> n = name) functions
    with Not_found -> failwith ("function '" ^ name ^ "' does not exist")
  let error_function_names = List.map (
    fun f -> (fst (find_function f)).svar
  ) error_function_names in

  (* Get a list of functions that might (directly or indirectly) call
   * one of the error functions.
  let error_functions, non_error_functions =
    functions_which_call call_graph error_function_names functions in

  List.iter (
    fun f -> printf "%s can call an error function\n" f.vname
  ) error_functions;

  List.iter (
    fun f -> printf "%s can NOT call an error function\n" f.vname
  ) non_error_functions;

  (* Save the list of error functions in a global set for fast lookups. *)
  let set =
    List.fold_left (
      fun set elt -> FunctionSet.add elt set
    ) FunctionSet.empty error_functions in
  ErrorCounter.error_functions_set := set;

  (* Analyze each top-level function to ensure it calls an error
   * function exactly once on error paths, and never on normal return
   * paths.
  printf "analyzing correctness of error paths\n%!";
  List.iter compute_error_paths functions;


(* Make a directed graph of which functions directly call which other
 * functions.
and make_call_graph functions =
  let graph = FunctionDigraph.create () in

  List.iter (
    fun ({ svar = caller; sallstmts = sallstmts }, _) ->
      (* Evaluate which other functions 'caller' calls.  First pull
       * out every 'Call' instruction anywhere in the function.
      let insns =  List.concat (
        filter_map (
          | { skind = Instr insns } -> Some insns
          | _ -> None
        ) sallstmts
      ) in
      let calls = List.filter (function Call _ -> true | _ -> false) insns in
      (* Then examine what function is being called at each place. *)
      let callees = filter_map (
        | Call (_, Lval (Var callee, _), _, _) -> Some callee
        | _ -> None
      ) calls in

      List.iter (
        fun callee ->
          FunctionDigraph.add_edge graph caller callee
      ) callees
  ) functions;


(* [functions_which_call g endpoints functions] partitions the
 * [functions] list, returning those functions that call directly or
 * indirectly one of the functions in [endpoints], and a separate list
 * of functions which do not.  [g] is the direct call graph.
and functions_which_call g endpoints functions =
  let functions = List.map (fun ({ svar = svar }, _) -> svar) functions in

  let checker = FunctionPathChecker.create g in
  List.partition (
    fun f ->
      (* Does a path exist from f to any of the endpoints? *)
      List.exists (
        fun endpoint ->
          try FunctionPathChecker.check_path checker f endpoint
          (* It appears safe to ignore this exception.  It seems to
           * mean that this function is in a part of the graph which
           * is completely disconnected from the other part of the graph
           * that contains the endpoint.
          | Invalid_argument "[ocamlgraph] iter_succ" -> false
      ) endpoints
  ) functions

and compute_error_paths ({ svar = svar } as f, loc) =
  (*ErrorCounter.debug := true;*)

  (* Find the initial statement in this function (assumes that the
   * function can only be entered in one place, which is normal for C
   * functions).
  let initial_stmts =
    match f.sbody.bstmts with
    | [] -> []
    | first::_ -> [first] in

  (* Initialize ErrorCounter. *)
  ErrorCounter.init initial_stmts;

  (* Compute the error counters along paths through the function. *)
  ForwardsErrorCounter.compute initial_stmts;

  (* Process all Return statements in this function. *)
  List.iter (
    fun stmt ->
        let errcalls = Inthash.find ErrorCounter.stmtStartData stmt.sid in

        match stmt with
        (* return -1; *)
        | { skind = Return (Some i, loc) } when is_literal_minus_one i ->
          if errcalls = 0 then
            printf "%s:%d: %s: may return an error code without calling error/perrorf\n"
              loc.file loc.line svar.vname
          else if errcalls > 1 then
            printf "%s:%d: %s: may call error/perrorf %d times (more than once) along an error path\n"
          loc.file loc.line svar.vname errcalls

        (* return 0; *)
        | { skind = Return (Some i, loc) } when is_literal_zero i ->
          if errcalls >= 1 then
            printf "%s:%d: %s: may call error/perrorf along a non-error return path\n"
              loc.file loc.line svar.vname

        (* return; (void return) *)
        | { skind = Return (None, loc) } ->
          if errcalls >= 1 then
            printf "%s:%d: %s: may call error/perrorf and return void\n"
              loc.file loc.line svar.vname

        | _ -> ()

        Not_found ->
          printf "%s:%d: %s: may contain unreachable code\n"
            loc.file loc.line svar.vname
  ) f.sallstmts

(* Some convenience CIL matching functions. *)
and is_literal_minus_one = function
  | Const (CInt64 (-1L, _, _)) -> true
  | _ -> false

and is_literal_zero = function
  | Const (CInt64 (0L, _, _)) -> true
  | _ -> false

(* Convenient routine to load the contents of a channel into a list of
 * strings.
and input_chan chan =
  let lines = ref [] in
  try while true; do lines := input_line chan :: !lines done; []
  with End_of_file -> List.rev !lines

and input_file filename =
  let chan = open_in filename in
  let r = input_chan chan in
  close_in chan;

let () =
  try main ()
    exn ->
      prerr_endline (Printexc.to_string exn);
      Printexc.print_backtrace Pervasives.stderr;
      exit 1


Filed under Uncategorized