albatrossd: on startup, back up state file, fixes #203

Author: hannesm

Diff for: daemon/albatrossd.ml

@@ -178,6 +178,11 @@ let jump _ systemd influx tmpdir dbdir =
   match Vmm_vmmd.restore_state () with
   | Error (`Msg msg) -> Logs.err (fun m -> m "bailing out: %s" msg)
   | Ok (old_unikernels, policies) ->
+    let file = "state.started" in
+    (match Vmm_unix.backup file with
+     | Ok () -> Logs.info (fun m -> m "backing up state to %s" file)
+     | Error `Msg msg -> Logs.err (fun m -> m "backing up state failed: %s" msg)
+     | Error `NoFile -> Logs.err (fun m -> m "backing up state failed - no file"));
     let policies, old_p = Vmm_trie.insert Name.root root_policy policies in
     Option.iter (fun p ->
         if not (Policy.equal p root_policy) then

Diff for: src/vmm_unix.ml

@@ -108,7 +108,7 @@ let close_no_err fd = try close fd with _ -> ()
 (* own code starts here
    (c) 2017, 2018 Hannes Mehnert, all rights reserved *)
 
-let dump, restore =
+let dump, restore, backup =
   let state_file ?(name = "state") () =
     if Fpath.is_seg name then
       Fpath.(!dbdir / name)
@@ -130,6 +130,15 @@ let dump, restore =
      let* exists = Bos.OS.File.exists state_file in
      if exists then
        Bos.OS.File.read state_file
+     else Error `NoFile),
+  (fun ?name backup ->
+     let state_file = state_file ?name ()
+     and backup = state_file ~name:backup ()
+     in
+     let* exists = Bos.OS.File.exists state_file in
+     if exists then
+       let cmd = Bos.Cmd.(v "cp" % p state_file % p backup) in
+       Bos.OS.Cmd.(run_out cmd |> out_null |> success)
      else Error `NoFile)
 
 let block_sub = "block"

Diff for: src/vmm_unix.mli

@@ -38,6 +38,8 @@ val dump : ?name:string -> string -> (unit, [> `Msg of string ]) result
 
 val restore : ?name:string -> unit -> (string, [> `Msg of string | `NoFile ]) result
 
+val backup : ?name:string -> string -> (unit, [> `Msg of string | `NoFile ]) result
+
 val unikernel_device : Unikernel.t -> (string, [> `Msg of string ]) result
 
 val manifest_devices_match : bridges:(string * string option * Macaddr.t option) list ->