1(*
2 * Copyright (C) 2006-2007 XenSource Ltd.
3 * Copyright (C) 2008      Citrix Ltd.
4 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU Lesser General Public License as published
8 * by the Free Software Foundation; version 2.1 only. with the special
9 * exception on linking described in file LICENSE.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 * GNU Lesser General Public License for more details.
15 *)
16
17open Printf
18open Stdext
19
20(* lists utils *)
21let filter_out filter l =
22  List.filter (fun x -> not (List.mem x filter)) l
23
24let filter_in filter l =
25  List.filter (fun x -> List.mem x filter) l
26
27let list_remove element l =
28  List.filter (fun e -> e != element) l
29
30let list_tl_multi n l =
31  let rec do_tl i x =
32    if i = 0 then x else do_tl (i - 1) (List.tl x)
33  in
34  do_tl n l
35
36(* string utils *)
37let get_hierarchy path =
38  let l = List.length path in
39  let revpath = List.rev path in
40  let rec sub i =
41    let x = List.rev (list_tl_multi (l - i) revpath) in
42    if i = l then [ x ] else x :: sub (i + 1)
43  in
44  sub 0
45
46let hexify s =
47  let hexseq_of_char c = sprintf "%02x" (Char.code c) in
48  let hs = Bytes.create (String.length s * 2) in
49  String.iteri (fun i c ->
50      let seq = hexseq_of_char c in
51      Bytes.set hs (i * 2) seq.[0];
52      Bytes.set hs (i * 2 + 1) seq.[1];
53    ) s;
54  Bytes.unsafe_to_string hs
55
56let unhexify hs =
57  let char_of_hexseq seq0 seq1 = Char.chr (int_of_string (sprintf "0x%c%c" seq0 seq1)) in
58  let b = Bytes.create (String.length hs / 2) in
59  for i = 0 to Bytes.length b - 1
60  do
61    Bytes.set b i (char_of_hexseq hs.[i * 2] hs.[i * 2 + 1])
62  done;
63  Bytes.unsafe_to_string b
64
65let trim_path path =
66  try
67    let rindex = String.rindex path '/' in
68    String.sub path 0 rindex
69  with
70    Not_found -> ""
71
72let join_by_null ls = String.concat "\000" ls
73
74(* unix utils *)
75let create_unix_socket name =
76  Unixext.unlink_safe name;
77  Unixext.mkdir_rec (Filename.dirname name) 0o700;
78  let sockaddr = Unix.ADDR_UNIX(name) in
79  let sock = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
80  Unix.bind sock sockaddr;
81  Unix.listen sock 1;
82  sock
83
84let read_file_single_integer filename =
85  let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0o640 in
86  let buf = Bytes.make 20 '\000' in
87  let sz = Unix.read fd buf 0 20 in
88  Unix.close fd;
89  int_of_string (Bytes.sub_string buf 0 sz)
90
91(* @path may be guest data and needs its length validating.  @connection_path
92 * is generated locally in xenstored and always of the form "/local/domain/$N/" *)
93let path_validate path connection_path =
94  let len = String.length path in
95
96  if len = 0 then raise Define.Invalid_path;
97
98  let abs_path =
99    match String.get path 0 with
100    | '/' | '@' -> path
101    | _   -> connection_path ^ path
102  in
103
104  (* Regardless whether client specified absolute or relative path,
105     	   canonicalize it (above) and, for domain-relative paths, check the
106     	   length of the relative part.
107
108     	   This prevents paths becoming invalid across migrate when the length
109     	   of the domid changes in @param connection_path.
110     	 *)
111  let len = String.length abs_path in
112  let on_absolute _ _ = len in
113  let on_relative _ offset = len - offset in
114  let len = Scanf.ksscanf abs_path on_absolute "/local/domain/%d/%n" on_relative in
115  if len > !Define.path_max then raise Define.Invalid_path;
116
117  abs_path
118
119module FD : sig
120  type t = Unix.file_descr
121  val of_int: int -> t
122  val to_int : t -> int
123end = struct
124  type t = Unix.file_descr
125  (* This is like Obj.magic but just for these types,
126     	   and relies on Unix.file_descr = int *)
127  external to_int : t -> int = "%identity"
128  external of_int : int -> t = "%identity"
129end
130