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 
18 type ('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  *)
23 let exnhook = ref None
24 
25 let 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. *)
36 let may f v =
37 	match v with Some x -> Some (f x) | None -> None
38 
39 (** default value to d if v is none. *)
40 let default d v =
41 	match v with Some x -> x | None -> d
42 
43 (** apply f on v if not none *)
44 let maybe f v =
45 	match v with None -> () | Some x -> f x
46 
47 module String = struct include String
48 
49 let of_char c = String.make 1 c
50 
51 let 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 
61 let 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' *)
69 let 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
72 end
73 
74 module Unixext = struct
75 
76 (** remove a file, but doesn't raise an exception if the file is already removed *)
77 let 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 *)
81 let 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 *)
85 let 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 !! *)
95 let 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 *)
116 let 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 
130 end
131