From 64fdc740ee80533baabaef59a45fa5aba1c35625 Mon Sep 17 00:00:00 2001
From: Gabriel Buica <danutgabriel.buica@cloud.com>
Date: Tue, 26 Mar 2024 09:10:35 +0000
Subject: [PATCH 1/2] CP-46576: Add standard http attributes

Add standard http attributes to from opentelemetry such as:

- `http.request.method`
- `http.request.header.content-type`;
- `http.request.body.size`;
- `http.request.header.user-agent`;
- `http.request.header.(key)`.

This improves debuggability associated with client requests.

Signed-off-by: Gabriel Buica <danutgabriel.buica@cloud.com>
---
 ocaml/xapi/context.ml | 34 +++++++++++++++++++++++++++++++---
 1 file changed, 31 insertions(+), 3 deletions(-)

diff --git a/ocaml/xapi/context.ml b/ocaml/xapi/context.ml
index 4179cf7d930..fc611de7fb5 100644
--- a/ocaml/xapi/context.ml
+++ b/ocaml/xapi/context.ml
@@ -227,8 +227,36 @@ let parent_of_origin (origin : origin) span_name =
   | _ ->
       None
 
+let attribute_helper_fn f v = Option.fold ~none:[] ~some:f v
+
+let attr_of_req (req : Http.Request.t) =
+  [
+    [
+      ("xs.xapi.task.origin", "http")
+    ; ("http.request.header.method", Http.string_of_method_t req.m)
+    ]
+  ; attribute_helper_fn
+      (fun user_agent -> [("http.request.header.user-agent", user_agent)])
+      req.user_agent
+  ; attribute_helper_fn
+      (fun content_type -> [("http.request.header.content-type", content_type)])
+      req.content_type
+  ; attribute_helper_fn
+      (fun content_length ->
+        [("http.request.body.size", Printf.sprintf "%Li" content_length)]
+      )
+      req.content_length
+  ; List.map
+      (fun (h, v) ->
+        ( h |> String.lowercase_ascii |> Printf.sprintf "http.request.header.%s"
+        , v
+        )
+      )
+      req.additional_headers
+  ]
+  |> List.concat
+
 let make_attributes ?task_name ?task_id ?task_uuid ?session_id ?origin () =
-  let attribute_helper_fn f v = Option.fold ~none:[] ~some:f v in
   [
     attribute_helper_fn
       (fun task_name -> [("xs.xapi.task.name", task_name)])
@@ -249,8 +277,8 @@ let make_attributes ?task_name ?task_id ?task_uuid ?session_id ?origin () =
         match origin with
         | Internal ->
             [("xs.xapi.task.origin", "internal")]
-        | Http _ ->
-            [("xs.xapi.task.origin", "http")]
+        | Http (req, _) ->
+            attr_of_req req
       )
       origin
   ]

From d384dbcc945147e6ed28c53b8cd75301b8580b2c Mon Sep 17 00:00:00 2001
From: Gabriel Buica <danutgabriel.buica@cloud.com>
Date: Tue, 26 Mar 2024 11:46:02 +0000
Subject: [PATCH 2/2] CP-46576: Add standard network attributes

Add standard http attributes to from opentelemetry such as:

- `network.local.address`;
- `network.local.port`;
- `network.peer.address`;
- `network.peer.port`.

 This improves debuggability associated with client requests.

Signed-off-by: Gabriel Buica <danutgabriel.buica@cloud.com>
---
 ocaml/xapi/context.ml | 32 ++++++++++++++++++++++++++++++--
 1 file changed, 30 insertions(+), 2 deletions(-)

diff --git a/ocaml/xapi/context.ml b/ocaml/xapi/context.ml
index fc611de7fb5..dce55ca4d40 100644
--- a/ocaml/xapi/context.ml
+++ b/ocaml/xapi/context.ml
@@ -229,6 +229,34 @@ let parent_of_origin (origin : origin) span_name =
 
 let attribute_helper_fn f v = Option.fold ~none:[] ~some:f v
 
+let addr_port_of_sock s =
+  match s with
+  | None ->
+      (None, None)
+  | Some (Unix.ADDR_UNIX "") ->
+      (None, None)
+  | Some (Unix.ADDR_UNIX socket_name) ->
+      (Some socket_name, None)
+  | Some (Unix.ADDR_INET (addr, port)) ->
+      (Some (Unix.string_of_inet_addr addr), Some (string_of_int port))
+
+let with_try_get_addr f s =
+  (try Some (f s) with Unix.Unix_error (Unix.ENOTSOCK, _, _) -> None)
+  |> addr_port_of_sock
+
+let attr_of_fd s =
+  let peer_addr, peer_port = s |> with_try_get_addr Unix.getpeername in
+  let local_addr, local_port = s |> with_try_get_addr Unix.getsockname in
+  [
+    attribute_helper_fn
+      (fun addr -> [("network.local.address", addr)])
+      local_addr
+  ; attribute_helper_fn (fun port -> [("network.local.port", port)]) local_port
+  ; attribute_helper_fn (fun addr -> [("network.peer.address", addr)]) peer_addr
+  ; attribute_helper_fn (fun port -> [("network.peer.port", port)]) peer_port
+  ]
+  |> List.concat
+
 let attr_of_req (req : Http.Request.t) =
   [
     [
@@ -277,8 +305,8 @@ let make_attributes ?task_name ?task_id ?task_uuid ?session_id ?origin () =
         match origin with
         | Internal ->
             [("xs.xapi.task.origin", "internal")]
-        | Http (req, _) ->
-            attr_of_req req
+        | Http (req, s) ->
+            [attr_of_req req; attr_of_fd s] |> List.concat
       )
       origin
   ]