Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Implement flock on Windows with LockFileEx + 'dune clean' fix on Windows #6523

Merged
merged 6 commits into from
Nov 20, 2022
+57 −68
Merged

Implement flock on Windows with LockFileEx + 'dune clean' fix on Windows #6523

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
feda372
Implement flock on Windows with LockFileEx
nojb Nov 19, 2022
a239ec1
Register all params using CAMLparam
nojb Nov 19, 2022
af3e076
Windows: allow deleting the lock while open
nojb Nov 19, 2022
a71b83a
CHANGES.md
nojb Nov 19, 2022
f158524
Formatting
nojb Nov 19, 2022
088663e
Merge branch 'main' into win_flock
nojb Nov 20, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
56 changes: 44 additions & 12 deletions src/dune_util/dune_flock.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,17 +3,53 @@
#include <caml/threads.h>
#include <caml/unixsupport.h>

#ifndef _WIN32
#ifdef _WIN32

#define FD_val(value) Handle_val(value)

CAMLprim value dune_flock_lock(value v_fd, value v_block, value v_exclusive) {
CAMLparam2(v_fd, v_block);
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why did you skip v_exclusive?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Good question: actually I copy-pasted from the Unix implementation below. I will add it (in both places). Or we could remove v_block from both places (both v_block and v_exclusive are booleans).

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Fixed.

OVERLAPPED overlapped = { 0 };
DWORD ok, dwFlags = 0;
if (Bool_val(v_exclusive)) {
dwFlags |= LOCKFILE_EXCLUSIVE_LOCK;
}
if (!Bool_val(v_block)) {
dwFlags |= LOCKFILE_FAIL_IMMEDIATELY;
}
caml_release_runtime_system();
ok = LockFileEx(FD_val(v_fd), dwFlags, 0, MAXDWORD, MAXDWORD, &overlapped);
caml_acquire_runtime_system();

if (!ok) {
win32_maperr(GetLastError());
uerror("LockFileEx", Nothing);
}

CAMLreturn(Val_unit);
}

CAMLprim value dune_flock_unlock(value v_fd) {
CAMLparam1(v_fd);
OVERLAPPED overlapped = { 0 };
DWORD ok;
caml_release_runtime_system();
ok = UnlockFileEx(FD_val(v_fd), 0, MAXDWORD, MAXDWORD, &overlapped);
caml_acquire_runtime_system();
if (!ok) {
win32_maperr(GetLastError());
uerror("UnlockFileEx", Nothing);
}
CAMLreturn(Val_unit);
}

#else /* _WIN32 */

#include <sys/file.h>
#endif

#define FD_val(value) Int_val(value)

CAMLprim value dune_flock_lock(value v_fd, value v_block, value v_exclusive) {
#ifdef _WIN32
caml_failwith("no flock on win32");
return Val_unit;
#else
CAMLparam2(v_fd, v_block);
int flags = 0;
if (Bool_val(v_exclusive)) {
Expand All @@ -30,14 +66,9 @@ CAMLprim value dune_flock_lock(value v_fd, value v_block, value v_exclusive) {
} else {
uerror("flock", Nothing);
}
#endif
}

CAMLprim value dune_flock_unlock(value v_fd) {
#ifdef _WIN32
caml_failwith("no flock on win32");
return Val_unit;
#else
CAMLparam1(v_fd);
caml_release_runtime_system();
int ret = flock(FD_val(v_fd), LOCK_UN);
Expand All @@ -47,5 +78,6 @@ CAMLprim value dune_flock_unlock(value v_fd) {
} else {
uerror("flock", Nothing);
}
#endif
}

#endif /* _WIN32 */
2 changes: 1 addition & 1 deletion src/dune_util/flock.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ let lock_block t lock =
let lock_non_block t lock =
match gen_lock t ~block:false ~exclusive:(is_exclusive lock) with
| () -> Ok `Success
| exception Unix.Unix_error ((EWOULDBLOCK | EAGAIN), _, _) -> Ok `Failure
| exception Unix.Unix_error ((EWOULDBLOCK | EAGAIN | EACCES), _, _) -> Ok `Failure
| exception Unix.Unix_error (err, _, _) -> Error err

external unlock : t -> unit = "dune_flock_unlock"
Expand Down
55 changes: 2 additions & 53 deletions src/dune_util/global_lock.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,62 +14,13 @@ let with_timeout ~timeout f =
in
loop ()

module type S = sig
val lock : unit -> [ `Success | `Failure ]

val unlock : unit -> unit
end

let write_pid fd =
let pid = Int.to_string (Unix.getpid ()) in
let len = String.length pid in
let res = Unix.write fd (Bytes.of_string pid) 0 len in
assert (res = len)

module Win () : S = struct
let t = ref None

let create () =
Path.ensure_build_dir_exists ();
match
Unix.openfile
(Path.Build.to_string lock_file)
[ O_CREAT; O_EXCL; O_WRONLY ]
0o600
with
| exception _ -> None
| fd ->
Unix.set_close_on_exec fd;
write_pid fd;
Some fd

let () =
at_exit (fun () ->
match !t with
| None -> ()
| Some fd ->
Unix.close fd;
Path.rm_rf (Path.build lock_file))

let lock () =
match !t with
| Some _ -> `Success
| None -> (
match create () with
| None -> `Failure
| Some fd ->
t := Some fd;
`Success)

let unlock () =
match !t with
| None -> ()
| Some fd ->
Unix.close fd;
Path.rm_rf (Path.build lock_file)
end

module Unix () : S = struct
module Lock = struct
let t =
lazy
(Path.ensure_build_dir_exists ();
Expand All @@ -83,7 +34,7 @@ module Unix () : S = struct

let or_raise_unix ~name = function
| Ok s -> s
| Error _unix -> Code_error.raise "lock" [ ("name", Dyn.string name) ]
| Error error -> Code_error.raise "lock" [ ("name", Dyn.string name); ("error", Dyn.string (Unix.error_message error)) ]

let lock () =
let t = Lazy.force t in
Expand All @@ -98,8 +49,6 @@ module Unix () : S = struct
let unlock () = Lazy.force t |> Flock.unlock |> or_raise_unix ~name:"unlock"
end

module Lock = (val if Sys.win32 then (module Win ()) else (module Unix ()) : S)

let locked = ref false

let lock_exn ~timeout =
Expand Down