Skip to content

Instantly share code, notes, and snippets.

@lindig
Created October 6, 2016 12:45
Show Gist options
  • Save lindig/92057c920c553be7ef8741e9d366e496 to your computer and use it in GitHub Desktop.
Save lindig/92057c920c553be7ef8741e9d366e496 to your computer and use it in GitHub Desktop.
(* Creating a directory with a given ownership and permissions looks
simple until you take closer look. Many things can fail: you might
not have the permissions to create or modify it, the desired groups
and owners might not exist.
This library tries to be systematic about it and de-composes the
complex operation (implemented in [mk]) into many small operations
that are stringed together in a monad: [>>=] sequences operations
and [//=] (read as: "or-else") recovers from a previous error.
*)
type 'a t = Ok of 'a | Error of string
let return x = Ok x
let fail msg = Error msg
let error fmt = Printf.kprintf (fun msg -> Error msg) fmt
(* [bind] executes [f] unless we already hit an error. In that case
* the error is passed on. *)
let on_success (t: 'a t) (f: 'a -> 'b t) = match t with
| Ok x -> f x
| Error str -> Error str
(** [on_error] ignores the current error and executes [f]. If there is
* no error, [f] is not executed and the result is passed
* on. *)
let on_error t f = match t with
| Error str -> f str
| Ok x -> Ok x
(** [always[ ignores the current state (error or not) and carries on
with [f] *)
let always t f = f ()
(* Infix operators. [//=] binds stronger than [>>=]. Both associate to
the left *)
let ( >>= ) = on_success
let ( //= ) = on_error
let ( //* ) = always
let getgid group =
let open Unix in
try (getgrnam group).gr_gid |> return
with Not_found -> error "no such group: '%s'" group
let getuid user =
let open Unix in
try (getpwnam user).pw_uid |> return
with Not_found -> error "no such user: '%s'" user
let stat path =
let open Unix in
try Some (stat path) |> return
with Unix_error (ENOENT, _, _) -> return None
let chmod path perm =
let open Unix in
try chmod path perm |> return
with Unix_error(_,_,_) -> error "can't set permissions for '%s'" path
let chown path uid gid =
let open Unix in
try chown path uid gid |> return
with Unix_error(_,_,_) -> error "can't set uid/gid for '%s'" path
let is_dir st =
match st.Unix.st_kind with
| Unix.S_DIR -> return ()
| _ -> error "not a directory"
let has_owner uid st =
if st.Unix.st_uid = uid
then return ()
else error "expected uid = %d, found %d" uid st.Unix.st_uid
let has_group gid st =
if st.Unix.st_gid = gid
then return ()
else error "expected gid = %d, found %d" gid st.Unix.st_gid
let has_perm perm st =
if st.Unix.st_perm = perm
then return ()
else error "expected permissions 0o%o, found 0o%o" perm st.Unix.st_perm
let mkdir path perm =
let open Unix in
try
mkdir path perm |> return
with
Unix_error(_,_,_) -> error "can't create directory '%s'" path
let rmdir path =
let open Unix in
try
rmdir path |> return
with
Unix_error(_,_,_) -> error "can't remove directory '%s'" path
(** [mk] is the core of the implementation. It obtains the uid and gid
and checks whether at [path] a file/directory exists. In that case it
checks and corrects the permissions and ownership. Otherwise it creates
the desired directory. Note how [//=] is used to recover when a desired
property is missing. If creating a new [path] fails, it *)
let mk path perm user group =
getgid group >>= fun gid ->
getuid user >>= fun uid ->
stat path >>= function
| Some st -> (* path already exists *)
is_dir st >>= fun () ->
(has_owner uid st //= fun _ -> chown path uid gid) >>= fun () ->
(has_perm perm st //= fun _ -> chmod path perm) >>= fun () ->
(has_group gid st //= fun _ -> chown path uid gid)
(* improve error message, if we have an errror *)
//= fun msg -> error "fixing existing %s failed: %s" path msg
| None -> (* path does not exist *)
mkdir path perm >>= fun () ->
(chown path uid gid //= (fun msg -> rmdir path //* fun () -> fail msg)) (* improve error message, if we have an error *)
//= fun msg -> error "creating %s failed: %s" path msg
let at ~path ~perm ~user ~group =
try
mk path perm user group
with
e -> error "error creating '%s': %s" path (Printexc.to_string e)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment