1(*
2 * Copyright (C) 2006-2007 XenSource Ltd.
3 * Copyright (C) 2008      Citrix Ltd.
4 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
5 * Author Thomas Gazagnaire <thomas.gazagnaire@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
18let info fmt = Logging.info "perms" fmt
19
20open Stdext
21
22let activate = ref true
23
24type permty = READ | WRITE | RDWR | NONE
25
26let char_of_permty perm =
27	match perm with
28	| READ -> 'r'
29	| WRITE -> 'w'
30	| RDWR -> 'b'
31	| NONE -> 'n'
32
33let permty_of_char c =
34	match c with
35	| 'r' -> READ
36	| 'w' -> WRITE
37	| 'b' -> RDWR
38	| 'n' -> NONE
39	| _ -> invalid_arg "unknown permission type"
40
41
42(* node permissions *)
43module Node =
44struct
45
46type t =
47{
48	owner: Xenctrl.domid;
49	other: permty;
50	acl: (Xenctrl.domid * permty) list;
51}
52
53let create owner other acl =
54	{ owner = owner; other = other; acl = acl }
55
56let get_other perms = perms.other
57let get_acl perms = perms.acl
58let get_owner perm = perm.owner
59
60let default0 = create 0 NONE []
61
62let perm_of_string s =
63	let ty = permty_of_char s.[0]
64	and id = int_of_string (String.sub s 1 (String.length s - 1)) in
65	(id, ty)
66
67let of_strings ls =
68	let vect = List.map (perm_of_string) ls in
69	match vect with
70	| [] -> invalid_arg "permvec empty"
71	| h :: l -> create (fst h) (snd h) l
72
73(* [s] must end with '\000' *)
74let of_string s =
75	let ls = String.split '\000' s in
76	let ls = if ls = [] then ls else List.rev (List.tl (List.rev ls)) in
77	of_strings ls
78
79let string_of_perm perm =
80	Printf.sprintf "%c%u" (char_of_permty (snd perm)) (fst perm)
81
82let to_string permvec =
83	let l = ((permvec.owner, permvec.other) :: permvec.acl) in
84	String.concat "\000" (List.map string_of_perm l)
85
86end
87
88
89(* permission of connections *)
90module Connection =
91struct
92
93type elt = Xenctrl.domid * (permty list)
94type t =
95	{ main: elt;
96	  target: elt option; }
97
98let full_rights : t =
99	{ main = 0, [READ; WRITE];
100	  target = None }
101
102let create ?(perms=[NONE]) domid : t =
103	{ main = (domid, perms);
104	  target = None }
105
106let set_target (connection:t) ?(perms=[NONE]) domid =
107	{ connection with target = Some (domid, perms) }
108
109let get_owners (connection:t) =
110	match connection.main, connection.target with
111	| c1, Some c2 -> [ fst c1; fst c2 ]
112	| c1, None    -> [ fst c1 ]
113
114let is_owner (connection:t) id =
115	match connection.target with
116	| Some target -> fst connection.main = id || fst target = id
117	| None        -> fst connection.main = id
118
119let is_dom0 (connection:t) =
120	is_owner connection 0
121
122let elt_to_string (i,p) =
123	Printf.sprintf "%i%S" i (String.concat "" (List.map String.of_char (List.map char_of_permty p)))
124
125let to_string connection =
126	Printf.sprintf "%s%s" (elt_to_string connection.main) (default "" (may elt_to_string connection.target))
127end
128
129(* check if owner of the current connection and of the current node are the same *)
130let check_owner (connection:Connection.t) (node:Node.t) =
131	if !activate && not (Connection.is_dom0 connection)
132	then Connection.is_owner connection (Node.get_owner node)
133	else true
134
135(* check if the current connection has the requested perm on the current node *)
136let check (connection:Connection.t) request (node:Node.t) =
137	let check_acl domainid =
138		let perm =
139			if List.mem_assoc domainid (Node.get_acl node)
140			then List.assoc domainid (Node.get_acl node)
141			else Node.get_other node
142		in
143		match perm, request with
144		| NONE, _ ->
145			info "Permission denied: Domain %d has no permission" domainid;
146			false
147		| RDWR, _ -> true
148		| READ, READ -> true
149		| WRITE, WRITE -> true
150		| READ, _ ->
151			info "Permission denied: Domain %d has read only access" domainid;
152			false
153		| WRITE, _ ->
154			info "Permission denied: Domain %d has write only access" domainid;
155			false
156	in
157	if !activate
158	&& not (Connection.is_dom0 connection)
159	&& not (check_owner connection node)
160	&& not (List.exists check_acl (Connection.get_owners connection))
161	then raise Define.Permission_denied
162
163let equiv perm1 perm2 =
164	(Node.to_string perm1) = (Node.to_string perm2)
165