Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 7c62863b04
Fetching contributors…

Cannot retrieve contributors at this time

file 70 lines (63 sloc) 1.903 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
(*
* Copyright (C) Citrix Systems Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation; version 2.1 only. with the special
* exception on linking described in file LICENSE.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)

open Stringext
open Xenops_interface.Vbd

(* ionice invocations apply a 'class' and a 'parameter' to a process *)
let to_class_param =
let to_param = function
| Highest -> 0
| High -> 2
| Normal -> 4
| Low -> 6
| Lowest -> 7
| Other x -> x in
function
| RealTime x -> 1, (to_param x)
| Idle -> 3, (to_param Lowest)
| BestEffort x -> 2, (to_param x)

let of_class_param_exn cls param =
let param = match param with
| "7" -> Lowest
| "6" -> Low
| "4" -> Normal
| "2" -> High
| "0" -> Highest
| x -> Other (int_of_string x) in
match cls with
| "idle"
| "3" -> Idle
| "realtime"
| "1" -> RealTime param
| "best-effort"
| "2" -> BestEffort param
| _ -> raise Not_found (* caught below *)

exception Parse_failed of string

let parse_result_exn s : qos_scheduler option =
try
match String.split ' ' (String.strip String.isspace s) with
| [ cls_colon; "prio"; param ] ->
let cls = String.sub cls_colon 0 (String.length cls_colon - 1) in
Some (of_class_param_exn cls param)
| _ ->
raise (Parse_failed s)
with _ ->
raise (Parse_failed s)

let set_args qos pid =
let cls, param = to_class_param qos in
[
Printf.sprintf "-c%d" cls;
Printf.sprintf "-n%d" param;
Printf.sprintf "-p%d" pid
]

let get_args pid = [ Printf.sprintf "-p%d" pid ]
Something went wrong with that request. Please try again.