The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #95 from patricoferris/stat
Initial statx support
authored by
Thomas Leonard
and committed by
GitHub
1c9529b6
a2924251
+401
-5
+54
vendor/opam/uring/lib/uring/include/discover.ml
+54
vendor/opam/uring/lib/uring/include/discover.ml
···
109
109
| _ -> assert false
110
110
)
111
111
in
112
+
let at_flags, mask_flags =
113
+
C.C_define.import c ~c_flags:["-D_GNU_SOURCE"; "-I"; Filename.concat (Sys.getcwd ()) "include"]
114
+
~prelude:{|#include <sys/stat.h>
115
+
#ifndef STATX_TYPE
116
+
#include <linux/stat.h>
117
+
#endif|}
118
+
~includes:["fcntl.h" ]
119
+
C.C_define.Type.[
120
+
"AT_EMPTY_PATH", Int;
121
+
"AT_NO_AUTOMOUNT", Int;
122
+
"AT_SYMLINK_NOFOLLOW", Int;
123
+
"AT_STATX_SYNC_AS_STAT", Int;
124
+
"AT_STATX_FORCE_SYNC", Int;
125
+
"AT_STATX_DONT_SYNC", Int;
126
+
127
+
"STATX_TYPE", Int;
128
+
"STATX_MODE", Int;
129
+
"STATX_NLINK", Int;
130
+
"STATX_UID", Int;
131
+
"STATX_GID", Int;
132
+
"STATX_ATIME", Int;
133
+
"STATX_MTIME", Int;
134
+
"STATX_CTIME", Int;
135
+
"STATX_INO", Int;
136
+
"STATX_SIZE", Int;
137
+
"STATX_BLOCKS", Int;
138
+
"STATX_BASIC_STATS", Int;
139
+
"STATX_BTIME", Int;
140
+
]
141
+
|> List.fold_left (fun (ats, stats) (v, k) -> match String.split_on_char '_' v, k with
142
+
| "AT" :: name, C.C_define.Value.Int v ->
143
+
let ocaml_name = String.lowercase_ascii (String.concat "_" name) in
144
+
((ocaml_name, v) :: ats, stats)
145
+
| "STATX" :: name, C.C_define.Value.Int v ->
146
+
let name = String.concat "_" name |> String.lowercase_ascii in
147
+
let ocaml_name = match name with
148
+
| "type" -> "type'"
149
+
| v -> v
150
+
in
151
+
(ats, (ocaml_name, v) :: stats)
152
+
| _ -> assert false
153
+
) ([], [])
154
+
in
112
155
let op_sig = List.map (fun (name, _) -> Printf.sprintf " val %s : t" name) ops in
113
156
let op_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) ops in
157
+
let at_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) at_flags in
158
+
let mask_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) mask_flags in
114
159
C.Flags.write_lines "config.ml"
115
160
(defs @
116
161
["module Op : sig";
···
120
165
" type t = int"
121
166
] @ op_struct @ [
122
167
"end"
168
+
] @ [
169
+
"module Statx = struct";
170
+
" module Flags = struct";
171
+
] @ at_struct @ [
172
+
" end";
173
+
" module Mask = struct";
174
+
] @ mask_struct @ [
175
+
" end";
176
+
"end"
123
177
])
124
178
)
+59
vendor/opam/uring/lib/uring/uring.ml
+59
vendor/opam/uring/lib/uring/uring.ml
···
86
86
let pollhup = Config.pollhup
87
87
end
88
88
89
+
module Statx = struct
90
+
type internal
91
+
92
+
type kind = [
93
+
| `Unknown
94
+
| `Fifo
95
+
| `Character_special
96
+
| `Directory
97
+
| `Block_device
98
+
| `Regular_file
99
+
| `Symbolic_link
100
+
| `Socket
101
+
]
102
+
103
+
type t = {
104
+
blksize : Int64.t;
105
+
attributes : Int64.t;
106
+
nlink : Int64.t;
107
+
uid : Int64.t;
108
+
gid : Int64.t;
109
+
mode : int;
110
+
ino : Int64.t;
111
+
size : Optint.Int63.t;
112
+
blocks : Int64.t;
113
+
attributes_mask : Int64.t;
114
+
atime : float;
115
+
btime : float;
116
+
ctime : float;
117
+
mtime : float;
118
+
rdev : Int64.t;
119
+
dev : Int64.t;
120
+
perm : int;
121
+
kind : kind;
122
+
mask : Int64.t;
123
+
}
124
+
125
+
external create : unit -> internal = "ocaml_uring_make_statx"
126
+
external internal_to_t : internal -> t = "ocaml_uring_statx_internal_to_t"
127
+
128
+
module Flags = struct
129
+
include Flags
130
+
include Config.Statx.Flags
131
+
end
132
+
133
+
module Mask = struct
134
+
include Flags
135
+
include Config.Statx.Mask
136
+
137
+
let check mask t =
138
+
let i = Int64.of_int t in
139
+
Int64.equal (Int64.logand mask i) i
140
+
end
141
+
end
142
+
89
143
module Sockaddr = struct
90
144
type t
91
145
···
239
293
external submit_readv_fixed : t -> Unix.file_descr -> id -> Cstruct.buffer -> int -> int -> offset -> bool = "ocaml_uring_submit_readv_fixed_byte" "ocaml_uring_submit_readv_fixed_native" [@@noalloc]
240
294
external submit_writev_fixed : t -> Unix.file_descr -> id -> Cstruct.buffer -> int -> int -> offset -> bool = "ocaml_uring_submit_writev_fixed_byte" "ocaml_uring_submit_writev_fixed_native" [@@noalloc]
241
295
external submit_close : t -> Unix.file_descr -> id -> bool = "ocaml_uring_submit_close" [@@noalloc]
296
+
external submit_statx : t -> id -> Unix.file_descr -> Statx.internal -> Sketch.ptr -> int -> int -> bool = "ocaml_uring_submit_statx_byte" "ocaml_uring_submit_statx_native" [@@noalloc]
242
297
external submit_splice : t -> id -> Unix.file_descr -> Unix.file_descr -> int -> bool = "ocaml_uring_submit_splice" [@@noalloc]
243
298
external submit_connect : t -> id -> Unix.file_descr -> Sockaddr.t -> bool = "ocaml_uring_submit_connect" [@@noalloc]
244
299
external submit_accept : t -> id -> Unix.file_descr -> Sockaddr.t -> bool = "ocaml_uring_submit_accept" [@@noalloc]
···
424
479
425
480
let close t fd user_data =
426
481
with_id t (fun id -> Uring.submit_close t.uring fd id) user_data
482
+
483
+
let statx t ?(fd=at_fdcwd) ~mask path statx flags user_data =
484
+
let spath = Sketch.String.alloc t.sketch path in
485
+
with_id_full t (fun id -> Uring.submit_statx t.uring id fd statx spath flags mask) user_data ~extra_data:statx
427
486
428
487
let splice t ~src ~dst ~len user_data =
429
488
with_id t (fun id -> Uring.submit_splice t.uring id src dst len) user_data
+86
vendor/opam/uring/lib/uring/uring.mli
+86
vendor/opam/uring/lib/uring/uring.mli
···
225
225
The operation returns the number of bytes transferred, or 0 for end-of-input.
226
226
The result is [EINVAL] if the file descriptors don't support splicing. *)
227
227
228
+
module Statx : sig
229
+
type internal
230
+
(** An internal type used to pass into {! statx}. *)
231
+
232
+
type kind = [
233
+
| `Unknown
234
+
| `Fifo
235
+
| `Character_special
236
+
| `Directory
237
+
| `Block_device
238
+
| `Regular_file
239
+
| `Symbolic_link
240
+
| `Socket
241
+
]
242
+
243
+
type t = {
244
+
blksize : Int64.t;
245
+
attributes : Int64.t;
246
+
nlink : Int64.t;
247
+
uid : Int64.t;
248
+
gid : Int64.t;
249
+
mode : int;
250
+
ino : Int64.t;
251
+
size : Optint.Int63.t;
252
+
blocks : Int64.t;
253
+
attributes_mask : Int64.t;
254
+
atime : float;
255
+
btime : float;
256
+
ctime : float;
257
+
mtime : float;
258
+
rdev : Int64.t;
259
+
dev : Int64.t;
260
+
perm : int;
261
+
kind : kind;
262
+
mask : Int64.t;
263
+
} (** See statx(2). *)
264
+
265
+
val create : unit -> internal
266
+
(** Use [create] to make an {! internal} statx struct to pass to {! statx}. *)
267
+
268
+
val internal_to_t : internal -> t
269
+
(** Convert an internal statx struct to an OCaml value. This should only be called
270
+
after a successful completition of a {! statx} call. *)
271
+
272
+
module Flags : sig
273
+
include FLAGS
274
+
275
+
val empty : t
276
+
val empty_path : t
277
+
val no_automount : t
278
+
val symlink_nofollow : t
279
+
val statx_sync_as_stat : t
280
+
val statx_force_sync : t
281
+
val statx_dont_sync : t
282
+
end
283
+
284
+
module Mask : sig
285
+
include FLAGS
286
+
287
+
val type' : t
288
+
val mode : t
289
+
val nlink : t
290
+
val uid : t
291
+
val gid : t
292
+
val atime : t
293
+
val mtime : t
294
+
val ctime : t
295
+
val ino : t
296
+
val size : t
297
+
val blocks : t
298
+
val basic_stats : t (** All of the above flags. *)
299
+
300
+
val btime : t
301
+
302
+
val check : Int64.t -> t -> bool
303
+
(** [check mask t] checks if [t] is set in [mask]. *)
304
+
end
305
+
end
306
+
307
+
val statx : 'a t -> ?fd:Unix.file_descr -> mask:Statx.Mask.t -> string -> Statx.internal -> Statx.Flags.t -> 'a -> 'a job option
308
+
(** [statx t ?fd ~mask path stat flags] stats [path], which is resolved relative to [fd]
309
+
(or the current directory if [fd] is not given).
310
+
311
+
Create a {! Statx.internal} using {! Statx.create} and after successful completion
312
+
of the job, convert it to {! Statx.t} using {! Statx.internal_to_t}. *)
313
+
228
314
val connect : 'a t -> Unix.file_descr -> Unix.sockaddr -> 'a -> 'a job option
229
315
(** [connect t fd addr d] will submit a request to connect [fd] to [addr]. *)
230
316
+117
-1
vendor/opam/uring/lib/uring/uring_stubs.c
+117
-1
vendor/opam/uring/lib/uring/uring_stubs.c
···
35
35
#include <sys/uio.h>
36
36
#include <fcntl.h>
37
37
#include <unistd.h>
38
+
#include <sys/stat.h>
39
+
#include <sys/sysmacros.h>
40
+
// Check for something related to statx
41
+
// this is needed for Alpine.
42
+
#ifndef STATX_TYPE
43
+
#include <linux/stat.h>
44
+
#endif
45
+
38
46
39
47
#undef URING_DEBUG
40
48
#ifdef URING_DEBUG
···
46
54
// TODO: this belongs in Optint
47
55
#ifdef ARCH_SIXTYFOUR
48
56
#define Int63_val(v) Long_val(v)
57
+
#define caml_copy_int63(v) Val_long(v)
49
58
#else
50
-
#define Int63_val(v) (Int64_val(v)) >> 1
59
+
#define Int63_val(v) (Int64_val(v) >> 1)
60
+
#define caml_copy_int63(v) caml_copy_int64(v << 1)
51
61
#endif
52
62
53
63
#define Ring_val(v) *((struct io_uring**)Data_custom_val(v))
···
406
416
Int_val(v_nbytes), 0);
407
417
io_uring_sqe_set_data(sqe, (void *)Long_val(v_id));
408
418
return (Val_true);
419
+
}
420
+
421
+
#define Statx_val(v) (*((struct statx **) Data_custom_val(v)))
422
+
423
+
static void finalize_statx(value v) {
424
+
caml_stat_free(Statx_val(v));
425
+
Statx_val(v) = NULL;
426
+
}
427
+
428
+
static struct custom_operations statx_ops = {
429
+
"uring.statx",
430
+
finalize_statx,
431
+
custom_compare_default,
432
+
custom_hash_default,
433
+
custom_serialize_default,
434
+
custom_deserialize_default,
435
+
custom_compare_ext_default,
436
+
custom_fixed_length_default
437
+
};
438
+
439
+
value
440
+
ocaml_uring_make_statx(value v_unit) {
441
+
CAMLparam0();
442
+
CAMLlocal1(v);
443
+
struct statx *data;
444
+
v = caml_alloc_custom_mem(&statx_ops, sizeof(struct statx *), sizeof(struct statx));
445
+
Statx_val(v) = NULL;
446
+
data = (struct statx *) caml_stat_alloc(sizeof(struct statx));
447
+
Statx_val(v) = data;
448
+
CAMLreturn(v);
449
+
}
450
+
451
+
static double double_of_timespec(struct statx_timestamp *t) {
452
+
return ((double) t->tv_sec) + (((double) t->tv_nsec) / 1e9);
453
+
}
454
+
455
+
static value get_file_type_variant(struct statx *sb) {
456
+
int filetype = sb->stx_mode & S_IFMT;
457
+
if (filetype == S_IFREG) {
458
+
return caml_hash_variant("Regular_file");
459
+
} else if (filetype == S_IFSOCK) {
460
+
return caml_hash_variant("Socket");
461
+
} else if (filetype == S_IFLNK) {
462
+
return caml_hash_variant("Symbolic_link");
463
+
} else if (filetype == S_IFBLK) {
464
+
return caml_hash_variant("Block_device");
465
+
} else if (filetype == S_IFDIR) {
466
+
return caml_hash_variant("Directory");
467
+
} else if (filetype == S_IFCHR) {
468
+
return caml_hash_variant("Character_special");
469
+
} else if (filetype == S_IFIFO) {
470
+
return caml_hash_variant("Fifo");
471
+
} else {
472
+
return caml_hash_variant("Unknown");
473
+
}
474
+
}
475
+
476
+
value
477
+
ocaml_uring_statx_internal_to_t(value v_statx) {
478
+
CAMLparam1(v_statx);
479
+
CAMLlocal1(v);
480
+
v = caml_alloc(19, 0);
481
+
struct statx *s = Statx_val(v_statx);
482
+
Store_field(v, 0, caml_copy_int64(s->stx_blksize));
483
+
Store_field(v, 1, caml_copy_int64(s->stx_attributes));
484
+
Store_field(v, 2, caml_copy_int64(s->stx_nlink));
485
+
Store_field(v, 3, caml_copy_int64(s->stx_uid));
486
+
Store_field(v, 4, caml_copy_int64(s->stx_gid));
487
+
Store_field(v, 5, Val_int(s->stx_mode));
488
+
Store_field(v, 6, caml_copy_int64(s->stx_ino));
489
+
Store_field(v, 7, caml_copy_int63(s->stx_size));
490
+
Store_field(v, 8, caml_copy_int64(s->stx_blocks));
491
+
Store_field(v, 9, caml_copy_int64(s->stx_attributes_mask));
492
+
Store_field(v, 10, caml_copy_double(double_of_timespec(&s->stx_atime)));
493
+
Store_field(v, 11, caml_copy_double(double_of_timespec(&s->stx_btime)));
494
+
Store_field(v, 12, caml_copy_double(double_of_timespec(&s->stx_ctime)));
495
+
Store_field(v, 13, caml_copy_double(double_of_timespec(&s->stx_mtime)));
496
+
Store_field(v, 14, caml_copy_int64(makedev(s->stx_rdev_major,s->stx_rdev_minor)));
497
+
Store_field(v, 15, caml_copy_int64(makedev(s->stx_dev_major,s->stx_dev_minor)));
498
+
Store_field(v, 16, Val_int(s->stx_mode & ~S_IFMT));
499
+
Store_field(v, 17, get_file_type_variant(s));
500
+
Store_field(v, 18, caml_copy_int64(s->stx_mask));
501
+
CAMLreturn(v);
502
+
}
503
+
504
+
value
505
+
ocaml_uring_submit_statx_native(value v_uring, value v_id, value v_fd, value v_statx, value v_sketch_ptr, value v_flags, value v_mask) {
506
+
struct io_uring *ring = Ring_val(v_uring);
507
+
struct io_uring_sqe *sqe = io_uring_get_sqe(ring);
508
+
if (!sqe) return (Val_false);
509
+
char *path = Sketch_ptr_val(v_sketch_ptr);
510
+
io_uring_prep_statx(sqe, Int_val(v_fd), path, Int_val(v_flags), Int_val(v_mask), Statx_val(v_statx));
511
+
io_uring_sqe_set_data(sqe, (void *)Long_val(v_id));
512
+
return (Val_true);
513
+
}
514
+
515
+
value
516
+
ocaml_uring_submit_statx_byte(value* values, int argc) {
517
+
return ocaml_uring_submit_statx_native(
518
+
values[0],
519
+
values[1],
520
+
values[2],
521
+
values[3],
522
+
values[4],
523
+
values[5],
524
+
values[6]);
409
525
}
410
526
411
527
struct sock_addr_data {
+85
-4
vendor/opam/uring/tests/main.md
+85
-4
vendor/opam/uring/tests/main.md
···
177
177
val token : [ `Create ] = `Create
178
178
val fd : Unix.file_descr = <abstr>
179
179
180
-
# Unix.write fd (Bytes.of_string "Test") 0 4;;
181
-
- : int = 4
182
-
# Printf.sprintf "0o%o" (Unix.fstat fd).st_perm;;
183
-
- : string = "0o600"
180
+
# Unix.write fd (Bytes.of_string "Test data") 0 9;;
181
+
- : int = 9
182
+
183
+
# let x = Unix.fstat fd in
184
+
x.st_kind, Printf.sprintf "0o%o" x.st_perm, x.st_size;;
185
+
- : Unix.file_kind * string * int = (Unix.S_REG, "0o600", 9)
186
+
187
+
# let fd : unit = Unix.close fd;;
188
+
val fd : unit = ()
189
+
190
+
# Uring.exit t;;
191
+
- : unit = ()
192
+
```
193
+
194
+
## Statx
195
+
196
+
```ocaml
197
+
# let t : [ `Open_path | `Statx ] Uring.t = Uring.create ~queue_depth:1 ();;
198
+
val t : [ `Open_path | `Statx ] Uring.t = <abstr>
199
+
200
+
# let statx = Uring.Statx.create ();;
201
+
val statx : Uring.Statx.internal = <abstr>
202
+
# Uring.statx t
203
+
~mask:Uring.Statx.Mask.basic_stats
204
+
"test-openat"
205
+
statx
206
+
Uring.Statx.Flags.empty
207
+
`Statx;;
208
+
- : [ `Open_path | `Statx ] Uring.job option = Some <abstr>
209
+
210
+
# Uring.submit t;;
211
+
- : int = 1
212
+
213
+
# let token, retval = consume t;;
214
+
val token : [ `Open_path | `Statx ] = `Statx
215
+
val retval : int = 0
216
+
217
+
# let x = Uring.Statx.internal_to_t statx in
218
+
x.kind, Printf.sprintf "0o%o" x.perm, Int63.to_int x.size;;
219
+
- : Uring.Statx.kind * string * int = (`Regular_file, "0o600", 9)
220
+
```
221
+
222
+
Now using `~fd`:
223
+
224
+
```ocaml
225
+
# Uring.openat2 t
226
+
~access:`R
227
+
~flags:Uring.Open_flags.path
228
+
~perm:0
229
+
~resolve:Uring.Resolve.empty
230
+
"test-openat"
231
+
`Open_path;;
232
+
- : [ `Open_path | `Statx ] Uring.job option = Some <abstr>
233
+
234
+
# Uring.submit t;;
235
+
- : int = 1
236
+
237
+
# let token, fd =
238
+
let token, fd = consume t in
239
+
assert (fd >= 0);
240
+
token, (Obj.magic fd : Unix.file_descr);;
241
+
val token : [ `Open_path | `Statx ] = `Open_path
242
+
val fd : Unix.file_descr = <abstr>
243
+
244
+
# let statx = Uring.Statx.create ();;
245
+
val statx : Uring.Statx.internal = <abstr>
246
+
# Uring.statx t
247
+
~fd
248
+
~mask:Uring.Statx.Mask.(type' + mode + size)
249
+
""
250
+
statx
251
+
Uring.Statx.Flags.empty_path
252
+
`Statx;;
253
+
- : [ `Open_path | `Statx ] Uring.job option = Some <abstr>
254
+
255
+
# Uring.submit t;;
256
+
- : int = 1
257
+
258
+
# let token, retval = consume t;;
259
+
val token : [ `Open_path | `Statx ] = `Statx
260
+
val retval : int = 0
261
+
262
+
# let x = Uring.Statx.internal_to_t statx in
263
+
x.kind, Printf.sprintf "0o%o" x.perm, Int63.to_int x.size;;
264
+
- : Uring.Statx.kind * string * int = (`Regular_file, "0o600", 9)
184
265
185
266
# let fd : unit = Unix.close fd;;
186
267
val fd : unit = ()