The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #97 from patricoferris/statx-opt
Statx opt
authored by
Thomas Leonard
and committed by
GitHub
7dd34a00
1c9529b6
+382
-126
+45
-9
vendor/opam/uring/lib/uring/include/discover.ml
+45
-9
vendor/opam/uring/lib/uring/include/discover.ml
···
109
109
| _ -> assert false
110
110
)
111
111
in
112
-
let at_flags, mask_flags =
112
+
let at_flags, mask_flags, attr_flags =
113
+
let new_flags =
114
+
C.C_define.Type.[
115
+
(* Masks *)
116
+
"STATX_MNT_ID", Int;
117
+
"STATX_DIOALIGN", Int;
118
+
(* File Attributes *)
119
+
"STATX_ATTR_VERITY", Int;
120
+
"STATX_ATTR_DAX", Int;
121
+
]
122
+
in
123
+
let new_flag_prelude =
124
+
let def_flag = function
125
+
| name, C.C_define.Type.Int ->
126
+
Printf.sprintf "#ifndef %s\n#define %s 0\n#endif\n" name name;
127
+
| _ -> assert false
128
+
in
129
+
String.concat "" (List.map def_flag new_flags)
130
+
in
113
131
C.C_define.import c ~c_flags:["-D_GNU_SOURCE"; "-I"; Filename.concat (Sys.getcwd ()) "include"]
114
-
~prelude:{|#include <sys/stat.h>
132
+
~prelude:({|#include <sys/stat.h>
115
133
#ifndef STATX_TYPE
116
134
#include <linux/stat.h>
117
-
#endif|}
135
+
#endif
136
+
|} ^ new_flag_prelude)
118
137
~includes:["fcntl.h" ]
119
-
C.C_define.Type.[
138
+
(C.C_define.Type.[
120
139
"AT_EMPTY_PATH", Int;
121
140
"AT_NO_AUTOMOUNT", Int;
122
141
"AT_SYMLINK_NOFOLLOW", Int;
···
137
156
"STATX_BLOCKS", Int;
138
157
"STATX_BASIC_STATS", Int;
139
158
"STATX_BTIME", Int;
140
-
]
141
-
|> List.fold_left (fun (ats, stats) (v, k) -> match String.split_on_char '_' v, k with
159
+
160
+
"STATX_ATTR_COMPRESSED", Int;
161
+
"STATX_ATTR_IMMUTABLE", Int;
162
+
"STATX_ATTR_APPEND", Int;
163
+
"STATX_ATTR_NODUMP", Int ;
164
+
"STATX_ATTR_ENCRYPTED", Int;
165
+
] @ new_flags)
166
+
|> List.fold_left (fun (ats, stats, attrs) (v, k) -> match String.split_on_char '_' v, k with
142
167
| "AT" :: name, C.C_define.Value.Int v ->
143
168
let ocaml_name = String.lowercase_ascii (String.concat "_" name) in
144
-
((ocaml_name, v) :: ats, stats)
169
+
((ocaml_name, v) :: ats, stats, attrs)
170
+
| "STATX" :: "ATTR" :: name, C.C_define.Value.Int v ->
171
+
let name = String.concat "_" name |> String.lowercase_ascii in
172
+
let ocaml_name = match name with
173
+
| "type" -> "type'"
174
+
| v -> v
175
+
in
176
+
(ats, stats, (ocaml_name, v) :: attrs)
145
177
| "STATX" :: name, C.C_define.Value.Int v ->
146
178
let name = String.concat "_" name |> String.lowercase_ascii in
147
179
let ocaml_name = match name with
148
180
| "type" -> "type'"
149
181
| v -> v
150
182
in
151
-
(ats, (ocaml_name, v) :: stats)
183
+
(ats, (ocaml_name, v) :: stats, attrs)
152
184
| _ -> assert false
153
-
) ([], [])
185
+
) ([], [], [])
154
186
in
155
187
let op_sig = List.map (fun (name, _) -> Printf.sprintf " val %s : t" name) ops in
156
188
let op_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) ops in
157
189
let at_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) at_flags in
158
190
let mask_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) mask_flags in
191
+
let attr_struct = List.map (fun (name, v) -> Printf.sprintf " let %s = 0x%x" name v) attr_flags in
159
192
C.Flags.write_lines "config.ml"
160
193
(defs @
161
194
["module Op : sig";
···
172
205
" end";
173
206
" module Mask = struct";
174
207
] @ mask_struct @ [
208
+
" end";
209
+
" module Attr = struct";
210
+
] @ attr_struct @ [
175
211
" end";
176
212
"end"
177
213
])
+55
-25
vendor/opam/uring/lib/uring/uring.ml
+55
-25
vendor/opam/uring/lib/uring/uring.ml
···
87
87
end
88
88
89
89
module Statx = struct
90
-
type internal
90
+
type t
91
91
92
92
type kind = [
93
93
| `Unknown
···
100
100
| `Socket
101
101
]
102
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
-
}
103
+
let pp_kind f k =
104
+
Fmt.pf f "%s"
105
+
(match k with
106
+
|`Unknown -> "unknown"
107
+
|`Fifo -> "fifo"
108
+
|`Character_special -> "character special file"
109
+
|`Directory -> "directory"
110
+
|`Block_device -> "block device"
111
+
|`Regular_file -> "regular file"
112
+
|`Symbolic_link -> "symbolic link"
113
+
|`Socket -> "socket")
124
114
125
-
external create : unit -> internal = "ocaml_uring_make_statx"
126
-
external internal_to_t : internal -> t = "ocaml_uring_statx_internal_to_t"
115
+
external create : unit -> t = "ocaml_uring_make_statx"
127
116
128
117
module Flags = struct
129
118
include Flags
130
119
include Config.Statx.Flags
131
120
end
132
121
122
+
module Attr = struct
123
+
include Flags
124
+
include Config.Statx.Attr
125
+
126
+
let check ?mask attr t =
127
+
let i = Int64.of_int t in
128
+
(match mask with Some m -> if Int64.equal (Int64.logand m i) i then invalid_arg "Attribute not supported" | _ -> ());
129
+
Int64.equal (Int64.logand attr i) i
130
+
end
131
+
133
132
module Mask = struct
134
133
include Flags
135
134
include Config.Statx.Mask
···
138
137
let i = Int64.of_int t in
139
138
Int64.equal (Int64.logand mask i) i
140
139
end
140
+
141
+
external blksize : t -> (int64 [@unboxed]) = "ocaml_uring_statx_blksize_bytes" "ocaml_uring_statx_blksize_native" [@@noalloc]
142
+
external attributes : t -> (int64 [@unboxed]) = "ocaml_uring_statx_attributes_bytes" "ocaml_uring_statx_attributes_native" [@@noalloc]
143
+
external nlink : t -> (int64 [@unboxed]) = "ocaml_uring_statx_nlink_bytes" "ocaml_uring_statx_nlink_native" [@@noalloc]
144
+
external uid : t -> (int64 [@unboxed]) = "ocaml_uring_statx_uid_bytes" "ocaml_uring_statx_uid_native" [@@noalloc]
145
+
external gid : t -> (int64 [@unboxed]) = "ocaml_uring_statx_gid_bytes" "ocaml_uring_statx_gid_native" [@@noalloc]
146
+
external ino : t -> (int64 [@unboxed]) = "ocaml_uring_statx_ino_bytes" "ocaml_uring_statx_ino_native" [@@noalloc]
147
+
external size : t -> (int64 [@unboxed]) = "ocaml_uring_statx_size_bytes" "ocaml_uring_statx_size_native" [@@noalloc]
148
+
external blocks : t -> (int64 [@unboxed]) = "ocaml_uring_statx_blocks_bytes" "ocaml_uring_statx_blocks_native" [@@noalloc]
149
+
external attributes_mask : t -> (int64 [@unboxed]) = "ocaml_uring_statx_attributes_mask_bytes" "ocaml_uring_statx_attributes_mask_native" [@@noalloc]
150
+
external rdev : t -> (int64 [@unboxed]) = "ocaml_uring_statx_rdev_bytes" "ocaml_uring_statx_rdev_native" [@@noalloc]
151
+
external dev : t -> (int64 [@unboxed]) = "ocaml_uring_statx_dev_bytes" "ocaml_uring_statx_dev_native" [@@noalloc]
152
+
external mask : t -> (int64 [@unboxed]) = "ocaml_uring_statx_mask_bytes" "ocaml_uring_statx_mask_native" [@@noalloc]
153
+
external mnt_id : t -> (int64 [@unboxed]) = "ocaml_uring_statx_mnt_id_bytes" "ocaml_uring_statx_mnt_id_native" [@@noalloc]
154
+
external dio_mem_align : t -> (int64 [@unboxed]) = "ocaml_uring_statx_dio_mem_align_bytes" "ocaml_uring_statx_dio_mem_align_native" [@@noalloc]
155
+
external dio_offset_align : t -> (int64 [@unboxed]) = "ocaml_uring_statx_dio_offset_align_bytes" "ocaml_uring_statx_dio_offset_align_native" [@@noalloc]
156
+
157
+
external atime_sec : t -> (int64 [@unboxed]) = "ocaml_uring_statx_atime_sec_bytes" "ocaml_uring_statx_atime_sec_native" [@@noalloc]
158
+
external btime_sec : t -> (int64 [@unboxed]) = "ocaml_uring_statx_btime_sec_bytes" "ocaml_uring_statx_btime_sec_native" [@@noalloc]
159
+
external ctime_sec : t -> (int64 [@unboxed]) = "ocaml_uring_statx_ctime_sec_bytes" "ocaml_uring_statx_ctime_sec_native" [@@noalloc]
160
+
external mtime_sec : t -> (int64 [@unboxed]) = "ocaml_uring_statx_mtime_sec_bytes" "ocaml_uring_statx_mtime_sec_native" [@@noalloc]
161
+
162
+
external atime_nsec : t -> int = "ocaml_uring_statx_atime_nsec" [@@noalloc]
163
+
external btime_nsec : t -> int = "ocaml_uring_statx_btime_nsec" [@@noalloc]
164
+
external ctime_nsec : t -> int = "ocaml_uring_statx_ctime_nsec" [@@noalloc]
165
+
external mtime_nsec : t -> int = "ocaml_uring_statx_mtime_nsec" [@@noalloc]
166
+
167
+
external mode : t -> (int [@untagged]) = "ocaml_uring_statx_mode_bytes" "ocaml_uring_statx_mode_native" [@@noalloc]
168
+
external perm : t -> (int [@untagged]) = "ocaml_uring_statx_perm_bytes" "ocaml_uring_statx_perm_native" [@@noalloc]
169
+
170
+
external kind : t -> kind = "ocaml_uring_statx_kind"
141
171
end
142
172
143
173
module Sockaddr = struct
···
293
323
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]
294
324
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]
295
325
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]
326
+
external submit_statx : t -> id -> Unix.file_descr -> Statx.t -> Sketch.ptr -> int -> int -> bool = "ocaml_uring_submit_statx_byte" "ocaml_uring_submit_statx_native" [@@noalloc]
297
327
external submit_splice : t -> id -> Unix.file_descr -> Unix.file_descr -> int -> bool = "ocaml_uring_submit_splice" [@@noalloc]
298
328
external submit_connect : t -> id -> Unix.file_descr -> Sockaddr.t -> bool = "ocaml_uring_submit_connect" [@@noalloc]
299
329
external submit_accept : t -> id -> Unix.file_descr -> Sockaddr.t -> bool = "ocaml_uring_submit_accept" [@@noalloc]
+73
-34
vendor/opam/uring/lib/uring/uring.mli
+73
-34
vendor/opam/uring/lib/uring/uring.mli
···
226
226
The result is [EINVAL] if the file descriptors don't support splicing. *)
227
227
228
228
module Statx : sig
229
-
type internal
230
-
(** An internal type used to pass into {! statx}. *)
229
+
type t
230
+
(** A statx struct. *)
231
231
232
232
type kind = [
233
233
| `Unknown
···
240
240
| `Socket
241
241
]
242
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}. *)
243
+
val pp_kind : kind Fmt.t
267
244
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. *)
245
+
val create : unit -> t
246
+
(** Use [create] to make a statx result buffer to pass to {! statx}. *)
271
247
272
248
module Flags : sig
273
249
include FLAGS
···
279
255
val statx_sync_as_stat : t
280
256
val statx_force_sync : t
281
257
val statx_dont_sync : t
258
+
end
259
+
260
+
module Attr : sig
261
+
include FLAGS
262
+
263
+
val compressed : t
264
+
val immutable : t
265
+
val append : t
266
+
val nodump : t
267
+
val encrypted : t
268
+
val verity : t
269
+
270
+
val dax : t
271
+
(** Since Linux 5.8 *)
272
+
273
+
val check : ?mask:Int64.t -> Int64.t -> t -> bool
274
+
(** [check ?mask attr t] will check if [t] is set in [attr].
275
+
276
+
If [mask] is not [None] then it will first check the mask to see
277
+
if the file attribute is supported and if not raise [Invalid_argument]. *)
282
278
end
283
279
284
280
module Mask : sig
···
299
295
300
296
val btime : t
301
297
298
+
val mnt_id : t
299
+
(** As of Linux 5.8 *)
300
+
301
+
val dioalign : t
302
+
(** As of Linux 6.1 *)
303
+
302
304
val check : Int64.t -> t -> bool
303
305
(** [check mask t] checks if [t] is set in [mask]. *)
304
306
end
307
+
308
+
(** You may wish to use {! Mask.check} to verify the field has actually
309
+
been returned with a sensible value first. *)
310
+
311
+
val blksize : t -> Int64.t
312
+
val attributes : t -> Int64.t
313
+
val nlink : t -> Int64.t
314
+
val uid : t -> Int64.t
315
+
val gid : t -> Int64.t
316
+
val ino : t -> Int64.t
317
+
val size : t -> Int64.t
318
+
val blocks : t -> Int64.t
319
+
val attributes_mask : t -> Int64.t
320
+
val rdev : t -> Int64.t
321
+
val dev : t -> Int64.t
322
+
val mask : t -> Int64.t
323
+
324
+
val mnt_id : t -> Int64.t
325
+
(** See {! Mask.mnt_id}. *)
326
+
327
+
val dio_mem_align : t -> Int64.t
328
+
(** See {! Mask.dioalign}. *)
329
+
330
+
val dio_offset_align : t -> Int64.t
331
+
(** See {! Mask.dioalign}. *)
332
+
333
+
val atime_sec : t -> int64
334
+
val btime_sec : t -> int64
335
+
val ctime_sec : t -> int64
336
+
val mtime_sec : t -> int64
337
+
338
+
val atime_nsec : t -> int
339
+
val btime_nsec : t -> int
340
+
val ctime_nsec : t -> int
341
+
val mtime_nsec : t -> int
342
+
343
+
val mode : t -> int
344
+
val perm : t -> int
345
+
346
+
val kind : t -> kind
305
347
end
306
348
307
-
val statx : 'a t -> ?fd:Unix.file_descr -> mask:Statx.Mask.t -> string -> Statx.internal -> Statx.Flags.t -> 'a -> 'a job option
349
+
val statx : 'a t -> ?fd:Unix.file_descr -> mask:Statx.Mask.t -> string -> Statx.t -> Statx.Flags.t -> 'a -> 'a job option
308
350
(** [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}. *)
351
+
(or the current directory if [fd] is not given). *)
313
352
314
353
val connect : 'a t -> Unix.file_descr -> Unix.sockaddr -> 'a -> 'a job option
315
354
(** [connect t fd addr d] will submit a request to connect [fd] to [addr]. *)
+146
-50
vendor/opam/uring/lib/uring/uring_stubs.c
+146
-50
vendor/opam/uring/lib/uring/uring_stubs.c
···
54
54
// TODO: this belongs in Optint
55
55
#ifdef ARCH_SIXTYFOUR
56
56
#define Int63_val(v) Long_val(v)
57
-
#define caml_copy_int63(v) Val_long(v)
58
57
#else
59
58
#define Int63_val(v) (Int64_val(v) >> 1)
60
-
#define caml_copy_int63(v) caml_copy_int64(v << 1)
61
59
#endif
62
60
63
61
#define Ring_val(v) *((struct io_uring**)Data_custom_val(v))
···
448
446
CAMLreturn(v);
449
447
}
450
448
451
-
static double double_of_timespec(struct statx_timestamp *t) {
452
-
return ((double) t->tv_sec) + (((double) t->tv_nsec) / 1e9);
453
-
}
454
-
455
449
static value get_file_type_variant(struct statx *sb) {
456
450
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");
451
+
switch (filetype) {
452
+
case S_IFREG:
453
+
return caml_hash_variant("Regular_file");
454
+
case S_IFSOCK:
455
+
return caml_hash_variant("Socket");
456
+
case S_IFLNK:
457
+
return caml_hash_variant("Symbolic_link");
458
+
case S_IFBLK:
459
+
return caml_hash_variant("Block_device");
460
+
case S_IFDIR:
461
+
return caml_hash_variant("Directory");
462
+
case S_IFCHR:
463
+
return caml_hash_variant("Character_special");
464
+
case S_IFIFO:
465
+
return caml_hash_variant("Fifo");
466
+
default:
467
+
return caml_hash_variant("Unknown");
473
468
}
474
469
}
475
470
476
471
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
472
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
473
struct io_uring *ring = Ring_val(v_uring);
507
474
struct io_uring_sqe *sqe = io_uring_get_sqe(ring);
···
522
489
values[4],
523
490
values[5],
524
491
values[6]);
492
+
}
493
+
494
+
// Non-allocating (for native mode) accessors for statx
495
+
#define STATX_GETTER(field, return_type, ocaml_value_maker) \
496
+
return_type ocaml_uring_statx_##field##_native(value v_statx) { \
497
+
struct statx *s = Statx_val(v_statx); \
498
+
return s->stx_##field; \
499
+
} \
500
+
value ocaml_uring_statx_ ## field ## _bytes(value v_statx) { \
501
+
return ocaml_value_maker(ocaml_uring_statx_##field##_native(v_statx)); \
502
+
}
503
+
504
+
// Int64
505
+
STATX_GETTER(blksize, int64_t, caml_copy_int64);
506
+
STATX_GETTER(attributes, int64_t, caml_copy_int64);
507
+
STATX_GETTER(nlink, int64_t, caml_copy_int64);
508
+
STATX_GETTER(uid, int64_t, caml_copy_int64);
509
+
STATX_GETTER(gid, int64_t, caml_copy_int64);
510
+
STATX_GETTER(ino, int64_t, caml_copy_int64);
511
+
STATX_GETTER(size, int64_t, caml_copy_int64);
512
+
STATX_GETTER(blocks, int64_t, caml_copy_int64);
513
+
STATX_GETTER(attributes_mask, int64_t, caml_copy_int64);
514
+
STATX_GETTER(mask, int64_t, caml_copy_int64);
515
+
516
+
int64_t
517
+
ocaml_uring_statx_rdev_native(value v_statx) {
518
+
struct statx *s = Statx_val(v_statx);
519
+
return makedev(s->stx_rdev_major,s->stx_rdev_minor);
520
+
}
521
+
522
+
value
523
+
ocaml_uring_statx_rdev_bytes(value v_statx) {
524
+
return caml_copy_int64(ocaml_uring_statx_rdev_native(v_statx));
525
+
}
526
+
527
+
int64_t
528
+
ocaml_uring_statx_dev_native(value v_statx) {
529
+
struct statx *s = Statx_val(v_statx);
530
+
return makedev(s->stx_dev_major,s->stx_dev_minor);
531
+
}
532
+
533
+
value
534
+
ocaml_uring_statx_dev_bytes(value v_statx) {
535
+
return caml_copy_int64(ocaml_uring_statx_dev_native(v_statx));
536
+
}
537
+
538
+
int64_t
539
+
ocaml_uring_statx_mnt_id_native(value v_statx) {
540
+
#ifdef STATX_MNT_ID // Linux 5.8 and above
541
+
struct statx *s = Statx_val(v_statx);
542
+
return s->stx_mnt_id;
543
+
#else
544
+
return 0;
545
+
#endif
546
+
}
547
+
548
+
value
549
+
ocaml_uring_statx_mnt_id_bytes(value v_statx) {
550
+
return caml_copy_int64(ocaml_uring_statx_mnt_id_native(v_statx));
551
+
}
552
+
553
+
int64_t
554
+
ocaml_uring_statx_dio_mem_align_native(value v_statx) {
555
+
#ifdef STATX_DIOALIGN // Linux 6.1 and above
556
+
struct statx *s = Statx_val(v_statx);
557
+
return s->stx_dio_mem_align;
558
+
#else
559
+
return 0;
560
+
#endif
561
+
}
562
+
563
+
value
564
+
ocaml_uring_statx_dio_mem_align_bytes(value v_statx) {
565
+
return caml_copy_int64(ocaml_uring_statx_dio_mem_align_native(v_statx));
566
+
}
567
+
568
+
int64_t
569
+
ocaml_uring_statx_dio_offset_align_native(value v_statx) {
570
+
#ifdef STATX_DIOALIGN // Linux 6.1 and above
571
+
struct statx *s = Statx_val(v_statx);
572
+
return s->stx_dio_mem_align;
573
+
#else
574
+
return 0;
575
+
#endif
576
+
}
577
+
578
+
value
579
+
ocaml_uring_statx_dio_offset_align_bytes(value v_statx) {
580
+
return caml_copy_int64(ocaml_uring_statx_dio_offset_align_native(v_statx));
581
+
}
582
+
583
+
#define STATX_TIME_GETTER(field) \
584
+
int64_t ocaml_uring_statx_##field##_sec_native(value v_statx) { \
585
+
struct statx *s = Statx_val(v_statx); \
586
+
return s->stx_##field.tv_sec; \
587
+
} \
588
+
value ocaml_uring_statx_##field##_sec_bytes(value v_statx) { \
589
+
return caml_copy_int64(ocaml_uring_statx_##field##_sec_native(v_statx)); \
590
+
} \
591
+
value ocaml_uring_statx_##field##_nsec(value v_statx) { \
592
+
struct statx *s = Statx_val(v_statx); \
593
+
return Val_int(s->stx_##field.tv_nsec); \
594
+
}
595
+
596
+
// Seconds and ns
597
+
STATX_TIME_GETTER(atime);
598
+
STATX_TIME_GETTER(btime);
599
+
STATX_TIME_GETTER(ctime);
600
+
STATX_TIME_GETTER(mtime);
601
+
602
+
// Int
603
+
STATX_GETTER(mode, intnat, Val_int);
604
+
605
+
intnat
606
+
ocaml_uring_statx_perm_native(value v_statx) {
607
+
struct statx *s = Statx_val(v_statx);
608
+
return (s->stx_mode & ~S_IFMT);
609
+
}
610
+
611
+
value
612
+
ocaml_uring_statx_perm_bytes(value v_statx) {
613
+
return Val_int(ocaml_uring_statx_perm_native(v_statx));
614
+
}
615
+
616
+
// Allocating
617
+
value
618
+
ocaml_uring_statx_kind(value v_statx) {
619
+
struct statx *s = Statx_val(v_statx);
620
+
return get_file_type_variant(s);
525
621
}
526
622
527
623
struct sock_addr_data {
+5
vendor/opam/uring/tests/dune
+5
vendor/opam/uring/tests/dune
+9
-8
vendor/opam/uring/tests/main.md
+9
-8
vendor/opam/uring/tests/main.md
···
198
198
val t : [ `Open_path | `Statx ] Uring.t = <abstr>
199
199
200
200
# let statx = Uring.Statx.create ();;
201
-
val statx : Uring.Statx.internal = <abstr>
201
+
val statx : Uring.Statx.t = <abstr>
202
202
# Uring.statx t
203
203
~mask:Uring.Statx.Mask.basic_stats
204
204
"test-openat"
···
214
214
val token : [ `Open_path | `Statx ] = `Statx
215
215
val retval : int = 0
216
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)
217
+
# Uring.Statx.kind statx, Printf.sprintf "0o%o" (Uring.Statx.perm statx), (Uring.Statx.size statx);;
218
+
- : Uring.Statx.kind * string * int64 = (`Regular_file, "0o600", 9L)
219
+
220
+
# if not (Uring.Statx.(Mask.check (mask statx) Mask.dioalign)) then assert (Uring.Statx.dio_mem_align statx = 0L);;
221
+
- : unit = ()
220
222
```
221
223
222
224
Now using `~fd`:
···
242
244
val fd : Unix.file_descr = <abstr>
243
245
244
246
# let statx = Uring.Statx.create ();;
245
-
val statx : Uring.Statx.internal = <abstr>
247
+
val statx : Uring.Statx.t = <abstr>
246
248
# Uring.statx t
247
249
~fd
248
250
~mask:Uring.Statx.Mask.(type' + mode + size)
···
259
261
val token : [ `Open_path | `Statx ] = `Statx
260
262
val retval : int = 0
261
263
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)
264
+
# Uring.Statx.kind statx, Printf.sprintf "0o%o" (Uring.Statx.perm statx), (Uring.Statx.size statx);;
265
+
- : Uring.Statx.kind * string * int64 = (`Regular_file, "0o600", 9L)
265
266
266
267
# let fd : unit = Unix.close fd;;
267
268
val fd : unit = ()
+49
vendor/opam/uring/tests/urstat.ml
+49
vendor/opam/uring/tests/urstat.ml
···
1
+
(* stat(1) built with liburing. *)
2
+
3
+
module S = Uring.Statx
4
+
5
+
(* TODO move into Uring.Statx? *)
6
+
let pp_time f (sec, nsec) =
7
+
let tm = Unix.localtime (Int64.to_float sec) in
8
+
Format.fprintf f "%04d-%02d-%02d %02d:%02d:%02d.%09d +0000"
9
+
(tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
10
+
tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
11
+
nsec
12
+
13
+
let get_completion_and_print uring =
14
+
let (fname, buf), _ =
15
+
match Uring.wait uring with
16
+
| Some { data; result } -> (data, result)
17
+
| None -> failwith "retry"
18
+
in
19
+
let kind = S.kind buf in
20
+
let opt_symlink = match kind with
21
+
`Symbolic_link -> Printf.sprintf " -> %s" (Unix.readlink fname) (* TODO no readlink in io_uring? *)
22
+
| _ -> "" in
23
+
Format.printf " File: %s%s\n Size: %Lu\t\tBlocks: %Lu\tIO Block: %Lu\t %a\nDevice: %Lu\tInode: %Lu\tLinks: %Lu\nAccess: (%04o/TODO)\tUid: (%Lu/TODO)\tGid: (%Lu/TODO)\nAccess: %a\nModify: %a\nChange: %a\n Birth: %a\n%!"
24
+
fname opt_symlink
25
+
(S.size buf)
26
+
(S.blocks buf)
27
+
(S.blksize buf)
28
+
S.pp_kind (S.kind buf)
29
+
(S.dev buf) (* TODO expose makedev/major/minor *) (S.ino buf) (S.nlink buf)
30
+
(S.perm buf) (S.uid buf) (S.gid buf)
31
+
pp_time (S.atime_sec buf, S.atime_nsec buf)
32
+
pp_time (S.mtime_sec buf, S.mtime_nsec buf)
33
+
pp_time (S.ctime_sec buf, S.ctime_nsec buf)
34
+
pp_time (S.btime_sec buf, S.btime_nsec buf)
35
+
36
+
let submit_stat_request fname buf uring =
37
+
let mask = S.Mask.(basic_stats + btime) in
38
+
let flags = S.Flags.(symlink_nofollow + statx_dont_sync) in
39
+
let _ = Uring.statx uring ~mask fname buf flags (fname,buf) in
40
+
let numreq = Uring.submit uring in
41
+
assert(numreq=1);
42
+
()
43
+
44
+
let () =
45
+
let fname = Sys.argv.(1) in
46
+
let buf = S.create () in
47
+
let uring = Uring.create ~queue_depth:1 () in
48
+
submit_stat_request fname buf uring;
49
+
get_completion_and_print uring