support metrics default, *, and tags

also change the behaviour of get:
- l and m output default, followed by everything that's different
- l* and m* output default, (tags for m), and everything (so it lists everything)
- l<specific> and m<specific> output the specific source(s)
- * in combination with concrete source names is not supported

README.md

@@ -12,20 +12,22 @@ can transmit a command (as text) to adjust log level and enable or disable
 metrics sources:
 
 The log level (prefix `L`) is specified, the same as the command-line argument `-l`:
-- `L*:debug` all log sources are enabled on the *debug* level
+- `L*:debug` all log sources are enabled on the *debug* level.
-- `Lmonitoring-experiments:error` the log source monitoring-experiments is set to the *error* level
+- `Lmonitoring-experiments:error` the log source monitoring-experiments is set to the *error* level.
-- `L*:info,monitoring-experiments:debug` all log sources are enabled on the *info* level, and the log source monitoring-experiments is set to the *debug* level
+- `L*:info,monitoring-experiments:debug` all log sources are enabled on the *info* level, and the log source monitoring-experiments is set to the *debug* level.
 
 The metrics (prefix `M`) sources can be enabled and disabled based on source name.
-First, if present, the all command is executed, then specific sources:
+First, if present, the all command is executed, then the tags, then specific sources:
-- `M*:disable,memory:enable,net-solo5:enable` disables all metrics sources, and then enables *memory* and *net-solo5*
+- `M*:disable,memory:enable,net-solo5:enable` disables all metrics sources, and then enables *memory* and *net-solo5*.
 - `Mnet-solo5:disable` disables the *net-solo5* metrics source.
+- `Mtag:http:enable` enables all metrics with the *http* tag.
 
 The log levels for the log sources can be inspected:
-- `l` reports the default log level and the log level for all log sources
+- `l` reports the default log level and the log level for all log sources with a different log level.
-- `l*` reports the default log level only
+- `l*` reports the default log level and the log level for all log sources.
 - `lmonitoring-experiments,dns` reports the log level for monitoring-experiments and dns respectively.
 
 Likewise, metrics status can be similarly inspected:
-- `m` reports the metrics status for all metrics sources
+- `m` reports the default metrics status and the metrics status for all metrics sources with a different status.
+- `m*` reports the default metrics status, all enabled tags, and the metrics status of all metrics sources.
 - `mmemory,net-solo5` reports the metrics status for memory and net-solo5 respectively.

monitoring-experiments.opam

@@ -11,7 +11,7 @@ depends: [
   "ocaml" {>= "4.08.0"}
   "dune"
   "logs" {>= "0.6.3"}
-  "metrics" {>= "0.2.0"}
+  "metrics" {>= "0.4.0"}
   "metrics-lwt" {>= "0.2.0"}
   "metrics-influx" {>= "0.2.0"}
   "mirage-time" {>= "2.0.0"}

src/monitoring_experiments.ml

@@ -53,46 +53,54 @@ let get_log_levels s =
     | [""] ->
       let all_level = Logs.level () in
       Ok (("*", all_level) :: List.filter (fun (_,l) -> l <> all_level) srcs)
+    | ["*"] ->
+      let all_level = Logs.level () in
+      Ok (("*", all_level) :: srcs)
     | qs ->
       let* () =
-        match List.find_opt
+        let src_names = List.map fst srcs in
-                (function
+        match List.find_opt (fun src -> not (List.mem src src_names)) qs with
-                  | "*" -> false
-                  | q -> List.for_all (fun (n,_) -> q <> n) srcs)
-                qs
-        with
         | Some bad_src -> Error ("unknown source: " ^ bad_src)
         | None -> Ok ()
       in
-      Ok (List.filter_map
+      Ok (List.filter (fun (name, _) -> List.mem name qs) srcs)
-            (function
-              | ("*", _) as src -> Some src
-              | (name, _) as src -> if List.mem name qs then Some src else None)
-            srcs)
   in
   let levels =
-    List.map (fun (name, level) -> name ^ ":" ^ Logs.level_to_string level) srcs
+    List.map (fun (name, level) ->
+        name ^ ":" ^ Logs.level_to_string level)
+      srcs
   in
   Ok (`String (String.concat "," levels))
 
 let get_metrics s =
   let qs = String.split_on_char ',' s in
   let srcs = Metrics.Src.list () in
+  let srcs =
+    List.map (fun src ->
+        Metrics.Src.name src, Metrics.Src.is_active src)
+      srcs
+  in
   let* srcs =
     match qs with
-    | [""] -> Ok srcs
+    | [""] ->
+      let all = Metrics.all_enabled () in
+      Ok (("*", all) :: (List.filter (fun (_, b) -> b <> all) srcs))
+    | ["*"] ->
+      let all = Metrics.all_enabled () in
+      let tags = Metrics.tags_enabled () in
+      Ok (("*", all) :: List.map (fun t -> "tag:" ^ t, true) tags @ srcs)
     | qs ->
-      let src_names = List.map Metrics.Src.name srcs in
       let* () =
+        let src_names = List.map fst srcs in
         match List.find_opt (fun src -> not (List.mem src src_names)) qs with
         | Some bad_src -> Error ("unknown source: " ^ bad_src)
         | None -> Ok ()
       in
-      Ok (List.filter (fun src -> List.mem (Metrics.Src.name src) qs) srcs)
+      Ok (List.filter (fun (n, _) -> List.mem n qs) srcs)
   in
   let metrics =
-    List.map (fun src -> Metrics.Src.name src ^ ":" ^
+    List.map (fun (name, act) ->
-                         if Metrics.Src.is_active src then "enabled" else "disabled")
+        name ^ ":" ^ if act then "enabled" else "disabled")
       srcs
   in
   Ok (`String (String.concat "," metrics))
@@ -100,7 +108,9 @@ let get_metrics s =
 let adjust_log_level s =
   let ts =
     List.map
-      (fst Mirage_runtime.Arg.log_threshold)
+      (fun s ->
+         try (fst Mirage_runtime.Arg.log_threshold) s with
+           Failure err -> `Error ("failure with " ^ s ^ ": " ^ err))
       (String.split_on_char ',' s)
   in
   let* oks =
@@ -135,22 +145,34 @@ let adjust_metrics s =
         | [ src ; en ] ->
           let* en_or_d = enable_of_str en in
           Ok (`Src src, en_or_d)
+        | [ "src" ; src ; en ] ->
+          let* en_or_d = enable_of_str en in
+          Ok (`Src src, en_or_d)
+        | [ "tag" ; tag ; en ] ->
+          let* en_or_d = enable_of_str en in
+          Ok (`Tag tag, en_or_d)
         | _ -> Error ("couldn't decode metrics " ^ s))
       (String.split_on_char ',' s)
   in
-  let* (all, srcs) =
+  let* (all, srcs, tags) =
     List.fold_left (fun acc t ->
-        let* (all, srcs) = acc in
+        let* (all, srcs, tags) = acc in
         let* t = t in
         match t with
-        | `All, en_or_d -> Ok (Some en_or_d, srcs)
+        | `All, en_or_d -> Ok (Some en_or_d, srcs, tags)
-        | `Src s, en_or_d -> Ok (all, (s, en_or_d) :: srcs))
+        | `Src s, en_or_d -> Ok (all, (s, en_or_d) :: srcs, tags)
-      (Ok (None, [])) ts
+        | `Tag t, en_or_d -> Ok (all, srcs, (t, en_or_d) :: tags))
+      (Ok (None, [], [])) ts
   in
   (match all with
    | Some `Enable -> Metrics.enable_all ()
    | Some `Disable -> Metrics.disable_all ()
    | None -> ());
+  List.iter (fun (tag, e_or_d) ->
+      match e_or_d with
+      | `Enable -> Metrics.enable_tag tag
+      | `Disable -> Metrics.disable_tag tag)
+    tags ;
   List.iter (fun (src, e_or_d) ->
       match List.find_opt (fun s -> Metrics.Src.name s = src) (Metrics.Src.list ()), e_or_d with
       | Some src, `Enable -> Metrics.Src.enable src