initial version

Author: palmskog

.gitignore

@@ -0,0 +1,2 @@
+_build
+verdi-runtime.install

CHANGES.md

@@ -0,0 +1,25 @@
+Copyright (c) 2014-2017, Verdi Team
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

LICENSE.md

@@ -0,0 +1 @@
+Verdi framework runtime library

README.md

@@ -0,0 +1 @@
+true : bin_annot

_tags

@@ -0,0 +1,17 @@
+opam-version: "1.2"
+version: "1.0"
+maintainer: "[email protected]"
+homepage: "https://github.com/DistributedComponents/verdi-runtime"
+dev-repo: "https://github.com/DistributedComponents/verdi-runtime.git"
+bug-reports: "https://github.com/DistributedComponents/verdi-runtime/issues"
+authors: ["James Wilcox <>" "Doug Woos <>" "Steve Anton <>" "Karl Palmskog <>" "Ryan Doenges <>"]
+available: [ ocaml-version >= "4.02.3"]
+license: "BSD"
+depends: [
+  "ocamlfind" {build}
+  "ocamlbuild" {build}
+  "topkg" {build} ]
+build: [
+  "ocaml" "pkg/pkg.ml" "build"
+          "--pinned" "%{pinned}%" 
+]

opam

@@ -0,0 +1,8 @@
+version = "%%VERSION%%"
+description = "Verdi framework runtime library"
+requires = "unix str"
+archive(byte) = "verdi_runtime.cma"
+archive(byte, plugin) = "verdi_runtime.cma"
+archive(native) = "verdi_runtime.cmxa"
+archive(native, plugin) = "verdi_runtime.cmxs"
+exists_if = "verdi_runtime.cma"

pkg/META

@@ -0,0 +1,16 @@
+#!/usr/bin/env ocaml
+#use "topfind";;
+#require "topkg"
+open Topkg
+
+let () =
+  Pkg.describe "verdi-runtime" @@ fun c ->
+    Ok [ Pkg.lib "src/Util.cmi";
+	 Pkg.lib "src/Opts.cmi";
+	 Pkg.lib "src/Daemon.cmi";
+	 Pkg.lib "src/Shim.cmi";
+	 Pkg.lib "src/OrderedShim.cmi";
+	 Pkg.lib "src/verdi_runtime.a";
+	 Pkg.lib "src/verdi_runtime.cma";
+	 Pkg.lib "src/verdi_runtime.cmxa";
+	 Pkg.lib "src/verdi_runtime.cmxs" ]

pkg/pkg.ml

@@ -0,0 +1,52 @@
+type ('env, 'state) task  = 
+  { fd : Unix.file_descr
+  ; mutable select_on : bool
+  ; mutable wake_time : float option
+  ; mutable process_read : ('env, 'state) task -> 'env -> 'state -> bool * ('env, 'state) task list * 'state
+  ; mutable process_wake : ('env, 'state) task -> 'env -> 'state -> bool * ('env, 'state) task list * 'state
+  ; finalize : ('env, 'state) task -> 'env -> 'state -> 'state
+  }
+
+let process process_f t hts env state =
+  let state = ref state in
+  let (finished, ts, state') = process_f t env !state in
+  state := state';
+  if finished then begin 
+    Hashtbl.remove hts t.fd; 
+    state := t.finalize t env !state 
+  end;
+  List.iter (fun t' -> Hashtbl.add hts t'.fd t') ts;
+  !state
+
+let rec eloop default_timeout old_timestamp hts env state =
+  let state = ref state in
+  let (select_fds, min_timeout) = 
+    Hashtbl.fold
+      (fun fd t (fds, timeout) ->
+	let fds' = if t.select_on then fd :: fds else fds in
+	let timeout' =
+	  match t.wake_time with
+	  | None -> timeout
+	  | Some wake_time -> min timeout wake_time 
+	in (fds', timeout'))
+      hts ([], default_timeout) in
+  let (ready_fds, _, _) = Util.select_unintr select_fds [] [] min_timeout in
+  List.iter
+    (fun fd -> 
+      let t = Hashtbl.find hts fd in 
+      state := process t.process_read t hts env !state) ready_fds;
+  let new_timestamp = Unix.gettimeofday () in
+  let elapsed_time = new_timestamp -. old_timestamp in
+  let wake_tasks =
+    Hashtbl.fold
+      (fun fd t ts ->
+	match t.wake_time with
+	| None -> ts
+	| Some wake_time ->
+	  if elapsed_time >= wake_time then
+	    t :: ts
+	  else
+	    (t.wake_time <- Some (wake_time -. elapsed_time); ts))
+      hts [] in
+  List.iter (fun t -> state := process t.process_wake t hts env !state) wake_tasks;
+  eloop default_timeout new_timestamp hts env !state

src/Daemon.ml

@@ -0,0 +1,10 @@
+type ('env, 'state) task  = 
+  { fd : Unix.file_descr
+  ; mutable select_on : bool
+  ; mutable wake_time : float option
+  ; mutable process_read : ('env, 'state) task -> 'env -> 'state -> bool * ('env, 'state) task list * 'state
+  ; mutable process_wake : ('env, 'state) task -> 'env -> 'state -> bool * ('env, 'state) task list * 'state
+  ; finalize : ('env, 'state) task -> 'env -> 'state -> 'state
+  }
+
+val eloop : float -> float -> (Unix.file_descr, ('a, 'b) task) Hashtbl.t -> 'a -> 'b -> 'c

src/Daemon.mli

@@ -0,0 +1,49 @@
+open List
+open Printf
+open Str
+
+let cluster_default = []
+let me_default = -1
+let port_default = 8351
+let dbpath_default = "/var/lib/vard"
+let debug_default = false
+
+let cluster = ref cluster_default
+let me = ref me_default
+let port = ref port_default
+let dbpath = ref dbpath_default
+let debug = ref debug_default
+
+let node_spec arg nodes_ref doc =
+  let parse opt =
+    (* name,ip:port *)
+    if string_match (regexp "\\([0-9]+\\),\\(.+\\):\\([0-9]+\\)") opt 0 then
+      (int_of_string (matched_group 1 opt),
+       (matched_group 2 opt, int_of_string (matched_group 3 opt)))
+    else
+      raise (Arg.Bad (sprintf "wrong argument: '%s'; option '%s' expects an address in the form 'name,host:port'" arg opt))
+  in (arg, Arg.String (fun opt -> nodes_ref := !nodes_ref @ [parse opt]), doc)
+
+let parse inp =
+  let opts =
+    [ node_spec "-node" cluster "{name,host:port} one node in the cluster"
+    ; ("-me", Arg.Set_int me, "{name} name for this node")
+    ; ("-port", Arg.Set_int port, "{port} port for client commands")
+    ; ("-dbpath", Arg.Set_string dbpath, "{path} directory for storing database files")
+    ; ("-debug", Arg.Set debug, "run in debug mode")
+    ] in  
+   Arg.parse_argv ?current:(Some (ref 0)) inp
+    opts
+    (fun x -> raise (Arg.Bad (sprintf "%s does not take position arguments" inp.(0))))
+    "Try -help for help or one of the following."
+
+let validate () =
+  if length !cluster == 0 then begin
+    raise (Arg.Bad "Please specify at least one -node")
+  end;
+  if !me == me_default then begin
+    raise (Arg.Bad "Please specify the node name -me")
+  end;
+  if not (mem_assoc !me !cluster) then begin
+    raise (Arg.Bad (sprintf "%d is not a member of this cluster" !me))
+  end

src/Opts.ml

@@ -0,0 +1,23 @@
+val cluster_default : (int * (string * int)) list
+
+val me_default : int
+
+val port_default : int
+
+val dbpath_default : string
+
+val debug_default : bool
+
+val cluster : (int * (string * int)) list ref
+
+val me : int ref
+
+val port : int ref
+
+val dbpath : string ref
+
+val debug : bool ref
+
+val parse : string array -> unit
+
+val validate : unit -> unit