Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Xapi thread classification - part 2 #6154

Open
wants to merge 3 commits into
base: feature/perf
Choose a base branch
from
Open

Xapi thread classification - part 2 #6154

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
f9d15a7
CP-52320: Improve xapi thread classification
GabrielBuica Dec 4, 2024
bbae795
CP-52320 & CP-52795: Add unit tests for tgroup library
GabrielBuica Dec 4, 2024
62a903a
CP-52320 & CP-52743: Classify xapi threads.
GabrielBuica Dec 4, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 8 additions & 1 deletion ocaml/libs/tgroup/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,11 @@
(library
(name tgroup)
(modules tgroup)
(public_name tgroup)
(libraries xapi-log xapi-stdext-unix))
(libraries xapi-log xapi-stdext-unix xapi-stdext-std))

(test
(name test_tgroup)
(modules test_tgroup)
(package tgroup)
(libraries tgroup alcotest xapi-log))
64 changes: 64 additions & 0 deletions ocaml/libs/tgroup/test_tgroup.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,64 @@
module D = Debug.Make (struct let name = __MODULE__ end)

let test_identity () =
let specs =
[
((Some "XenCenter2024", "u1000"), "u1000/XenCenter2024")
; ((None, "u1001"), "u1001")
; ((None, "Special!@#"), "Special")
; ((Some "With-Hyphen", "123"), "123/WithHyphen")
; ((Some "", ""), "root")
; ((Some " Xen Center 2024 ", ", u 1000 "), "u1000/XenCenter2024")
; ((Some "Xen Center ,/@.~# 2024", "root"), "root/XenCenter2024")
; ((Some "XenCenter 2024.3.18", ""), "root/XenCenter2024318")
]
in

let test_make ((user_agent, subject_sid), expected_identity) =
let actual_identity =
Tgroup.Group.Identity.(make ?user_agent subject_sid |> to_string)
in
Alcotest.(check string)
"Check expected identity" expected_identity actual_identity
in
List.iter test_make specs

let test_of_creator () =
let dummy_identity =
Tgroup.Group.Identity.make ~user_agent:"XenCenter2024" "root"
in
let specs =
[
((None, None, None, None), "external/unauthenticated")
; ((Some true, None, None, None), "external/intrapool")
; ( (Some true, Some "external", Some dummy_identity, Some "sm")
, "external/intrapool"
)
; ( (Some true, Some "internal", Some dummy_identity, Some "sm")
, "external/intrapool"
)
; ((None, Some "intenal", Some dummy_identity, Some "cli"), "internal/cli")
; ( (None, None, Some dummy_identity, Some "sm")
, "external/authenticated/root/XenCenter2024"
)
]
in
let test_make ((intrapool, endpoint, identity, originator), expected_group) =
let actual_group =
Tgroup.Group.(
Creator.make ?intrapool ?endpoint ?identity ?originator ()
|> of_creator
|> to_string
)
in
Alcotest.(check string) "Check expected group" expected_group actual_group
in
List.iter test_make specs

let tests =
[
("identity make", `Quick, test_identity)
; ("group of creator", `Quick, test_of_creator)
]

let () = Alcotest.run "Tgroup library" [("Thread classification", tests)]
Empty file added ocaml/libs/tgroup/test_tgroup.mli
View file
Open in desktop
Empty file.
239 changes: 183 additions & 56 deletions ocaml/libs/tgroup/tgroup.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,12 +29,24 @@ module Group = struct
type t

let name = "external"
end

module Host = struct
type t
module Intrapool = struct
type t

let name = "intrapool"
end

module Authenticated = struct
type t = string

let name = "authenticated"
end

module Unauthenticated = struct
type t

let name = "host"
let name = "unauthenticated"
end
end

module SM = struct
Expand All @@ -43,73 +55,190 @@ module Group = struct
let name = "SM"
end

module CLI = struct
type t

let name = "cli"
end

module Identity = struct
type t = {user_agent: string option; subject_sid: string}

let is_alphanum = function
| '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' ->
true
| _ ->
false

let sanitize s =
Xapi_stdext_std.Xstringext.String.filter_chars s is_alphanum

let make ?user_agent subject_sid =
let user_agent =
user_agent
|> Option.map sanitize
|> Option.map (fun user_agent ->
let len = Int.min (String.length user_agent) 16 in
String.sub user_agent 0 len
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Do we have to care about collisions? If we consider only the sanitized prefix, we could end up with collisions of the shortened names.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think collisions matter that much in this case. If the we end up with the same shortened names they should be under the same classification. The important aspect was to differentiate between auth_user_sids.

)
in

let user_agent = if user_agent = Some "" then None else user_agent in
let subject_sid =
if subject_sid = "" then "root" else sanitize subject_sid
in
{user_agent; subject_sid}

let to_string i =
match i.user_agent with
| Some user_agent ->
i.subject_sid // user_agent
| None ->
i.subject_sid

let root_identity = make "root"
end

type _ group =
| Internal_Host_SM : (Internal.t * Host.t * SM.t) group
| EXTERNAL : External.t group
| Internal_SM : (Internal.t * SM.t) group
| Internal_CLI : (Internal.t * CLI.t) group
| External_Intrapool : (External.t * External.Intrapool.t) group
| External_Authenticated :
Identity.t
-> (External.t * External.Authenticated.t) group
| External_Unautheticated : (External.t * External.Unauthenticated.t) group

type t = Group : 'a group -> t

let all = [Group Internal_Host_SM; Group EXTERNAL]
let all =
[
Group Internal_SM
; Group Internal_CLI
; Group External_Intrapool
; Group (External_Authenticated Identity.root_identity)
; Group External_Unautheticated
]

module Kind = struct
type t = Intrapool | Authenticated of Identity.t | Unautheticated

let to_string = function
| Some Intrapool ->
External.Intrapool.name
| Some (Authenticated identity) ->
External.Authenticated.name // Identity.to_string identity
| Some Unautheticated ->
External.Unauthenticated.name
| None ->
"internal"
end

module Originator = struct
type t = Internal_Host_SM | EXTERNAL
type t = Internal_SM | Internal_CLI | External

let of_string = function
| s
when String.equal
(String.lowercase_ascii SM.name)
(String.lowercase_ascii s) ->
Internal_Host_SM
Internal_SM
| s
when String.equal
(String.lowercase_ascii External.name)
(String.lowercase_ascii CLI.name)
(String.lowercase_ascii s) ->
EXTERNAL
Internal_CLI
| _ ->
EXTERNAL
External

let to_string = function
| Internal_Host_SM ->
| Internal_SM ->
SM.name
| EXTERNAL ->
| Internal_CLI ->
CLI.name
| External ->
External.name
end

module Creator = struct
type t = {
user: string option
; endpoint: string option
; originator: Originator.t
}

let make ?user ?endpoint originator = {originator; user; endpoint}
type t = {kind: Kind.t option; originator: Originator.t}

let make ?(intrapool = false) ?(endpoint = External.name) ?identity
?originator () =
let kind =
match (intrapool, endpoint) with
| true, _ ->
Some Kind.Intrapool
| false, endpoint when String.equal endpoint Internal.name ->
None
| false, _ -> (
match identity with
| None ->
Some Kind.Unautheticated
| Some identity ->
Some (Kind.Authenticated identity)
)
in
let originator =
if String.equal endpoint External.name || intrapool then
Originator.External
else
let originator = Option.map Originator.of_string originator in
match originator with
| None ->
Originator.External
| Some originator ->
originator
in

{kind; originator}

let default_creator =
{
kind= Some (Kind.Authenticated (Identity.make "root"))
; originator= Originator.External
}

let to_string c =
Printf.sprintf "Creator -> user:%s endpoint:%s originator:%s"
(Option.value c.user ~default:"")
(Option.value c.endpoint ~default:"")
Printf.sprintf "Creator -> kind:%s originator:%s" (Kind.to_string c.kind)
(Originator.to_string c.originator)
end

let of_originator = function
| Originator.Internal_Host_SM ->
Group Internal_Host_SM
| Originator.EXTERNAL ->
Group EXTERNAL

let get_originator = function
| Group Internal_Host_SM ->
Originator.Internal_Host_SM
| Group EXTERNAL ->
Originator.EXTERNAL

let of_creator creator = of_originator creator.Creator.originator
| Group Internal_SM ->
Originator.Internal_SM
| Group Internal_CLI ->
Originator.Internal_CLI
| _ ->
Originator.External

let of_creator creator =
match (creator.Creator.originator, creator.Creator.kind) with
| _, Some Intrapool ->
Group External_Intrapool
| Internal_SM, _ ->
Group Internal_SM
| Internal_CLI, _ ->
Group Internal_CLI
| External, Some (Authenticated identity) ->
Group (External_Authenticated identity)
| External, Some Unautheticated | External, None ->
Group External_Unautheticated

let to_cgroup : type a. a group -> string = function
| Internal_Host_SM ->
Internal.name // Host.name // SM.name
| EXTERNAL ->
| Internal_SM ->
Internal.name // SM.name
| Internal_CLI ->
Internal.name // CLI.name
| External_Authenticated identity ->
External.name
// External.Authenticated.name
// Identity.to_string identity
| External_Intrapool ->
External.name // External.Intrapool.name
| External_Unautheticated ->
External.name // External.Unauthenticated.name

let to_string g = match g with Group group -> to_cgroup group
end

module Cgroup = struct
Expand All @@ -124,6 +253,10 @@ module Cgroup = struct
(fun dir -> dir // Group.to_cgroup group)
(Atomic.get cgroup_dir)

let with_dir dir f arg =
Xapi_stdext_unix.Unixext.mkdir_rec dir 0o755 ;
f arg

let write_cur_tid_to_cgroup_file filename =
try
let perms = 0o640 in
Expand All @@ -146,39 +279,33 @@ module Cgroup = struct
Option.iter
(fun dir ->
let tasks_file = dir // "tasks" in
write_cur_tid_to_cgroup_file tasks_file
with_dir dir write_cur_tid_to_cgroup_file tasks_file
)
(dir_of group)

let set_cur_cgroup ~originator =
match originator with
| Group.Originator.Internal_Host_SM ->
attach_task (Group Internal_Host_SM)
| Group.Originator.EXTERNAL ->
attach_task (Group EXTERNAL)
let set_cur_cgroup ~creator = attach_task (Group.of_creator creator)

let set_cgroup creator =
set_cur_cgroup ~originator:creator.Group.Creator.originator
let set_cgroup creator = set_cur_cgroup ~creator

let init dir =
let () = Atomic.set cgroup_dir (Some dir) in
Group.all
|> List.filter_map dir_of
|> List.iter (fun dir -> Xapi_stdext_unix.Unixext.mkdir_rec dir 0o755) ;
set_cur_cgroup ~originator:Group.Originator.EXTERNAL
|> List.iter (fun dir -> with_dir dir debug "created cgroup for: %s" dir) ;
set_cur_cgroup ~creator:Group.Creator.default_creator
end

let of_originator originator =
originator |> Group.Creator.make |> Cgroup.set_cgroup

let of_req_originator originator =
Option.iter
(fun _ ->
try
originator
|> Option.value ~default:Group.Originator.(to_string EXTERNAL)
|> Group.Originator.of_string
|> of_originator
|> Option.iter (fun originator ->
Group.Creator.make ~endpoint:Group.Internal.name ~originator ()
|> Cgroup.set_cgroup
)
with _ -> ()
)
(Atomic.get Cgroup.cgroup_dir)

let of_creator creator = creator |> Cgroup.set_cgroup
Loading
Loading