├── dune-project ├── .ocamlinit ├── dune ├── .merlin ├── .gitignore ├── Makefile ├── cgroups.opam ├── LICENSE ├── .header ├── subsystems ├── CGSubsystem.mli ├── CGCpu.mli ├── subsystem.ml ├── CGCpuacct.ml ├── CGCpuacct.mli ├── CGCpu.ml ├── CGCpuset.mli ├── CGSubsystem.ml ├── CGCpuset.ml ├── CGBlkio.mli ├── CGMemory.mli ├── CGBlkio.ml ├── CGParameters.mli ├── CGParameters.ml └── CGMemory.ml ├── util ├── util.mli ├── converter.mli ├── util.ml └── converter.ml ├── hierarchy ├── hierarchy.mli └── hierarchy.ml └── README.md /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | -------------------------------------------------------------------------------- /.ocamlinit: -------------------------------------------------------------------------------- 1 | #directory "_build";; 2 | #load "cgroups.cma";; 3 | 4 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (include_subdirs unqualified) 2 | 3 | (library 4 | (name cgroups) 5 | (public_name cgroups) 6 | (libraries unix) 7 | ) 8 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | B _build/ 2 | B _build/util/ 3 | B _build/hierarchy/ 4 | B _build/subsystems/ 5 | 6 | S ./ 7 | S ./util/ 8 | S ./hierarchy/ 9 | S ./subsystems/ 10 | 11 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | 11 | # ocamlbuild working directory 12 | _build/ 13 | 14 | # ocamlbuild targets 15 | *.byte 16 | *.native 17 | 18 | # oasis generated files 19 | setup.data 20 | setup.log 21 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # copyright (c) 2015, guillaume bury 2 | 3 | NAME=cgroups 4 | 5 | all: lib 6 | 7 | lib: 8 | dune build @install -p $(NAME) 9 | 10 | doc: 11 | dune build @doc -p $(NAME) 12 | 13 | log: 14 | cat _build/log || true 15 | 16 | clean: 17 | dune clean 18 | 19 | .PHONY: clean doc all 20 | -------------------------------------------------------------------------------- /cgroups.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name:"cgroups" 3 | license: "BSD" 4 | version: "dev" 5 | author: ["Guillaume Bury "] 6 | maintainer: ["Guillaume Bury "] 7 | synopsis: "Cgroups is an interface for control groups" 8 | build: [ 9 | ["dune" "build" "-p" name "-j" jobs] 10 | ] 11 | depends: [ 12 | "ocaml" { >= "4.02.1" } 13 | "dune" 14 | "base-unix" 15 | "odoc" { doc } 16 | ] 17 | tags: [ "cgroup" ] 18 | homepage: "https://github.com/Gbury/ocaml-cgroups" 19 | dev-repo: "git+https://github.com/Gbury/ocaml-cgroups.git" 20 | bug-reports: "https://github.com/Gbury/ocaml-cgroups/issues/" 21 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Guillaume Bury 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 18 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 20 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 22 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 23 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | 25 | -------------------------------------------------------------------------------- /.header: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | -------------------------------------------------------------------------------- /subsystems/CGSubsystem.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | type t = private { 28 | id : int; 29 | name : string; 30 | enabled : bool; 31 | available : bool; 32 | } 33 | 34 | val find : string -> t 35 | 36 | val find_all : unit -> t list 37 | 38 | -------------------------------------------------------------------------------- /util/util.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | val split : seps:(char list) -> string -> string list 28 | val fold_dir : (string -> 'a -> 'a) -> string -> 'a -> 'a 29 | 30 | val range : int * int -> int list 31 | val compactify : int list -> (int * int) list 32 | 33 | module Opt : sig 34 | val map : ('a -> 'b) -> 'a option -> 'b option 35 | val iter : ('a -> unit) -> 'a option -> unit 36 | val iter2 : ('a -> 'b -> unit) -> ('a * 'b) option -> unit 37 | val bind : ('a -> 'b option) -> 'a option -> 'b option 38 | end 39 | 40 | -------------------------------------------------------------------------------- /subsystems/CGCpu.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | val t : CGSubsystem.t 28 | 29 | type stat = { nr_periods : int; nr_throttled : int; throttled_time : int; } 30 | 31 | val cfs_quota_us : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 32 | val cfs_period_us : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 33 | 34 | val stat : (stat, [ `Read ], [ `Dummy ]) CGParameters.t 35 | val shares : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 36 | 37 | val rt_period_us : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 38 | val rt_runtime_us : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 39 | 40 | -------------------------------------------------------------------------------- /subsystems/subsystem.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | (** Module aliases *) 28 | 29 | (** {2 Main definitions} *) 30 | 31 | (** Main module. Contains the definition of a subsystem, and some functions 32 | to get installed subsystems *) 33 | module Main = CGSubsystem 34 | 35 | (** Subsystems parameters. This defines the type of tunable parameters 36 | for controllers and provides accesors to those parameters. *) 37 | module Param = CGParameters 38 | 39 | (** {2 Known subsystems} *) 40 | 41 | module Blkio = CGBlkio 42 | module Cpu = CGCpu 43 | module Cpuset = CGCpuset 44 | module Cpuacct = CGCpuacct 45 | module Memory = CGMemory 46 | 47 | -------------------------------------------------------------------------------- /subsystems/CGCpuacct.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | module A = CGParameters 28 | 29 | (* Convert functions *) 30 | type stat = { 31 | user : int; 32 | system : int; 33 | } 34 | 35 | let stat_converter = Converter.ro 36 | (fun s -> match Converter.(read (list ~sep:'\n' (list ~sep:' ' string))) s with 37 | | [["user"; u]; ["system"; s]] -> 38 | { user = int_of_string u; system = int_of_string s} 39 | | _ -> assert false) 40 | 41 | (* Parameters *) 42 | 43 | let t = CGSubsystem.find "cpuacct" 44 | 45 | let stat = A.mk_get t "stat" stat_converter 46 | 47 | let usage = A.mk_reset t "usage" Converter.int "0" 48 | 49 | let usage_percpu = A.mk_get t "usage_percpu" Converter.(list ~sep:' ' int) 50 | 51 | -------------------------------------------------------------------------------- /subsystems/CGCpuacct.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | (** Parameters for the 'cpuacct' subsystem *) 28 | 29 | (** {2 Type definitions} *) 30 | 31 | type stat = { 32 | user : int; 33 | system : int; 34 | } 35 | (** The types of stats for cpu activity. *) 36 | 37 | (** {2 Parameters} *) 38 | 39 | val t : CGSubsystem.t 40 | (** The name of the subsystem *) 41 | 42 | val stat : (stat, [ `Read ], [ `Dummy ]) CGParameters.t 43 | (** Parameter: returns the user & system time (in nanoseconds) used by 44 | all tasks in a cgroup and its children (recursively). *) 45 | 46 | val usage : (int, [ `Read ], [ `Reset ]) CGParameters.t 47 | (** Parameter: returns the cpu time (in nanoseconds) used by 48 | all tasks in a cgroup and its children (recusively). *) 49 | 50 | val usage_percpu : (int list, [ `Read ], [ `Dummy ]) CGParameters.t 51 | (** Parameter: same as [usage] but discriminates between cpus. *) 52 | 53 | -------------------------------------------------------------------------------- /subsystems/CGCpu.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | let t = CGSubsystem.find "cpu" 28 | 29 | type stat = { 30 | nr_periods : int; 31 | nr_throttled : int; 32 | throttled_time : int; 33 | } 34 | 35 | let stat_converter = Converter.ro 36 | (fun s -> match Converter.(read (list ~sep:'\n' (pair ~sep:' ' string int))) s with 37 | | ["nr_periods", nr_periods; 38 | "nr_throttled", nr_throttled; 39 | "throttled_time", throttled_time] -> 40 | { nr_periods; nr_throttled; throttled_time; } 41 | | _ -> raise (Invalid_argument "stat_of_string")) 42 | 43 | let cfs_quota_us = CGParameters.mk_set t "cfs_quota_us" Converter.int 44 | let cfs_period_us = CGParameters.mk_set t "cfs_period_us" Converter.int 45 | 46 | let stat = CGParameters.mk_get t "stat" stat_converter 47 | 48 | let shares = CGParameters.mk_set t "share" (Converter.bounded_int ~min:2 ()) 49 | 50 | let rt_period_us = CGParameters.mk_set t "rt_period_us" Converter.int 51 | let rt_runtime_us = CGParameters.mk_set t "rt_runtime_us" Converter.int 52 | 53 | -------------------------------------------------------------------------------- /subsystems/CGCpuset.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | val t : CGSubsystem.t 28 | 29 | val cpus : (int list, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 30 | val mems : (int list, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 31 | val memory_migrate : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 32 | val cpu_exclusive : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 33 | val mem_exclusive : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 34 | val mem_hardwall : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 35 | val memory_pressure : (int, [ `Read ], [ `Dummy ]) CGParameters.t 36 | val memory_pressure_enabled : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 37 | val memory_spread_page : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 38 | val memory_spread_slab : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 39 | val sched_load_balance : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 40 | val sched_relax_domain_level : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 41 | 42 | -------------------------------------------------------------------------------- /util/converter.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | type ('ty, -'attr) t 28 | constraint 'attr = [< `Read | `Write ] 29 | 30 | val ro : (string -> 'a) -> ('a, [ `Read ]) t 31 | val wo : ('a -> string) -> ('a, [ `Write ]) t 32 | val rw : (string -> 'a) -> ('a -> string) -> ('a, [ `Read | `Write ]) t 33 | 34 | val read : ('a, [> `Read ]) t -> string -> 'a 35 | val write : ('a, [> `Write ]) t -> 'a -> string 36 | 37 | val int : (int, [ `Read | `Write ]) t 38 | val bool : (bool, [ `Read | `Write ]) t 39 | val string : (string, [ `Read | `Write ]) t 40 | 41 | val pair : sep:char -> ('a, 'c) t -> ('b, 'c) t -> ('a * 'b, 'c) t 42 | val triple : sep:char -> ('a, 'd) t -> ('b, 'd) t -> ('c, 'd) t -> ('a * 'b * 'c, 'd) t 43 | 44 | val list : sep:char -> ('a, 'b) t -> ('a list, 'b) t 45 | 46 | val device : (int * int, [ `Read | `Write ]) t 47 | 48 | val range : (int list, [ `Read | `Write ]) t 49 | val single_range : (int * int, [ `Read | `Write ]) t 50 | 51 | val bounded_int : ?min:int -> ?max:int -> unit -> (int, [ `Read | `Write ]) t 52 | 53 | -------------------------------------------------------------------------------- /subsystems/CGSubsystem.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | type t = { 28 | id : int; 29 | name : string; 30 | enabled : bool; 31 | available : bool; 32 | } 33 | 34 | let mk_some id name enabled = 35 | { id; name; enabled; available = true; } 36 | 37 | let mk_none name = 38 | { id = 0; name; enabled = false; available = false; } 39 | 40 | (* Access function *) 41 | let find_all () = 42 | let rec aux ch acc = 43 | match input_line ch with 44 | | exception End_of_file -> acc 45 | | s -> 46 | begin match Util.split ~seps:[' '; '\t'] s with 47 | | [sub_name; id; _; enabled;] -> 48 | aux ch (mk_some (int_of_string id) sub_name (enabled = "1") :: acc) 49 | | _ -> aux ch acc 50 | end 51 | in 52 | let ch = open_in "/proc/cgroups" in 53 | ignore (input_line ch); (* first line does not have any useful info *) 54 | let res = aux ch [] in 55 | close_in ch; 56 | res 57 | 58 | let find name = 59 | try List.find (fun t -> t.name = name) (find_all ()) 60 | with Not_found -> mk_none name 61 | 62 | -------------------------------------------------------------------------------- /subsystems/CGCpuset.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | let t = CGSubsystem.find "cpuset" 28 | 29 | let cpus = CGParameters.mk_set t "cpus" Converter.range 30 | let mems = CGParameters.mk_set t "mems" Converter.range 31 | 32 | let memory_migrate = CGParameters.mk_set t "memory_migrate" Converter.bool 33 | 34 | let cpu_exclusive = CGParameters.mk_set t "cpu_exclusive" Converter.bool 35 | let mem_exclusive = CGParameters.mk_set t "memory_exclusive" Converter.bool 36 | 37 | let mem_hardwall = CGParameters.mk_set t "mem_hardwall" Converter.bool 38 | 39 | let memory_pressure = CGParameters.mk_get t "memory_pressure" Converter.int 40 | 41 | let memory_pressure_enabled = CGParameters.mk_set t "memory_pressure_enabled" Converter.bool 42 | 43 | let memory_spread_page = CGParameters.mk_set t "memory_spread_page" Converter.bool 44 | let memory_spread_slab = CGParameters.mk_set t "memory_spread_slab" Converter.bool 45 | 46 | let sched_load_balance = CGParameters.mk_set t "sched_load_balance" Converter.bool 47 | 48 | let sched_relax_domain_level = CGParameters.mk_set t "sched_relax_domain_level" Converter.int 49 | 50 | -------------------------------------------------------------------------------- /util/util.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | (* Directory iteration *) 28 | let fold_dir f d acc = 29 | let rec aux f dir acc = 30 | match Unix.readdir dir with 31 | | exception End_of_file -> Unix.closedir dir; acc 32 | | s when s = Filename.current_dir_name 33 | || s = Filename.parent_dir_name -> 34 | aux f dir acc 35 | | s -> aux f dir (f s acc) 36 | in 37 | aux f (Unix.opendir d) acc 38 | 39 | (* String manipulation *) 40 | let rec next_occ s i l = 41 | if i >= String.length s || List.mem s.[i] l then i 42 | else next_occ s (i + 1) l 43 | 44 | let split ~seps s = 45 | let rec aux l s acc i = 46 | if i >= String.length s then acc 47 | else begin 48 | let j = next_occ s i l in 49 | if j <= i then 50 | aux l s acc (i + 1) 51 | else 52 | aux l s (String.sub s i (j - i) :: acc) (j + 1) 53 | end 54 | in 55 | List.rev (aux seps s [] 0) 56 | 57 | (* Operations on integer lists as ranges *) 58 | let range (start, stop) = 59 | let rec aux start acc i = 60 | if i < start then acc 61 | else aux start (i :: acc) (i -1) 62 | in 63 | aux start [] stop 64 | 65 | let compactify l = 66 | let rec aux acc (min,max) = function 67 | | [] -> (min,max) :: acc 68 | | x :: r -> 69 | if x = max + 1 then aux acc (min,x) r 70 | else aux ((min,max) :: acc) (x,x) r 71 | in 72 | match List.sort (fun (x:int) y -> compare x y) l with 73 | | [] -> [] 74 | | x :: r -> aux [] (x,x) r 75 | 76 | (* Option operations *) 77 | module Opt = struct 78 | 79 | let map f = function None -> None | Some a -> Some (f a) 80 | 81 | let iter f = function None -> () | Some a -> f a 82 | 83 | let iter2 f = function None -> () | Some (a, b) -> f a b 84 | 85 | let bind f = function None -> None | Some a -> f a 86 | 87 | end 88 | 89 | -------------------------------------------------------------------------------- /subsystems/CGBlkio.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | val t : CGSubsystem.t 28 | 29 | val weight : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 30 | val weight_device :(((int * int) * int) list, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 31 | 32 | val throttle_read_bps_device : (((int * int) * int) list, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 33 | val throttle_read_iops_device : (((int * int) * int) list, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 34 | val throttle_write_bps_device : (((int * int) * int) list, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 35 | val throttle_write_iops_device : (((int * int) * int) list, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 36 | val throttle_io_serviced : (((int * int) * string * int) list, [ `Read ], [ `Dummy ]) CGParameters.t 37 | val throttle_io_service_bytes : (((int * int) * string * int) list, [ `Read ], [ `Dummy ]) CGParameters.t 38 | 39 | val reset_stats : (int, [ `Read ], [ `Reset ]) CGParameters.t 40 | val time : (((int * int) * int) list, [ `Read ], [ `Dummy ]) CGParameters.t 41 | val sectors : (((int * int) * int) list, [ `Read ], [ `Dummy ]) CGParameters.t 42 | val avg_queue_size : (int, [ `Read ], [ `Dummy ]) CGParameters.t 43 | val group_wait_time : (int, [ `Read ], [ `Dummy ]) CGParameters.t 44 | val empty_time : (int, [ `Read ], [ `Dummy ]) CGParameters.t 45 | val idle_time : (int, [ `Read ], [ `Dummy ]) CGParameters.t 46 | 47 | val io_serviced : (((int * int) * string * int) list, [ `Read ], [ `Dummy ]) CGParameters.t 48 | val io_service_bytes : (((int * int) * string * int) list, [ `Read ], [ `Dummy ]) CGParameters.t 49 | val io_service_time : (((int * int) * string * int) list, [ `Read ], [ `Dummy ]) CGParameters.t 50 | 51 | val wait_time : (((int * int) * string * int) list, [ `Read ], [ `Dummy ]) CGParameters.t 52 | val io_merged : (int * string, [ `Read ], [ `Dummy ]) CGParameters.t 53 | val io_queued : (int * string, [ `Read ], [ `Dummy ]) CGParameters.t 54 | 55 | -------------------------------------------------------------------------------- /subsystems/CGMemory.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | val t : CGSubsystem.t 28 | 29 | type stat = { 30 | cache : int; 31 | rss : int; 32 | mapped_file : int; 33 | pgpgin : int; 34 | pgpgout : int; 35 | swap : int; 36 | active_anon : int; 37 | inactive_anon : int; 38 | active_file : int; 39 | inactive_file : int; 40 | unevictable : int; 41 | total_cache : int; 42 | total_rss : int; 43 | total_mapped_file : int; 44 | total_pgpgin : int; 45 | total_pgpgout : int; 46 | total_swap : int; 47 | total_active_anon : int; 48 | total_inactive_anon : int; 49 | total_active_file : int; 50 | total_inactive_file : int; 51 | total_unevictable : int; 52 | hierarchical_memory_limit : int; 53 | hierarchical_memsw_limit : int; 54 | } 55 | 56 | type oom_control = { oom_kill_disable : bool; under_oom : bool; } 57 | 58 | val stat : (stat, [ `Read ], [ `Dummy ]) CGParameters.t 59 | val usage_in_bytes : (int, [ `Read ], [ `Dummy ]) CGParameters.t 60 | val memsw_usage_in_bytes : (int, [ `Read ], [ `Dummy ]) CGParameters.t 61 | val max_usage_in_bytes : (int, [ `Read ], [ `Dummy ]) CGParameters.t 62 | val memsw_max_usage_in_bytes : (int, [ `Read ], [ `Dummy ]) CGParameters.t 63 | val limit_in_bytes : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 64 | val memsw_limit_in_bytes : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 65 | val failcnt : (int, [ `Read ], [ `Dummy ]) CGParameters.t 66 | val memsw_failcnt : (int, [ `Read ], [ `Dummy ]) CGParameters.t 67 | val soft_limit_in_bytes : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 68 | val force_empty : (int, [ `Read ], [ `Reset ]) CGParameters.t 69 | val swappiness : (int, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 70 | val move_charge_at_immigrate : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 71 | val use_hierarchy : (bool, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 72 | val oom_control : (oom_control, [ `Read | `Write ], [ `Dummy ]) CGParameters.t 73 | 74 | -------------------------------------------------------------------------------- /subsystems/CGBlkio.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | let t = CGSubsystem.find "blkio" 28 | 29 | let devices = Converter.(list ~sep:'\n' (pair ~sep:' ' device int)) 30 | 31 | let weight = CGParameters.mk_set t "weight" (Converter.bounded_int ~min:100 ~max:1000 ()) 32 | 33 | let weight_device = CGParameters.mk_set t "weight_device" devices 34 | 35 | let throttle_read_bps_device = CGParameters.mk_set t "throttle.read_bps_device" devices 36 | let throttle_read_iops_device = CGParameters.mk_set t "throttle.read_iops_device" devices 37 | let throttle_write_bps_device = CGParameters.mk_set t "throttle.write_bps_device" devices 38 | let throttle_write_iops_device = CGParameters.mk_set t "throttle.write_iops_device" devices 39 | 40 | let throttle_io_serviced = CGParameters.mk_get t "throttle.io_serviced" 41 | Converter.(list ~sep:'\n' (triple ~sep:' ' device string int)) 42 | 43 | let throttle_io_service_bytes = CGParameters.mk_get t "throttle.io_service_bytes" 44 | Converter.(list ~sep:'\n' (triple ~sep:' ' device string int)) 45 | 46 | let reset_stats = CGParameters.mk_reset t "reset_stats" Converter.int "0" 47 | 48 | let time = CGParameters.mk_get t "time" devices 49 | 50 | let sectors = CGParameters.mk_get t "sectors" devices 51 | 52 | let avg_queue_size = CGParameters.mk_get t "avg_queue_size" Converter.int 53 | 54 | let group_wait_time = CGParameters.mk_get t "group_wait_time" Converter.int 55 | 56 | let empty_time = CGParameters.mk_get t "empty_time" Converter.int 57 | 58 | let idle_time = CGParameters.mk_get t "idle_time" Converter.int 59 | 60 | let io_serviced = CGParameters.mk_get t "io_serviced" 61 | Converter.(list ~sep:'\n' (triple ~sep:' ' device string int)) 62 | 63 | let io_service_bytes = CGParameters.mk_get t "io_service_bytes" 64 | Converter.(list ~sep:'\n' (triple ~sep:' ' device string int)) 65 | 66 | let io_service_time = CGParameters.mk_get t "io_service_time" 67 | Converter.(list ~sep:'\n' (triple ~sep:' ' device string int)) 68 | 69 | let wait_time = CGParameters.mk_get t "wait_time" 70 | Converter.(list ~sep:'\n' (triple ~sep:' ' device string int)) 71 | 72 | let io_merged = CGParameters.mk_get t "io_merged" 73 | Converter.(pair ~sep:' ' int string) 74 | 75 | let io_queued = CGParameters.mk_get t "io_queued" 76 | Converter.(pair ~sep:' ' int string) 77 | 78 | -------------------------------------------------------------------------------- /subsystems/CGParameters.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | (** Defines the parameters of subsystems *) 28 | 29 | (** {2 Types and exceptions} *) 30 | 31 | type ('ty, -'attr, -'flag) t constraint 'attr = [< `Read | `Write ] 32 | (** The type of parameters for subsystems. The ['ty] argument represents 33 | the high level type of the value stored in the parameter. The ['attr] 34 | type parameter represents the level of access of the parameter, i.e 35 | should it be a read-only parameter, can it be set to a specific value ? 36 | The flag type is for additional operations, such as reset. *) 37 | 38 | exception Expected_root of string * Hierarchy.cgroup 39 | (** Raised by parameters that are only settable for the root cgroup of a 40 | hierarchy, such as release_agent. *) 41 | 42 | exception Subsystem_not_available of CGSubsystem.t 43 | (** Raised when trying to get/set/reset a parameter of a subsystem that is not 44 | available on the machine. *) 45 | 46 | exception Subsystem_not_attached of CGSubsystem.t * Hierarchy.cgroup 47 | (** Raised when trying to get/set/reset a parameter of a subsystem that is not 48 | mounted on the hierarchyof the selected cgroup. *) 49 | 50 | (** {2 Using parameters} *) 51 | 52 | val get : ('a, [> `Read ], _) t -> Hierarchy.cgroup -> 'a 53 | (** Returns the value of the parameter for the given cgroup. *) 54 | 55 | val set : ('a, [> `Write ], _) t -> Hierarchy.cgroup -> 'a -> unit 56 | (** Sets the parameter to the given value for the cgroup. *) 57 | 58 | val reset : ('a, _, [> `Reset ]) t -> Hierarchy.cgroup -> unit 59 | (** Reset the parameter for the given cgroup *) 60 | 61 | (** {2 Standard cgroup parameters} *) 62 | 63 | val release_agent : (string, [ `Read | `Write ], [ `Dummy ]) t 64 | val notify_on_release : (bool, [ `Read | `Write ], [ `Dummy ]) t 65 | (** These parameters do not belong to any subsystem but are present in every cgroup. *) 66 | 67 | (** {2 Creating parameters} 68 | As parameters are stored in system files, they are stored as strings. 69 | Thus conversion functions are used to translate the strings to appropriate 70 | representations of the values actually stored. *) 71 | 72 | val mk_get : CGSubsystem.t -> string -> ('a, [> `Read ]) Converter.t -> ('a, [ `Read ], [ `Dummy ]) t 73 | (** [mk_get subsystem name from_string] returns a gettable parameter. *) 74 | 75 | val mk_set : CGSubsystem.t -> string -> ('a, [> `Read | `Write ]) Converter.t -> ('a, [ `Read | `Write ], [ `Dummy ]) t 76 | (** [mk_set subsystem name from_string to_string] returns a settable parameter. 77 | Note that a settable parameter is also a gettable parameter. *) 78 | 79 | val mk_reset : CGSubsystem.t -> string -> ('a, [> `Read ]) Converter.t -> string -> ('a, [ `Read ], [ `Reset ]) t 80 | (** [mk_reset subsystem name from_string reset_value] returns a gettable parameter 81 | whose value can be reset by writing [reset_value] in the corresponding file. *) 82 | 83 | -------------------------------------------------------------------------------- /subsystems/CGParameters.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | exception Expected_root of string * Hierarchy.cgroup 28 | exception Subsystem_not_available of CGSubsystem.t 29 | exception Subsystem_not_attached of CGSubsystem.t * Hierarchy.cgroup 30 | 31 | type ('a, -'b, -'c) t = { 32 | name : string; 33 | subsystem : CGSubsystem.t option; 34 | 35 | reset_value : string; 36 | converter : ('a, 'b) Converter.t; 37 | 38 | check : Hierarchy.cgroup -> unit; 39 | } constraint 'b = [< `Read | `Write ] 40 | 41 | let check sub_opt = 42 | match sub_opt with 43 | | None -> assert false 44 | | Some sub -> 45 | (fun g -> 46 | if not sub.CGSubsystem.available then 47 | raise (Subsystem_not_available sub) 48 | else if not (List.mem sub (Hierarchy.subsys g)) then 49 | raise (Subsystem_not_attached (sub, g)) 50 | ) 51 | 52 | let mk subsystem name converter ?(reset_value = "") ?(check=(check subsystem)) () = 53 | { name; subsystem; reset_value; converter; check; } 54 | 55 | (* Cgroup tunable parameters *) 56 | let notify_on_release = mk None "notify_on_release" Converter.bool ~check:(fun _ -> ()) () 57 | 58 | let release_agent = mk None "release_agent" Converter.string 59 | ~check:(fun g -> 60 | if not (Hierarchy.is_root g) then 61 | raise (Expected_root ("release_agent", g)) 62 | ) () 63 | 64 | (* Attribute creation *) 65 | let mk_get sub name converter = 66 | mk (Some sub) name (converter : ('a, [> `Read]) Converter.t :> ('a, [ `Read ]) Converter.t) () 67 | 68 | let mk_set sub name converter = mk (Some sub) name converter () 69 | 70 | let mk_reset sub name converter reset_value = 71 | mk (Some sub) name (converter : ('a, [> `Read]) Converter.t :> ('a, [ `Read ]) Converter.t) ~reset_value () 72 | 73 | (* Low-level Accessors *) 74 | let file t = 75 | match t.subsystem with 76 | | None -> Format.asprintf "%s" t.name 77 | | Some sub -> Format.asprintf "%s.%s" sub.CGSubsystem.name t.name 78 | 79 | let raw_get attr path = 80 | let f = Filename.concat path (file attr) in 81 | let rec aux ch acc = 82 | match input_line ch with 83 | | exception End_of_file -> acc 84 | | s -> aux ch (s :: acc) 85 | in 86 | let ch = open_in f in 87 | let res = String.concat "\n" (List.rev (aux ch [])) in 88 | close_in ch; 89 | res 90 | 91 | let raw_set attr path value = 92 | let f = Filename.concat path (file attr) in 93 | let ch = open_out f in 94 | output_string ch value; 95 | close_out ch 96 | 97 | (* High-level accessors *) 98 | 99 | let get t g = 100 | t.check g; 101 | Converter.read t.converter (raw_get t (Hierarchy.path g)) 102 | 103 | let set t g value = 104 | t.check g; 105 | raw_set t (Hierarchy.path g) (Converter.write t.converter value) 106 | 107 | let reset t g = 108 | t.check g; 109 | raw_set t (Hierarchy.path g) t.reset_value 110 | 111 | -------------------------------------------------------------------------------- /util/converter.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | (* Type definition *) 28 | 29 | type ('ty, -'attr) t = { 30 | read : string -> 'ty; 31 | write : 'ty -> string; 32 | } constraint 'attr = [< `Read | `Write ] 33 | 34 | (* Exceptions *) 35 | 36 | let _invalid_arg s = raise (Invalid_argument s) 37 | 38 | (* Using converters *) 39 | let read t = t.read 40 | let write t = t.write 41 | 42 | (* Creating converters *) 43 | 44 | let _false _ = assert false 45 | let mk ?(read=_false) ?(write=_false) () = { read; write; } 46 | 47 | let ro read = mk ~read () 48 | let wo write = mk ~write () 49 | let rw read write = mk ~read ~write () 50 | 51 | (* Bool converter *) 52 | let bool = mk 53 | ~read:(function 54 | | "0" -> false | "1" -> true 55 | | _s -> _invalid_arg "bool") 56 | ~write:(fun b -> if b then "1" else "0") 57 | () 58 | 59 | (* String converter (i.e identity) *) 60 | let string = mk ~read:(fun s -> s) ~write:(fun s -> s) () 61 | 62 | (* Int converter *) 63 | let bounded_int ?(min=min_int) ?(max=max_int) () = mk 64 | ~read:(fun s -> 65 | try 66 | let i = int_of_string s in 67 | if i >= min && i <= max then i 68 | else _invalid_arg "int" 69 | with Invalid_argument _ -> 70 | _invalid_arg"int") 71 | ~write:(fun i -> 72 | if i >= min && i <= max then 73 | string_of_int i 74 | else 75 | _invalid_arg "int") 76 | () 77 | 78 | let int = bounded_int () 79 | 80 | (* Pair converter *) 81 | let pair ~sep t1 t2 = mk 82 | ~read:(fun s -> 83 | match Util.split ~seps:[sep] s with 84 | | [a; b] -> (read t1 a, read t2 b) 85 | | _ -> _invalid_arg "pair") 86 | ~write:(fun (a, b) -> 87 | Format.asprintf "%s%c%s" (write t1 a) sep (write t2 b)) 88 | () 89 | 90 | (* Triple converter *) 91 | let triple ~sep t1 t2 t3 = mk 92 | ~read:(fun s -> 93 | match Util.split ~seps:[sep] s with 94 | | [a; b; c] -> (read t1 a, read t2 b, read t3 c) 95 | | _ -> _invalid_arg "pair") 96 | ~write:(fun (a, b, c) -> 97 | Format.asprintf "%s%c%s%c%s" (write t1 a) sep (write t2 b) sep (write t3 c)) 98 | () 99 | 100 | (* List converter *) 101 | let list ~sep t = mk 102 | ~read:(fun s -> 103 | List.map (read t) (Util.split ~seps:[sep] s)) 104 | ~write:(fun l -> 105 | String.concat (String.make 1 sep) (List.map (write t) l)) 106 | () 107 | 108 | (* Specific converter for linux device identifier *) 109 | let device = pair ~sep:':' int int 110 | 111 | (* Converter for range of discrete integer values, 112 | such as "1-4,8" *) 113 | let single_range = mk 114 | ~read:(fun s -> 115 | match read (list ~sep:'-' int) s with 116 | | [i] -> (i,i) 117 | | [i; j] -> (i,j) 118 | | _ -> _invalid_arg "single_range") 119 | ~write:(fun ((i,j) : (int * int)) -> 120 | if i = j then Format.asprintf "%d" i 121 | else Format.asprintf "%d-%d" i j) 122 | () 123 | 124 | let range = mk 125 | ~read:(fun s -> 126 | List.flatten (List.map Util.range (read (list ~sep:',' single_range) s))) 127 | ~write:(fun l -> 128 | let l' = Util.compactify l in 129 | write (list ~sep:',' single_range) l') 130 | () 131 | 132 | -------------------------------------------------------------------------------- /hierarchy/hierarchy.mli: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | (** Defines cgroups and hierachies. *) 28 | 29 | (** {2 Type definitions} *) 30 | 31 | type t 32 | (** The type of a cgroup hierarchy. A hierarchy is defined by its 33 | mounting point, and the subsystems attached to it. *) 34 | 35 | type cgroup 36 | (** The type of cgroups. Each hierarchy is composed of a tree where the nodes 37 | and leaves are cgroups. *) 38 | 39 | val equal : t -> t -> bool 40 | val cgroup_equal : cgroup -> cgroup -> bool 41 | (** Equality functions for hierarchies and cgroups *) 42 | 43 | (** {2 Hierarchy Access} *) 44 | 45 | val is_root : cgroup -> bool 46 | (** Is the cgroup at the root of its hierarchy ? *) 47 | 48 | val root : t -> cgroup 49 | (** Returns the cgroup at the root of a given hierarchy *) 50 | 51 | val name : cgroup -> string 52 | (** Return the name of the cgroup *) 53 | 54 | val path : cgroup -> string 55 | (** Returns the filesystem path of a cgroup. *) 56 | 57 | val subsys : cgroup -> CGSubsystem.t list 58 | (** Returns the list of subsystems attached to the hierarchy of a cgroup. *) 59 | 60 | (** {2 Manipulating hierarchies} *) 61 | 62 | val find : string -> cgroup option 63 | (** Takes a string with the format ["subsystem:path/to/cgroup"] and try and 64 | return the corresponding cgroup. *) 65 | 66 | val find_exn : string -> cgroup 67 | (** Same as [find] but raises an exception if no matching cgroup is found. *) 68 | 69 | val make_sub : ?id: int * int -> ?a: Unix.file_perm -> ?t: Unix.file_perm -> 70 | perm:Unix.file_perm -> cgroup -> string -> cgroup 71 | (** Create a new children for a cgroup. Since interaction with cgroups is 72 | done via the filesystem, this means creating a directory at the 73 | appropriate place in the filesystem. The [~perm] argument is used for the directory 74 | permissions, the [?t] for the tasks file and [?a] for other subsystem files. 75 | If provided, the directory as well as files will be chowned to the uid and gid provided 76 | by [?id]. 77 | Note that this function may currently very well raise errors from the 78 | Unix module if, for instance, the user does not have permission 79 | to create directories in the cgroup. *) 80 | 81 | val make : ?id: int * int -> ?a: Unix.file_perm -> ?t: Unix.file_perm -> 82 | perm:Unix.file_perm -> cgroup -> string -> cgroup 83 | (** Same as [mk_sub] but accepts a path instead of a single groupe name. *) 84 | 85 | val find_or_create : ?id: int * int -> ?a: Unix.file_perm -> ?t: Unix.file_perm -> 86 | perm:Unix.file_perm -> string -> cgroup 87 | (** Same as find, but creates the cgroup at the end of the path (and all necessary 88 | cgroups in between) and if the specified path does not yet exists. *) 89 | 90 | val scan : CGSubsystem.t list -> t list 91 | (** Given a list of subsystems, returns the list of hierarchies that have 92 | at least one of the subsystems attached. Information on the returned 93 | hierarchies may be incomplete, i.e if a hierarchy [h] has subsystems ["A"] 94 | and ["B"] attached, then [find_all \["A"\]] will return a hierarchy [h] 95 | with only ["A"] attached. [find_all \["A"; "B"\]], however, will 96 | return the expected hierarchy. *) 97 | 98 | val children : cgroup -> cgroup list 99 | (** Returns the list of children of a cgroup. *) 100 | 101 | (** {2 Processes in cgroups} *) 102 | 103 | val processes : cgroup -> int list 104 | (** Returns the list of processids of all processein a cgroup. *) 105 | 106 | val add_process : cgroup -> int -> unit 107 | (** Add a process to a cgroup using its process id. *) 108 | 109 | val process_info : int -> cgroup list 110 | (** Returns the list of cgroups to which the process with given pid belongs. *) 111 | 112 | -------------------------------------------------------------------------------- /subsystems/CGMemory.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | let t = CGSubsystem.find "memory" 28 | 29 | type stat = { 30 | cache : int; 31 | rss : int; 32 | mapped_file : int; 33 | pgpgin : int; 34 | pgpgout : int; 35 | swap : int; 36 | active_anon : int; 37 | inactive_anon : int; 38 | active_file : int; 39 | inactive_file : int; 40 | unevictable : int; 41 | 42 | total_cache : int; 43 | total_rss : int; 44 | total_mapped_file : int; 45 | total_pgpgin : int; 46 | total_pgpgout : int; 47 | total_swap : int; 48 | total_active_anon : int; 49 | total_inactive_anon : int; 50 | total_active_file : int; 51 | total_inactive_file : int; 52 | total_unevictable : int; 53 | 54 | hierarchical_memory_limit : int; 55 | hierarchical_memsw_limit : int 56 | } 57 | 58 | let stat_converter = Converter.ro 59 | (fun s -> let l = Converter.(read (list ~sep:'\n' (pair ~sep:' ' string int))) s in 60 | try { 61 | cache = List.assoc "cache" l; 62 | rss = List.assoc "rss" l; 63 | mapped_file = List.assoc "mapped_file" l; 64 | pgpgin = List.assoc "pgpgin" l; 65 | pgpgout = List.assoc "pgpgout" l; 66 | swap = List.assoc "swap" l; 67 | active_anon = List.assoc "active_anon" l; 68 | inactive_anon = List.assoc "inactive_anon" l; 69 | active_file = List.assoc "active_file" l; 70 | inactive_file = List.assoc "incative_file" l; 71 | unevictable = List.assoc "unevictable" l; 72 | 73 | total_cache = List.assoc "total_cache" l; 74 | total_rss = List.assoc "total_rss" l; 75 | total_mapped_file = List.assoc "total_mapped_file" l; 76 | total_pgpgin = List.assoc "total_pgpgin" l; 77 | total_pgpgout = List.assoc "total_pgpgout" l; 78 | total_swap = List.assoc "total_swap" l; 79 | total_active_anon = List.assoc "total_active_anon" l; 80 | total_inactive_anon = List.assoc "total_inactive_anon" l; 81 | total_active_file = List.assoc "total_active_file" l; 82 | total_inactive_file = List.assoc "total_incative_file" l; 83 | total_unevictable = List.assoc "total_unevictable" l; 84 | 85 | hierarchical_memory_limit = List.assoc "hierarchical_memory_limit" l; 86 | hierarchical_memsw_limit = List.assoc "hierarchical_memsw_limit" l; 87 | } 88 | with Not_found -> raise (Invalid_argument "stat_of_string")) 89 | 90 | type oom_control = { 91 | oom_kill_disable : bool; 92 | under_oom : bool; 93 | } 94 | 95 | let oom_converter = Converter.rw 96 | (fun s -> let l = Converter.(read (list ~sep:'\n' (pair ~sep:' ' string bool))) s in 97 | { oom_kill_disable = List.assoc "oom_kill_disable" l; 98 | under_oom = List.assoc "under_oom" l; }) 99 | (fun o -> Converter.(write bool) o.oom_kill_disable) 100 | 101 | let stat = CGParameters.mk_get t "stat" stat_converter 102 | 103 | let usage_in_bytes = CGParameters.mk_get t "usage_in_bytes" Converter.int 104 | let memsw_usage_in_bytes = CGParameters.mk_get t "memsw.usage_in_bytes" Converter.int 105 | 106 | let max_usage_in_bytes = CGParameters.mk_get t "max_usage_in_bytes" Converter.int 107 | let memsw_max_usage_in_bytes = CGParameters.mk_get t "memsw.usage_in_bytes" Converter.int 108 | 109 | let limit_in_bytes = CGParameters.mk_set t "limit_in_bytes" Converter.int 110 | let memsw_limit_in_bytes = CGParameters.mk_set t "memsw.limit_in_bytes" Converter.int 111 | 112 | let failcnt = CGParameters.mk_get t "failcnt" Converter.int 113 | let memsw_failcnt = CGParameters.mk_get t "memsw.fail_cnt" Converter.int 114 | 115 | let soft_limit_in_bytes = CGParameters.mk_set t "soft_limit_in_bytes" Converter.int 116 | 117 | let force_empty = CGParameters.mk_reset t "force_empty" Converter.int "0" 118 | 119 | let swappiness = CGParameters.mk_set t "swappiness" Converter.int 120 | 121 | let move_charge_at_immigrate = CGParameters.mk_set t "move_charge_at_immigrate" Converter.bool 122 | 123 | let use_hierarchy = CGParameters.mk_set t "use_hierarchy" Converter.bool 124 | 125 | let oom_control = CGParameters.mk_set t "oom_control" oom_converter 126 | 127 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ocaml-cgroups 2 | 3 | This is still a BETA version 4 | 5 | OCaml interface to the control groups. Control groups are a way 6 | of grouping together processes (into cgroups) in order to be able to 7 | compute and/or restrict the behavior of said groups of processes. 8 | As such, cgroups allow to keep track of processes memory allocation, 9 | cpu time, input/output, etc ... 10 | 11 | For further documentation, a good resource is: 12 | https://access.redhat.com/documentation/en-US/Red_Hat_Enterprise_Linux/6/html/Resource_Management_Guide/ch01.html 13 | 14 | Since cgroups interaction is done via the filesystem, some permissions 15 | are needed to perform certain actions, such as creating a cgroup, attaching 16 | a process to a cgroup, or setting values for parameters. 17 | 18 | ## Basics about cgroups 19 | 20 | Hierarchies are trees of cgroups, hierarchies are completely independent from one another, 21 | except for some limitations concerning subsystems. Subsystems (or controllers) are mechanisms for gathering 22 | statistics about process and/or restricting their behavior. Each subsystem is typically 23 | attached to only one hierarchy. A cgroup is a node in a hierarchy. Each cgroup has a list 24 | of processes attached to the cgroup. In a hierarchy, every process belongs to exactly one cgroup. 25 | 26 | Spawned processes are automatically attached to the same cgroups as their parents, but 27 | nothing prevents to move them to other cgroups afterward. 28 | 29 | Standard subsystems include: 30 | 31 | - memory: a subsystem to gather information about memory resources used by a program; 32 | can also set soft and hard limits to the memory consumption of programs 33 | - cpu: a subsystem to control scheduling of cpus among cgroups 34 | - cpuacct: a subsystem that gathers information about cpu resources used by processes 35 | - cpuset: a subsystem to assign individual cpus and memory nodes to process in cgroups 36 | 37 | ## Examples 38 | 39 | Let's say you want to limit the resources used by a program `P` and its children. 40 | You may want to limit the memory used, as well as keep track of the cpu resources 41 | used, so that you may send a signal to the process if it exceeds a certain amount. 42 | 43 | For that, we need to use two subsystems which are the 'memory' and 'cpuacct' subsystems. 44 | We then need to find the hierarchies to which they are attached (which will most likely 45 | be distinct), and within each hierarchy, find a cgroup to which attach the process we want 46 | to observe. For this example, we will suppose such a group already exists, and is named 47 | foobar (see following section on the creation of cgroups). 48 | 49 | Now that we have our cgroups, we will need to attach `P` to them, this is done 50 | via the `Hierarchy.add_process` function. Please note that it is only `P` that we 51 | add to the cgroup, so if at that moment, `P` has already spawned children, they 52 | will NOT be added to the cgroup; however, once `P` is in the cgroup, the children 53 | it spawns will automatically belongs to the same cgroup as `P`. 54 | 55 | Once `P` belongs to the cgroup, subsystems will start to gather information about 56 | its execution (such as cpu time used, memory used, etc..). It can be accessed 57 | using the predefined subsystem parameters in the `Subsystem.Memory` and 58 | `Subsystem.Cpuacct` modules. 59 | 60 | ```ocaml 61 | open Cgroups 62 | 63 | (* This call tries and find the hieracrhy attached to a subsystem, and then 64 | go down the hierarchy to find the specified cgroup. Is the specified 65 | cgroup does not exists, it will raises Invalid_argument *) 66 | let memory_cgroup = Hierarchy.find_exn "memory:/foobar" in 67 | let cpuacct_cgroup = Hierarchy.find_exn "cpuacct:/foobar" in 68 | 69 | (* Replace this by whatever pid you want *) 70 | let pid = Unix.getpid () in 71 | 72 | (* We add a process to the cgroups *) 73 | Hierarchy.add_process memory_cgroup pid; 74 | Hierarchy.add_process cpuacct_cgroup pid; 75 | 76 | (* We can get the total cpu time (in nanoseconds) used by all processes in 77 | a cgroup (and processes in the children of the cgroups, etc..) *) 78 | let _totat_cpu_time = Subsystem.Param.get Subsystem.Cpuacct.usage cpuacct_cgroup in 79 | 80 | (* We can also get the memory used by tasks in the cgroup (strictly, i.e includes tasks 81 | in the cgroup but not tasks in children of the cgroup), etc ... *) 82 | let _memory_used = Subsystem.Param.get Subsystem.Memory.usage_in_bytes memory_cgroup in 83 | 84 | (* We can set also limit memory usage to 1G *) 85 | Subsystem.Param.set Subsystem.Memory.limit_in_bytes memory_cgroup 1_000_000_000; 86 | (* This line limits RAM + Swap usage to 2G *) 87 | Subsystem.Param.set Subsystem.Memory.memsw_limit_in_bytes memory_cgroup 2_000_000_000; 88 | 89 | ``` 90 | 91 | ## Creation of cgroups 92 | 93 | As mentioned previously, all interactions with cgroups is done via the filesystem, 94 | which may bring some annoying problems about permission sometimes. For instance, 95 | most hierarchies and groups are only writable by `root` by default, which 96 | prevent users from creating new cgroups, editing limits, or moving tasks to cgroups. 97 | 98 | ### Using libcg 99 | 100 | The `libcg` (or `libcgroup`) package provides some tools to manipulate cgroups a bit more easily. 101 | In order to create the memory cgroups used in the example above, you may do: 102 | 103 | ``` 104 | cgcreate -a user:group -t user:group -g memory:foobar 105 | ``` 106 | 107 | ### Manually 108 | 109 | Or alternatively, you can do it by hand, though it requires a bit more work. First you have 110 | to identify the mountpoint of the hierarchy associated to the memory controller. You 111 | can do it by looking at mount points (i.e `mount` or `cat /proc/mounts`), and look for a line 112 | like : 113 | 114 | ``` 115 | cgroup on /sys/fs/cgroup/memory type cgroup (rw,nosuid,nodev,noexec,relatime,memory) 116 | ``` 117 | 118 | You can then create the appropriate directory and set the owner and permissions as desired, 119 | using the following commands (you may need root permission to do this). 120 | 121 | ``` 122 | mkdir /sys/fs/cgroup/memory/foobar 123 | chown -R user:group /sys/fs/cgroup/memory/foobar 124 | ``` 125 | 126 | ## Other resources 127 | 128 | You can also take a look at the following link for some interesting 129 | explanation about cgroups: 130 | https://www.kernel.org/doc/Documentation/cgroups/cgroups.txt 131 | 132 | 133 | -------------------------------------------------------------------------------- /hierarchy/hierarchy.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Copyright (c) 2015, Guillaume Bury 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | type t = { 28 | mount : string; 29 | subsystems : CGSubsystem.t list; 30 | } 31 | 32 | let equal t t' = t.mount = t'.mount 33 | 34 | type cgroup = { 35 | name : string; 36 | path : string; 37 | hierarchy : t; 38 | } 39 | 40 | let cgroup_equal g g' = g.path = g'.path 41 | 42 | let mk_t mount subsystems = 43 | assert (List.for_all (fun s -> s.CGSubsystem.enabled) subsystems); 44 | { mount; subsystems } 45 | 46 | let mk_cgroup name path hierarchy = 47 | { name; path; hierarchy; } 48 | 49 | (* Test *) 50 | let is_root g = g.name = "" 51 | 52 | (* Access function *) 53 | let root h = mk_cgroup "" h.mount h 54 | 55 | let name g = g.name 56 | let path g = g.path 57 | let subsys g = g.hierarchy.subsystems 58 | 59 | (* Generating hierarchies *) 60 | let scan subsys = 61 | let rec aux ch acc = 62 | match input_line ch with 63 | | exception End_of_file -> acc 64 | | s -> 65 | begin match Util.split ~seps:[' '; '\t'] s with 66 | | ["cgroup"; path; "cgroup"; opts; _; _] -> 67 | let l_opts = Util.split ~seps:[','] opts in 68 | begin match List.filter (fun x -> List.mem x.CGSubsystem.name l_opts) subsys with 69 | | [] -> aux ch acc 70 | | l -> aux ch (mk_t path l :: acc) 71 | end 72 | | _ -> aux ch acc 73 | end 74 | in 75 | let ch = open_in "/proc/mounts" in 76 | let res = aux ch [] in 77 | close_in ch; 78 | res 79 | 80 | let children g = 81 | Util.fold_dir (fun s acc -> 82 | let f = Filename.concat g.path s in 83 | let stats = Unix.stat f in 84 | if stats.Unix.st_kind = Unix.S_DIR then begin 85 | let cg = mk_cgroup s f g.hierarchy in 86 | cg :: acc 87 | end else 88 | acc) g.path [] 89 | 90 | let rec follow c = function 91 | | [] -> c, [] 92 | | (child :: r) as l -> 93 | begin match List.filter (fun s -> s.name = child) (children c) with 94 | | [ c' ] -> follow c' r 95 | | [] -> c, l 96 | | _ -> assert false 97 | end 98 | 99 | (* Modifying hierarchies *) 100 | let make_sub ?id ?a ?t ~perm parent name = 101 | let path = Filename.concat parent.path name in 102 | if Sys.file_exists path then 103 | raise (Invalid_argument "Hierachy.mk_sub") 104 | else begin 105 | Unix.mkdir path perm; 106 | Util.Opt.iter2 (Unix.chown path) id; 107 | Util.fold_dir (fun s () -> 108 | let full_path = Filename.concat path s in 109 | Util.Opt.iter2 (Unix.chown full_path) id; 110 | if s = "tasks" then 111 | Util.Opt.iter (Unix.chmod full_path) t 112 | else 113 | Util.Opt.iter (Unix.chmod full_path) a; 114 | ) path (); 115 | mk_cgroup name path parent.hierarchy 116 | end 117 | 118 | let rec make_aux ?id ?a ?t ~perm curr = function 119 | | child :: r -> make_aux ?id ?a ?t ~perm 120 | (make_sub ?id ?a ?t ~perm curr child) r 121 | | [] -> curr 122 | 123 | let make ?id ?a ?t ~perm parent path = 124 | match Util.split ~seps:['/'] path with 125 | | [] -> parent 126 | | (first :: _) as l -> 127 | if List.exists (fun s -> s.name = first) (children parent) then 128 | raise (Invalid_argument "Hierarchy.make") 129 | else 130 | make_aux ?id ?a ?t ~perm parent l 131 | 132 | (* Easy access *) 133 | let get (sub, path) = 134 | match scan [sub] with 135 | | [h] -> Some (follow (root h) (Util.split ~seps:['/'] path)) 136 | | _ -> None 137 | 138 | let find_aux s = 139 | let args = match Util.split ~seps:[':'] s with 140 | | [ sub ] -> Some (CGSubsystem.find sub, "") 141 | | [ sub; path ] -> Some (CGSubsystem.find sub, path) 142 | | _ -> None 143 | in 144 | Util.Opt.bind get args 145 | 146 | let find s = 147 | match find_aux s with 148 | | Some (res, []) -> Some res 149 | | _ -> None 150 | 151 | let find_exn s = 152 | match find s with 153 | | Some c -> c 154 | | None -> raise (Invalid_argument "find_exn") 155 | 156 | let find_or_create ?id ?a ?t ~perm s = 157 | match find_aux s with 158 | | Some (c, l) -> make_aux ?id ?a ?t ~perm c l 159 | | None -> raise (Invalid_argument "find_and_create") 160 | 161 | (* Cgroups and processes *) 162 | let processes g = 163 | let rec aux ch acc = match input_line ch with 164 | | exception End_of_file -> close_in ch; acc 165 | | s -> aux ch (int_of_string s :: acc) 166 | in 167 | aux (open_in (Filename.concat g.path "tasks")) [] 168 | 169 | let add_process g pid = 170 | let ch = open_out (Filename.concat g.path "tasks") in 171 | output_string ch (string_of_int pid); 172 | close_out ch 173 | 174 | let process_info pid = 175 | let rec aux ch acc = 176 | match input_line ch with 177 | | exception End_of_file -> close_in ch; acc 178 | | s -> 179 | begin match Util.split ~seps:[':'] s with 180 | | [id; _; path] -> aux ch ((int_of_string id, path) :: acc) 181 | | _ -> aux ch acc 182 | end 183 | in 184 | let l = aux (open_in (Format.asprintf "/proc/%d/cgroup" pid)) [] in 185 | let subs = CGSubsystem.find_all () in 186 | List.fold_left (fun acc (id, path) -> 187 | match List.find (fun s -> s.CGSubsystem.id = id) subs with 188 | | exception Not_found -> acc 189 | | sub -> 190 | begin match get (sub, path) with 191 | | Some (g, []) -> g :: acc | _ -> acc 192 | end 193 | ) [] l 194 | 195 | --------------------------------------------------------------------------------