~ubuntu-branches/ubuntu/quantal/xen/quantal

« back to all changes in this revision

Viewing changes to .pc/upstream-23936:cdb34816a40a-rework/tools/ocaml/xenstored/perms.ml

  • Committer: Package Import Robot
  • Author(s): Chuck Short
  • Date: 2011-12-22 04:53:35 UTC
  • mfrom: (0.4.1) (1.3.2) (15.1.5 sid)
  • Revision ID: package-import@ubuntu.com-20111222045335-k2jy47lo9124o7e3
Tags: 4.1.2-2ubuntu1
* Merge from Debian testing.  Remaining changes:
    - libxenstore3.0: Conflict and replaces libxen3.
    - libxen-dev: Conflict and replaces libxen3-dev.
    - xenstore-utils: Conflict and replaces libxen3.
    - xen-utils-4.1: Conflict and replaces libxen3, python-xen-3.3,
      and xen-utils-4.1.
    - Make sure the LDFLAGS value passed is suitable for use by ld
      rather than gcc.
    - Dropped:
      - debian/patches/upstream-23044:d4ca456c0c25
      - debian/patches/upstream-23104:1976adbf2b80
      - debian/patches/upstream-changeset-23146.patch
      - debian/patches/upstream-changeset-23147.patch
      - debian/patches/xen-pirq-resubmit-irq.patch

Show diffs side-by-side

added added

removed removed

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