(******************************************************************************)
(* ocaml-fileutils: files and filenames common operations *)
(* *)
(* Copyright (C) 2003-2014, Sylvain Le Gall *)
(* *)
(* This library is free software; you can redistribute it and/or modify it *)
(* under the terms of the GNU Lesser General Public License as published by *)
(* the Free Software Foundation; either version 2.1 of the License, or (at *)
(* your option) any later version, with the OCaml static compilation *)
(* exception. *)
(* *)
(* This library is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *)
(* COPYING for more details. *)
(* *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this library; if not, write to the Free Software Foundation, *)
(* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *)
(******************************************************************************)
type who = [`User | `Group | `Other | `All]
type wholist = [ who | `List of who list ]
type permcopy = [`User | `Group | `Other]
type perm = [ `Read | `Write | `Exec | `ExecX | `Sticky | `StickyO ]
type permlist = [ perm | `List of perm list ]
type actionarg = [ permlist | permcopy ]
type action = [ `Set of actionarg | `Add of actionarg | `Remove of actionarg]
type actionlist = [ action | `List of action list ]
type clause = [ `User of actionlist | `Group of actionlist
| `Other of actionlist | `All of actionlist
| `None of actionlist ]
type t = clause list
let all_masks =
[
`User, `Sticky, 0o4000;
`User, `Exec, 0o0100;
`User, `Write, 0o0200;
`User, `Read, 0o0400;
`Group, `Sticky, 0o2000;
`Group, `Exec, 0o0010;
`Group, `Write, 0o0020;
`Group, `Read, 0o0040;
`Other, `StickyO, 0o1000;
`Other, `Exec, 0o0001;
`Other, `Write, 0o0002;
`Other, `Read, 0o0004;
]
let mask =
let module M =
Map.Make
(struct
type t = who * perm
let compare = Pervasives.compare
end)
in
let m =
List.fold_left
(fun m (who, prm, msk) -> M.add (who, prm) msk m)
M.empty all_masks
in
fun who prm ->
try
M.find (who, prm) m
with Not_found ->
0
let of_int i =
let user, group, other =
List.fold_left
(fun (user, group, other) (who, perm, mask) ->
if (i land mask) <> 0 then begin
match who with
| `User -> perm :: user, group, other
| `Group -> user, perm :: group, other
| `Other -> user, group, perm :: other
end else begin
(user, group, other)
end)
([], [], [])
all_masks
in
[`User (`Set (`List user));
`Group (`Set (`List group));
`Other (`Set (`List other))]
let to_string =
let perm =
function
| `Read -> "r"
| `Write -> "w"
| `Exec -> "x"
| `Sticky -> "s"
| `ExecX -> "X"
| `StickyO -> "t"
in
let permlist =
function
| `List lst -> String.concat "" (List.map perm lst)
| #perm as prm -> perm prm
in
let permcopy =
function
| `User -> "u"
| `Group -> "g"
| `Other -> "o"
in
let action act =
let sact, arg =
match act with
| `Set arg -> "=", arg
| `Add arg -> "+", arg
| `Remove arg -> "-", arg
in
let sarg =
match arg with
| #permlist as lst -> permlist lst
| #permcopy as prm -> permcopy prm
in
sact^sarg
in
let actionlist =
function
| `List lst -> String.concat "" (List.map action lst)
| #action as act -> action act
in
let clause cls =
let swho, lst =
match cls with
| `User lst -> "u", lst
| `Group lst -> "g", lst
| `Other lst -> "o", lst
| `All lst -> "a", lst
| `None lst -> "", lst
in
swho^(actionlist lst)
in
fun t -> String.concat "," (List.map clause t)
let apply ~is_dir ~umask i (t: t) =
let set who prm b i =
let m = mask who prm in
if b then i lor m else i land (lnot m)
in
let get who prm i =
let m = mask who prm in
(i land m) <> 0
in
let permlist _who i lst =
List.fold_left
(fun acc ->
function
| `Exec | `Read | `Write | `Sticky | `StickyO as a -> a :: acc
| `ExecX ->
if is_dir ||
List.exists (fun who -> get who `Exec i)
[`User; `Group; `Other] then
`Exec :: acc
else
acc)
[]
(match lst with
| `List lst -> lst
| #perm as prm -> [prm])
in
let permcopy _who i =
List.fold_left
(fun acc (who, prm, _) ->
if get who prm i then
prm :: acc
else
acc)
[] all_masks
in
let args who i =
function
| #permlist as lst -> permlist who i lst
| #permcopy as who -> permcopy who i
in
let rec action who i act =
match act with
| `Set arg ->
action who
(action who i (`Remove (`List (permcopy who i))))
(`Add arg)
| `Add arg ->
List.fold_left (fun i prm -> set who prm true i) i (args who i arg)
| `Remove arg ->
List.fold_left (fun i prm -> set who prm false i) i (args who i arg)
in
let actionlist who i lst =
match lst with
| `List lst -> List.fold_left (action who) i lst
| #action as act -> action who i act
in
let actionlist_none i lst =
let numask = lnot umask in
let arg_set_if_mask who i arg b =
List.fold_left
(fun i prm ->
if get who prm numask then
set who prm b i
else
i)
i (args who i arg)
in
List.fold_left
(fun i who ->
List.fold_left
(fun i ->
function
| `Set _ -> i
| `Add arg -> arg_set_if_mask who i arg true
| `Remove arg -> arg_set_if_mask who i arg false)
i
(match lst with
| `List lst -> lst
| #action as act -> [act]))
i [`User; `Group; `Other]
in
let rec clause i cls =
match cls with
| `User lst -> actionlist `User i lst
| `Group lst -> actionlist `Group i lst
| `Other lst -> actionlist `Other i lst
| `All lst ->
List.fold_left clause i [`User lst; `Group lst; `Other lst]
| `None lst -> actionlist_none i lst
in
List.fold_left clause i t