1(*
2 * Copyright (C) 2006-2007 XenSource Ltd.
3 * Copyright (C) 2008-2010 Citrix Ltd.
4 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
5 * Author Dave Scott <dave.scott@eu.citrix.com>
6 *
7 * This program is free software; you can redistribute it and/or modify
8 * it under the terms of the GNU Lesser General Public License as published
9 * by the Free Software Foundation; version 2.1 only. with the special
10 * exception on linking described in file LICENSE.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU Lesser General Public License for more details.
16 *)
17
18type ('a, 'b) either = Right of 'a | Left of 'b
19
20(** apply the clean_f function after fct function has been called.
21 * Even if fct raises an exception, clean_f is applied
22 *)
23let exnhook = ref None
24
25let finally fct clean_f =
26	let result = try
27		fct ();
28	with
29		exn ->
30		  (match !exnhook with None -> () | Some f -> f exn);
31		  clean_f (); raise exn in
32	clean_f ();
33	result
34
35(** if v is not none, apply f on it and return some value else return none. *)
36let may f v =
37	match v with Some x -> Some (f x) | None -> None
38
39(** default value to d if v is none. *)
40let default d v =
41	match v with Some x -> x | None -> d
42
43(** apply f on v if not none *)
44let maybe f v =
45	match v with None -> () | Some x -> f x
46
47module String = struct include String
48
49let of_char c = String.make 1 c
50
51let rec split ?limit:(limit=(-1)) c s =
52	let i = try String.index s c with Not_found -> -1 in
53	let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in
54	if i = -1 || nlimit = 0 then
55		[ s ]
56	else
57		let a = String.sub s 0 i
58		and b = String.sub s (i + 1) (String.length s - i - 1) in
59		a :: (split ~limit: nlimit c b)
60
61let fold_left f accu string =
62	let accu = ref accu in
63	for i = 0 to length string - 1 do
64		accu := f !accu string.[i]
65	done;
66	!accu
67
68(** True if string 'x' starts with prefix 'prefix' *)
69let startswith prefix x =
70	let x_l = String.length x and prefix_l = String.length prefix in
71	prefix_l <= x_l && String.sub x 0 prefix_l  = prefix
72end
73
74module Unixext = struct
75
76(** remove a file, but doesn't raise an exception if the file is already removed *)
77let unlink_safe file =
78	try Unix.unlink file with (* Unix.Unix_error (Unix.ENOENT, _ , _)*) _ -> ()
79
80(** create a directory but doesn't raise an exception if the directory already exist *)
81let mkdir_safe dir perm =
82	try Unix.mkdir dir perm with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
83
84(** create a directory, and create parent if doesn't exist *)
85let mkdir_rec dir perm =
86	let rec p_mkdir dir =
87		let p_name = Filename.dirname dir in
88		if p_name <> "/" && p_name <> "."
89		then p_mkdir p_name;
90		mkdir_safe dir perm in
91	p_mkdir dir
92
93(** daemonize a process *)
94(* !! Must call this before spawning any threads !! *)
95let daemonize () =
96	match Unix.fork () with
97	| 0 ->
98		if Unix.setsid () == -1 then
99			failwith "Unix.setsid failed";
100
101		begin match Unix.fork () with
102		| 0 ->
103			let nullfd = Unix.openfile "/dev/null" [ Unix.O_RDWR ] 0 in
104			begin try
105				Unix.dup2 nullfd Unix.stdin;
106				Unix.dup2 nullfd Unix.stdout;
107				Unix.dup2 nullfd Unix.stderr;
108			with exn -> Unix.close nullfd; raise exn
109			end;
110			Unix.close nullfd
111		| _ -> exit 0
112		end
113	| _ -> exit 0
114
115(** write a pidfile file *)
116let pidfile_write filename =
117	let fd = Unix.openfile filename
118	                       [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC; ]
119			       0o640 in
120	finally
121	(fun () ->
122		let pid = Unix.getpid () in
123		let buf = string_of_int pid ^ "\n" in
124		let len = String.length buf in
125		if Unix.write_substring fd buf 0 len <> len
126		then failwith "pidfile_write failed";
127	)
128	(fun () -> Unix.close fd)
129
130end
131