The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #65 from talex5/unlink
Add unlink
authored by
Christiano Haesbaert
and committed by
GitHub
f518db89
d57bc334
+79
+16
lib/uring/uring.ml
+16
lib/uring/uring.ml
···
175
175
set ptr csl;
176
176
ptr
177
177
end
178
+
179
+
module String = struct
180
+
external set : ptr -> string -> unit = "ocaml_uring_set_string" [@@noalloc]
181
+
182
+
let alloc t s =
183
+
let ptr = alloc t (String.length s + 1) in
184
+
set ptr s;
185
+
ptr
186
+
end
178
187
end
179
188
180
189
(* Used for the sendmsg/recvmsg calls. Liburing doesn't support sendto/recvfrom at the time of writing. *)
···
228
237
external submit_accept : t -> id -> Unix.file_descr -> Sockaddr.t -> bool = "ocaml_uring_submit_accept" [@@noalloc]
229
238
external submit_cancel : t -> id -> id -> bool = "ocaml_uring_submit_cancel" [@@noalloc]
230
239
external submit_openat2 : t -> id -> Unix.file_descr -> Open_how.t -> bool = "ocaml_uring_submit_openat2" [@@noalloc]
240
+
external submit_unlinkat : t -> id -> Unix.file_descr -> Sketch.ptr -> bool -> bool = "ocaml_uring_submit_unlinkat" [@@noalloc]
231
241
external submit_send_msg : t -> id -> Unix.file_descr -> Msghdr.t -> Sketch.ptr -> bool = "ocaml_uring_submit_send_msg" [@@noalloc]
232
242
external submit_recv_msg : t -> id -> Unix.file_descr -> Msghdr.t -> Sketch.ptr -> bool = "ocaml_uring_submit_recv_msg" [@@noalloc]
233
243
···
357
367
in
358
368
let open_how = Open_how.v ~open_flags ~perm ~resolve path in
359
369
with_id_full t (fun id -> Uring.submit_openat2 t.uring id fd open_how) user_data ~extra_data:open_how
370
+
371
+
let unlink t ~dir ?(fd=at_fdcwd) path user_data =
372
+
with_id t (fun id ->
373
+
let buf = Sketch.String.alloc t.sketch path in
374
+
Uring.submit_unlinkat t.uring id fd buf dir
375
+
) user_data
360
376
361
377
let read t ~file_offset fd (buf : Cstruct.t) user_data =
362
378
with_id_full t (fun id -> Uring.submit_read t.uring fd id buf file_offset) user_data ~extra_data:buf
+7
lib/uring/uring.mli
+7
lib/uring/uring.mli
···
145
145
@param perm sets the access control bits for newly created files (subject to the process's umask)
146
146
@param resolve controls how the pathname is resolved. *)
147
147
148
+
val unlink : 'a t -> dir:bool -> ?fd:Unix.file_descr -> string -> 'a -> 'a job option
149
+
(** [unlink t ~dir ~fd path] removes the directory entry [path], which is resolved relative to [fd].
150
+
If [fd] is not given, then the current working directory is used.
151
+
If [path] is a symlink, the link is removed, not the target.
152
+
@param dir If [true], this acts like [rmdir] (only removing empty directories).
153
+
If [false], it acts like [unlink] (only removing non-directories). *)
154
+
148
155
module Poll_mask : sig
149
156
include FLAGS
150
157
+23
lib/uring/uring_stubs.c
+23
lib/uring/uring_stubs.c
···
33
33
#include <string.h>
34
34
#include <poll.h>
35
35
#include <sys/uio.h>
36
+
#include <fcntl.h>
37
+
#include <unistd.h>
36
38
37
39
#undef URING_DEBUG
38
40
#ifdef URING_DEBUG
···
606
608
sqe = io_uring_get_sqe(ring);
607
609
if (!sqe) return (Val_false);
608
610
io_uring_prep_accept(sqe, Int_val(v_fd), &(addr->sock_addr_addr.s_gen), &addr->sock_addr_len, SOCK_CLOEXEC);
611
+
io_uring_sqe_set_data(sqe, (void *)Long_val(v_id));
612
+
return (Val_true);
613
+
}
614
+
615
+
value /* noalloc */
616
+
ocaml_uring_set_string(value v_sketch_ptr, value v_string)
617
+
{
618
+
char *dst = Sketch_ptr_val(v_sketch_ptr);
619
+
strcpy(dst, String_val(v_string));
620
+
return (Val_unit);
621
+
}
622
+
623
+
// Caller must ensure the path pointed to by v_sketch_ptr is not GC'd until the job is finished.
624
+
value /* noalloc */
625
+
ocaml_uring_submit_unlinkat(value v_uring, value v_id, value v_fd, value v_sketch_ptr, value v_rmdir) {
626
+
struct io_uring *ring = Ring_val(v_uring);
627
+
struct io_uring_sqe *sqe = io_uring_get_sqe(ring);
628
+
int flags = Bool_val(v_rmdir) ? AT_REMOVEDIR : 0;
629
+
char *path = Sketch_ptr_val(v_sketch_ptr);
630
+
if (!sqe) return (Val_false);
631
+
io_uring_prep_unlinkat(sqe, Int_val(v_fd), path, flags);
609
632
io_uring_sqe_set_data(sqe, (void *)Long_val(v_id));
610
633
return (Val_true);
611
634
}
+33
tests/main.md
+33
tests/main.md
···
738
738
- : unit = ()
739
739
```
740
740
741
+
## Unlink and rmdir
742
+
743
+
```ocaml
744
+
# let t : unit Uring.t = Uring.create ~queue_depth:2 ();;
745
+
val t : unit Uring.t = <abstr>
746
+
747
+
# close_out (open_out "test-file"); Unix.mkdir "test-dir" 0o700;;
748
+
- : unit = ()
749
+
750
+
# let check () = Sys.file_exists "test-file", Sys.file_exists "test-dir";;
751
+
val check : unit -> bool * bool = <fun>
752
+
# check ();;
753
+
- : bool * bool = (true, true)
754
+
755
+
# Uring.unlink t ~dir:false "test-file" ();;
756
+
- : unit Uring.job option = Some <abstr>
757
+
758
+
# Uring.unlink t ~dir:true "test-dir" ();;
759
+
- : unit Uring.job option = Some <abstr>
760
+
761
+
# Uring.wait t;;
762
+
- : unit Uring.completion_option = Uring.Some {Uring.result = 0; data = ()}
763
+
764
+
# Uring.wait t;;
765
+
- : unit Uring.completion_option = Uring.Some {Uring.result = 0; data = ()}
766
+
767
+
# check ();;
768
+
- : bool * bool = (false, false)
769
+
770
+
# Uring.exit t;;
771
+
- : unit = ()
772
+
```
773
+
741
774
## Sketch allocation
742
775
```ocaml
743
776
let ldup n x = List.init n (Fun.const x)