The unpac monorepo manager self-hosting as a monorepo using unpac
Add linkat support
Signed-off-by: Luca Seritan <luca.seritan@gmail.com>
Co-authored-by: Thomas Leonard <talex5@gmail.com>
Note: the flags don't currently work due to a Linux bug, so that test is
disabled for now: https://github.com/axboe/liburing/issues/955
authored by
Luca Seritan
Thomas Leonard
and committed by
Thomas Leonard
5566b1d2
5e54d7e7
+118
-4
+4
-3
vendor/opam/uring/lib/uring/include/discover.ml
+4
-3
vendor/opam/uring/lib/uring/include/discover.ml
···
139
139
"AT_EMPTY_PATH", Int;
140
140
"AT_NO_AUTOMOUNT", Int;
141
141
"AT_SYMLINK_NOFOLLOW", Int;
142
+
"AT_SYMLINK_FOLLOW", Int;
142
143
"AT_STATX_SYNC_AS_STAT", Int;
143
144
"AT_STATX_FORCE_SYNC", Int;
144
145
"AT_STATX_DONT_SYNC", Int;
···
199
200
] @ op_struct @ [
200
201
"end"
201
202
] @ [
202
-
"module Statx = struct";
203
-
" module Flags = struct";
203
+
"module At = struct";
204
204
] @ at_struct @ [
205
-
" end";
205
+
"end";
206
+
"module Statx = struct";
206
207
" module Mask = struct";
207
208
] @ mask_struct @ [
208
209
" end";
+2
vendor/opam/uring/lib/uring/primitives.h
+2
vendor/opam/uring/lib/uring/primitives.h
···
84
84
CAMLprim value ocaml_uring_submit_accept(value, value, value, value);
85
85
CAMLprim value ocaml_uring_submit_cancel(value, value, value);
86
86
CAMLprim value ocaml_uring_submit_openat2(value, value, value, value);
87
+
CAMLprim value ocaml_uring_submit_linkat_native(value, value, value, value, value, value, value);
88
+
CAMLprim value ocaml_uring_submit_linkat_byte(value *, int);
87
89
CAMLprim value ocaml_uring_submit_unlinkat(value, value, value, value, value);
88
90
CAMLprim value ocaml_uring_submit_send_msg(value, value, value, value, value);
89
91
CAMLprim value ocaml_uring_submit_recv_msg(value, value, value, value, value);
+15
-1
vendor/opam/uring/lib/uring/uring.ml
+15
-1
vendor/opam/uring/lib/uring/uring.ml
···
116
116
117
117
module Flags = struct
118
118
include Flags
119
-
include Config.Statx.Flags
119
+
include Config.At
120
120
end
121
121
122
122
module Attr = struct
···
329
329
external submit_accept : t -> id -> Unix.file_descr -> Sockaddr.t -> bool = "ocaml_uring_submit_accept" [@@noalloc]
330
330
external submit_cancel : t -> id -> id -> bool = "ocaml_uring_submit_cancel" [@@noalloc]
331
331
external submit_openat2 : t -> id -> Unix.file_descr -> Open_how.t -> bool = "ocaml_uring_submit_openat2" [@@noalloc]
332
+
external submit_linkat : t -> id -> Unix.file_descr -> Sketch.ptr -> Unix.file_descr -> Sketch.ptr -> int -> bool = "ocaml_uring_submit_linkat_byte" "ocaml_uring_submit_linkat_native" [@@noalloc]
332
333
external submit_unlinkat : t -> id -> Unix.file_descr -> Sketch.ptr -> bool -> bool = "ocaml_uring_submit_unlinkat" [@@noalloc]
333
334
external submit_send_msg : t -> id -> Unix.file_descr -> Msghdr.t -> Sketch.ptr -> bool = "ocaml_uring_submit_send_msg" [@@noalloc]
334
335
external submit_recv_msg : t -> id -> Unix.file_descr -> Msghdr.t -> Sketch.ptr -> bool = "ocaml_uring_submit_recv_msg" [@@noalloc]
···
464
465
in
465
466
let open_how = Open_how.v ~open_flags ~perm ~resolve path in
466
467
with_id_full t (fun id -> Uring.submit_openat2 t.uring id fd open_how) user_data ~extra_data:open_how
468
+
469
+
module Linkat_flags = struct
470
+
include Flags
471
+
let empty_path = Config.At.empty_path
472
+
let symlink_follow = Config.At.symlink_follow
473
+
end
474
+
475
+
let linkat t ?(old_dir_fd=at_fdcwd) ?(new_dir_fd=at_fdcwd) ~flags ~old_path ~new_path user_data =
476
+
with_id t (fun id ->
477
+
let old_path_buf = Sketch.String.alloc t.sketch old_path in
478
+
let new_path_buf = Sketch.String.alloc t.sketch new_path in
479
+
Uring.submit_linkat t.uring id old_dir_fd old_path_buf new_dir_fd new_path_buf flags
480
+
) user_data
467
481
468
482
let unlink t ~dir ?(fd=at_fdcwd) path user_data =
469
483
with_id t (fun id ->
+26
vendor/opam/uring/lib/uring/uring.mli
+26
vendor/opam/uring/lib/uring/uring.mli
···
251
251
@param perm sets the access control bits for newly created files (subject to the process's umask)
252
252
@param resolve controls how the pathname is resolved. *)
253
253
254
+
module Linkat_flags : sig
255
+
include FLAGS
256
+
257
+
val empty_path : t
258
+
(** If the old path is empty, link to old_dir_fd. *)
259
+
260
+
val symlink_follow : t
261
+
(** If the old path is a symlink, link its target. *)
262
+
end
263
+
264
+
val linkat : 'a t ->
265
+
?old_dir_fd:Unix.file_descr ->
266
+
?new_dir_fd:Unix.file_descr ->
267
+
flags:Linkat_flags.t ->
268
+
old_path:string ->
269
+
new_path:string ->
270
+
'a -> 'a job option
271
+
(** [linkat t ~flags ~old_path ~new_path] creates a new hard link.
272
+
273
+
If [new_path] already exists then it is not overwritten.
274
+
275
+
@param old_dir_fd If provided and [old_path] is a relative path, it is interpreted relative to [old_dir_fd].
276
+
@param new_dir_fd If provided and [new_path] is a relative path, it is interpreted relative to [new_dir_fd].
277
+
@param old_path Path of the already-existing link.
278
+
@param new_path Path for the newly created link. *)
279
+
254
280
val unlink : 'a t -> dir:bool -> ?fd:Unix.file_descr -> string -> 'a -> 'a job option
255
281
(** [unlink t ~dir ~fd path] removes the directory entry [path], which is resolved relative to [fd].
256
282
If [fd] is not given, then the current working directory is used.
+32
vendor/opam/uring/lib/uring/uring_stubs.c
+32
vendor/opam/uring/lib/uring/uring_stubs.c
···
1014
1014
1015
1015
return Val_unit;
1016
1016
}
1017
+
1018
+
value /* noalloc */
1019
+
ocaml_uring_submit_linkat_native(value v_uring, value v_id,
1020
+
value v_old_dir, value v_old_path,
1021
+
value v_new_dir, value v_new_path,
1022
+
value v_flags) {
1023
+
struct io_uring *ring = Ring_val(v_uring);
1024
+
char *old_path = Sketch_ptr_val(v_old_path);
1025
+
char *new_path = Sketch_ptr_val(v_new_path);
1026
+
struct io_uring_sqe *sqe = io_uring_get_sqe(ring);
1027
+
1028
+
if (!sqe)
1029
+
return Val_false;
1030
+
1031
+
io_uring_prep_linkat(sqe, Int_val(v_old_dir), old_path, Int_val(v_new_dir), new_path, Int_val(v_flags));
1032
+
io_uring_sqe_set_data(sqe, (void *)Long_val(v_id));
1033
+
1034
+
return Val_true;
1035
+
}
1036
+
1037
+
value
1038
+
ocaml_uring_submit_linkat_byte(value* values, int argc) {
1039
+
return ocaml_uring_submit_linkat_native(
1040
+
values[0],
1041
+
values[1],
1042
+
values[2],
1043
+
values[3],
1044
+
values[4],
1045
+
values[5],
1046
+
values[6]
1047
+
);
1048
+
}
+39
vendor/opam/uring/tests/main.md
+39
vendor/opam/uring/tests/main.md
···
810
810
- : unit = ()
811
811
```
812
812
813
+
## Linkat
814
+
815
+
```ocaml
816
+
# close_out (open_out "test-file");;
817
+
- : unit = ()
818
+
# Unix.symlink "test-file" "old-path";;
819
+
- : unit = ()
820
+
# let t : unit Uring.t = Uring.create ~queue_depth:2 ();;
821
+
val t : unit Uring.t = <abstr>
822
+
# Uring.linkat t ~old_path:"old-path" ~new_path:"new-symlink" ~flags:Uring.Linkat_flags.empty ();;
823
+
- : unit Uring.job option = Some <abstr>
824
+
# Uring.submit t;;
825
+
- : int = 1
826
+
# Uring.wait t;;
827
+
- : unit Uring.completion_option = Uring.Some {Uring.result = 0; data = ()}
828
+
# (Unix.lstat "new-symlink").st_kind;;
829
+
- : Unix.file_kind = Unix.S_LNK
830
+
```
831
+
832
+
This currently doesn't work due to https://github.com/axboe/liburing/issues/955:
833
+
834
+
# Uring.linkat t ~old_path:"old-path" ~new_path:"new-file" ~flags:Uring.Linkat_flags.symlink_follow ();;
835
+
- : unit Uring.job option = Some <abstr>
836
+
# Uring.submit t;;
837
+
- : int = 1
838
+
# Uring.wait t;;
839
+
- : unit Uring.completion_option = Uring.Some {Uring.result = 0; data = ()}
840
+
# (Unix.lstat "new-file").st_kind;;
841
+
- : Unix.file_kind = Unix.S_REG
842
+
843
+
# ["test-file"; "old-path"; "new-symlink"; "new-file"] |> List.iter Unix.unlink;;
844
+
845
+
```ocaml
846
+
# ["test-file"; "old-path"; "new-symlink"] |> List.iter Unix.unlink;;
847
+
- : unit = ()
848
+
# Uring.exit t;;
849
+
- : unit = ()
850
+
```
851
+
813
852
## Timeout
814
853
815
854
Timeout should return (-ETIME). This is defined in https://github.com/torvalds/linux/blob/master/include/uapi/asm-generic/errno.h#L45