make console command changes in respect to time backwards compatible

previously, an old client subscribed to a console, but then received
generalized_time timestamps (instead of utc_time).

now, this is cleaner: the old client will indicate that they need utc_time
timestamp.

discovered by @PizieDust

daemon/albatross_console.ml

@@ -27,9 +27,15 @@ let read_console id name ring fd =
         Vmm_ring.write ring (t, line) ;
         (match Vmm_core.String_map.find_opt name !active with
          | None -> Lwt.return_unit
-         | Some (version, fd) ->
+         | Some (version, utc, fd) ->
            let header = Vmm_commands.header ~version id in
-           Vmm_lwt.write_wire fd (header, `Data (`Console_data (t, line))) >>= function
+           let data =
+             if utc then
+               `Data (`Utc_console_data (t, line))
+             else
+               `Data (`Console_data (t, line))
+           in
+           Vmm_lwt.write_wire fd (header, data) >>= function
            | Error _ ->
              Vmm_lwt.safe_close fd >|= fun () ->
              active := Vmm_core.String_map.remove name !active
@@ -83,21 +89,21 @@ let add_fifo id =
     Lwt.async (fun () -> read_console id name ring f >|= fun () -> fifos `Close) ;
     Ok ()
 
-let subscribe s version id =
+let subscribe s version ~utc id =
   let name = Vmm_core.Name.to_string id in
   Logs.debug (fun m -> m "attempting to subscribe %a" Vmm_core.Name.pp id) ;
   match Vmm_core.String_map.find_opt name !t with
   | None ->
-    active := Vmm_core.String_map.add name (version, s) !active ;
+    active := Vmm_core.String_map.add name (version, utc, s) !active ;
     Lwt.return (None, "waiting for VM")
   | Some r ->
     (match Vmm_core.String_map.find_opt name !active with
      | None -> Lwt.return_unit
-     | Some (_, s) -> Vmm_lwt.safe_close s) >|= fun () ->
-    active := Vmm_core.String_map.add name (version, s) !active ;
+     | Some (_, _, s) -> Vmm_lwt.safe_close s) >|= fun () ->
+    active := Vmm_core.String_map.add name (version, utc, s) !active ;
     (Some r, "subscribed")
 
-let send_history s version r id since =
+let send_history s version ~utc r id since =
   let entries =
     match since with
     | `Count n -> Vmm_ring.read_last r n
@@ -106,7 +112,13 @@ let send_history s version r id since =
   Logs.debug (fun m -> m "%a found %d history" Vmm_core.Name.pp id (List.length entries)) ;
   Lwt_list.iter_s (fun (i, v) ->
       let header = Vmm_commands.header ~version id in
-      Vmm_lwt.write_wire s (header, `Data (`Console_data (i, v))) >>= function
+      let data =
+        if utc then
+          `Data (`Utc_console_data (i, v))
+        else
+          `Data (`Console_data (i, v))
+      in
+      Vmm_lwt.write_wire s (header, data) >>= function
       | Ok () -> Lwt.return_unit
       | Error _ -> Vmm_lwt.safe_close s)
     entries
@@ -135,16 +147,30 @@ let handle s addr =
             Logs.err (fun m -> m "error while writing") ;
             Lwt.return_unit
           end
+        | `Old_console_subscribe ts ->
+          begin
+            subscribe s header.Vmm_commands.version ~utc:true name >>= fun (ring, res) ->
+            Vmm_lwt.write_wire s (header, `Success (`String res)) >>= function
+            | Error _ -> Vmm_lwt.safe_close s
+            | Ok () ->
+              (match ring with
+               | None -> Lwt.return_unit
+               | Some r -> send_history s header.Vmm_commands.version ~utc:true r name ts) >>= fun () ->
+              (* now we wait for the next read and terminate*)
+              Vmm_lwt.read_wire s >|= fun _ -> ()
+          end
         | `Console_subscribe ts ->
-          subscribe s header.Vmm_commands.version name >>= fun (ring, res) ->
-          Vmm_lwt.write_wire s (header, `Success (`String res)) >>= function
-          | Error _ -> Vmm_lwt.safe_close s
-          | Ok () ->
-            (match ring with
-             | None -> Lwt.return_unit
-             | Some r -> send_history s header.Vmm_commands.version r name ts) >>= fun () ->
-            (* now we wait for the next read and terminate*)
-            Vmm_lwt.read_wire s >|= fun _ -> ()
+          begin
+            subscribe s header.Vmm_commands.version ~utc:false name >>= fun (ring, res) ->
+            Vmm_lwt.write_wire s (header, `Success (`String res)) >>= function
+            | Error _ -> Vmm_lwt.safe_close s
+            | Ok () ->
+              (match ring with
+               | None -> Lwt.return_unit
+               | Some r -> send_history s header.Vmm_commands.version ~utc:false r name ts) >>= fun () ->
+              (* now we wait for the next read and terminate*)
+              Vmm_lwt.read_wire s >|= fun _ -> ()
+          end
       end
     | Ok wire ->
       Logs.err (fun m -> m "unexpected wire %a"

src/vmm_asn.ml

@@ -139,20 +139,27 @@ let my_explicit : ?cls:Asn.S.cls -> int -> ?label:string -> 'a Asn.S.t -> 'a Asn
 let console_cmd =
   let f = function
     | `C1 () -> `Console_add
-    | `C2 `C1 (`C1 ts | `C2 ts) ->
-      `Console_subscribe (`Since ts)
-    | `C2 `C2 c -> `Console_subscribe (`Count c)
+    | `C2 `C1 ts -> `Old_console_subscribe (`Since ts)
+    | `C2 `C2 c -> `Old_console_subscribe (`Count c)
+    | `C3 `C1 ts -> `Console_subscribe (`Since ts)
+    | `C3 `C2 c -> `Console_subscribe (`Count c)
   and g = function
     | `Console_add -> `C1 ()
-    | `Console_subscribe `Since ts -> `C2 (`C1 (`C2 ts))
-    | `Console_subscribe `Count c -> `C2 (`C2 c)
+    | `Old_console_subscribe `Since ts -> `C2 (`C1 ts)
+    | `Old_console_subscribe `Count c -> `C2 (`C2 c)
+    | `Console_subscribe `Since ts -> `C3 (`C1 ts)
+    | `Console_subscribe `Count c -> `C3 (`C2 c)
   in
   Asn.S.map f g @@
-  Asn.S.(choice2
+  Asn.S.(choice3
            (my_explicit 0 ~label:"add" null)
-           (my_explicit 1 ~label:"subscribe"
+           (my_explicit 1 ~label:"old-subscribe"
               (choice2
-                 (my_explicit 0 ~label:"since" (choice2 utc_time generalized_time))
+                 (my_explicit 0 ~label:"since" utc_time)
+                 (my_explicit 1 ~label:"count" int)))
+           (my_explicit 2 ~label:"subscribe"
+              (choice2
+                 (my_explicit 0 ~label:"since" generalized_time)
                  (my_explicit 1 ~label:"count" int))))
 
 (* TODO is this good? *)
@@ -589,19 +596,20 @@ let wire_command =
 
 let data =
   let f = function
-    | `C1 ((`C1 timestamp | `C2 timestamp), data) ->
-      `Console_data (timestamp, data)
+    | `C1 (timestamp, data) -> `Utc_console_data (timestamp, data)
     | `C2 (ru, ifs, vmm, mem) -> `Stats_data (ru, mem, vmm, ifs)
     | `C3 () -> Asn.S.parse_error "support for log was dropped"
+    | `C4 (timestamp, data) -> `Console_data (timestamp, data)
   and g = function
-    | `Console_data (timestamp, data) -> `C1 (`C2 timestamp, data)
+    | `Utc_console_data (timestamp, data) -> `C1 (timestamp, data)
+    | `Console_data (timestamp, data) -> `C4 (timestamp, data)
     | `Stats_data (ru, mem, ifs, vmm) -> `C2 (ru, vmm, ifs, mem)
   in
   Asn.S.map f g @@
-  Asn.S.(choice3
-           (my_explicit 0 ~label:"console"
+  Asn.S.(choice4
+           (my_explicit 0 ~label:"utc-console"
               (sequence2
-                 (required ~label:"timestamp" (choice2 utc_time generalized_time))
+                 (required ~label:"timestamp" utc_time)
                  (required ~label:"data" utf8_string)))
            (my_explicit 1 ~label:"statistics"
               (sequence4
@@ -612,7 +620,11 @@ let data =
                                     (required ~label:"key" utf8_string)
                                     (required ~label:"value" int64))))
                  (optional ~label:"kinfo-mem" @@ implicit 1 kinfo_mem)))
-           (my_explicit 2 ~label:"log" null))
+           (my_explicit 2 ~label:"log" null)
+           (my_explicit 3 ~label:"console"
+              (sequence2
+                 (required ~label:"timestamp" generalized_time)
+                 (required ~label:"data" utf8_string))))
 
 let old_unikernel_info =
   let open Unikernel in

src/vmm_commands.ml

@@ -32,11 +32,13 @@ let pp_since_count ppf = function
 type console_cmd = [
   | `Console_add
   | `Console_subscribe of since_count
+  | `Old_console_subscribe of since_count
 ]
 
 let pp_console_cmd ppf = function
   | `Console_add -> Fmt.string ppf "console add"
   | `Console_subscribe ts -> Fmt.pf ppf "console subscribe %a" pp_since_count ts
+  | `Old_console_subscribe ts -> Fmt.pf ppf "console subscribe %a" pp_since_count ts
 
 type stats_cmd = [
   | `Stats_add of string * int * (string * string) list
@@ -130,12 +132,15 @@ let pp ~verbose ppf = function
 
 type data = [
   | `Console_data of Ptime.t * string
+  | `Utc_console_data of Ptime.t * string
   | `Stats_data of Stats.t
 ]
 
 let pp_data ppf = function
   | `Console_data (ts, line) ->
     Fmt.pf ppf "console %a: %s" (Ptime.pp_rfc3339 ()) ts line
+  | `Utc_console_data (ts, line) ->
+    Fmt.pf ppf "console %a: %s" (Ptime.pp_rfc3339 ()) ts line
   | `Stats_data stats -> Fmt.pf ppf "stats: %a" Stats.pp stats
 
 type header = {

src/vmm_commands.mli

@@ -20,6 +20,7 @@ type since_count = [ `Since of Ptime.t | `Count of int ]
 type console_cmd = [
   | `Console_add
   | `Console_subscribe of since_count
+  | `Old_console_subscribe of since_count
 ]
 
 type stats_cmd = [
@@ -67,6 +68,7 @@ val pp : verbose:bool -> t Fmt.t
 
 type data = [
   | `Console_data of Ptime.t * string
+  | `Utc_console_data of Ptime.t * string
   | `Stats_data of Stats.t
 ]
 

test/tests.ml

@@ -550,7 +550,7 @@ let console_subscribe_v4 () =
       (Vmm_commands.header ~version:`AV4 (n_o_s "foo"))
       hdr;
     match cmd with
-    | `Command `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Command `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console_subscribe, got %a"
              (Vmm_commands.pp_wire ~verbose:true) w
 
@@ -569,7 +569,7 @@ let console_subscribe_v4_2 () =
       (Vmm_commands.header ~version:`AV4 (n_o_s "foo.bar"))
       hdr;
     match cmd with
-    | `Command `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Command `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console_subscribe, got %a"
              (Vmm_commands.pp_wire ~verbose:true) w
 
@@ -588,7 +588,7 @@ let console_subscribe_v5 () =
       (Vmm_commands.header ~version:`AV5 (n_o_s "foo"))
       hdr;
     match cmd with
-    | `Command `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Command `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console_subscribe, got %a"
              (Vmm_commands.pp_wire ~verbose:true) w
 
@@ -607,7 +607,7 @@ let console_subscribe_v5_2 () =
       (Vmm_commands.header ~version:`AV5 (n_o_s "foo.bar"))
       hdr;
     match cmd with
-    | `Command `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Command `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console_subscribe, got %a"
              (Vmm_commands.pp_wire ~verbose:true) w
 
@@ -643,7 +643,7 @@ HUBeGB+KSdPOX8zc8taDCQ==
     Alcotest.check test_version "version is 4" `AV4 version;
     Alcotest.(check bool "pols is empty" true (pols = []));
     match command with
-    | `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console subscribe command, got %a"
              (Vmm_commands.pp ~verbose:true) command
 
@@ -676,7 +676,7 @@ HUBeGB+KSdPOX8zc8taDCQ==
     Alcotest.check test_version "version is 4" `AV4 version;
     Alcotest.(check bool "pols is empty" true (pols = []));
     match command with
-    | `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console subscribe command, got %a"
              (Vmm_commands.pp ~verbose:true) command
 
@@ -714,7 +714,7 @@ s2bwQQncdiUHfYEPbuMIo7WxjT0WBw==
     let path, _pol = List.hd pols in
     Alcotest.check test_path "path is sub" (p_o_s "sub") path;
     match command with
-    | `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console subscribe command, got %a"
              (Vmm_commands.pp ~verbose:true) command
 
@@ -747,7 +747,7 @@ HUBeGB+KSdPOX8zc8taDCQ==
     Alcotest.check test_version "version is 5" `AV5 version;
     Alcotest.(check bool "pols is empty" true (pols = []));
     match command with
-    | `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console subscribe command, got %a"
              (Vmm_commands.pp ~verbose:true) command
 
@@ -780,7 +780,7 @@ HUBeGB+KSdPOX8zc8taDCQ==
     Alcotest.check test_version "version is 5" `AV5 version;
     Alcotest.(check bool "pols is empty" true (pols = []));
     match command with
-    | `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console subscribe command, got %a"
              (Vmm_commands.pp ~verbose:true) command
 
@@ -818,7 +818,7 @@ BgMrZXADQQAZXTUICXOZCD1lFuRKi+zT0qQ2n0+AjluPM4Q+PUVjmqfLqau/2KHc
     let path, _pol = List.hd pols in
     Alcotest.check test_path "path is subv5" (p_o_s "subv5") path;
     match command with
-    | `Console_cmd `Console_subscribe `Count 20 -> ()
+    | `Console_cmd `Old_console_subscribe `Count 20 -> ()
     | _ -> Alcotest.failf "expected console subscribe command, got %a"
              (Vmm_commands.pp ~verbose:true) command
 

tls/vmm_tls.ml

@@ -93,6 +93,7 @@ let handle chain =
     (* we only allow some commands via certificate *)
     match wire with
     | `Console_cmd (`Console_subscribe _)
+    | `Console_cmd (`Old_console_subscribe _)
     | `Stats_cmd `Stats_subscribe
     | `Unikernel_cmd _
     | `Policy_cmd `Policy_info