-
Notifications
You must be signed in to change notification settings - Fork 19
/
extUnix.pp.ml
3014 lines (2326 loc) · 115 KB
/
extUnix.pp.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(** ExtUnix
These functions are thin wrappers for underlying system API, consult
the corresponding man pages and/or system documentation for details.
*)
(** [Not_available "symbol"] may be raised by functions in {!ExtUnix.All}
if the wrapped C function or constant is not available on this platform.
{!ExtUnix.Specific} includes only functions available on the current
platform and will not raise [Not_available].
Note that libc wrappers underlying {!ExtUnix.Specific} functions may still raise
[ENOSYS] (Not implemented) error even though the function is available. *)
exception Not_available of string
(** type of bigarray used by BA submodules that read from files into
bigarrays or write bigarrays into files. The only constraint here
is [Bigarray.c_layout].
Naming: "bigarray with C layout" -> "carray". *)
type ('a, 'b) carray =
('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
(** type of bigarray used by BA submodules that work with endianness
and memory. Constraints are:
+ [Bigarray.c_layout],
+ bigarray contains 8-bit integers.
Naming: "bigarray with C layout and 8-bit elements" -> "carray8". *)
type 'a carray8 =
('a, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
type open_flag = Unix.open_flag
(*
= O_RDONLY | O_WRONLY | O_RDWR | O_NONBLOCK | O_APPEND | O_CREAT
| O_TRUNC | O_EXCL | O_NOCTTY | O_DSYNC | O_SYNC | O_RSYNC
| O_SHARE_DELETE | O_CLOEXEC
*)
[%%have EVENTFD
external eventfd : int -> Unix.file_descr = "caml_extunix_eventfd"
external eventfd_read : Unix.file_descr -> int64 = "caml_extunix_eventfd_read"
external eventfd_write : Unix.file_descr -> int64 -> unit = "caml_extunix_eventfd_write"
]
[%%have SYSLOG
module Syslog : sig
type options = LOG_PID | LOG_CONS | LOG_NDELAY | LOG_ODELAY | LOG_NOWAIT
type facility = LOG_KERN | LOG_USER | LOG_MAIL | LOG_NEWS | LOG_UUCP
| LOG_DAEMON | LOG_AUTH | LOG_CRON | LOG_LPR | LOG_LOCAL0 | LOG_LOCAL1
| LOG_LOCAL2 | LOG_LOCAL3 | LOG_LOCAL4 | LOG_LOCAL5 | LOG_LOCAL6
| LOG_LOCAL7
type level = LOG_EMERG | LOG_ALERT | LOG_CRIT | LOG_ERR | LOG_WARNING
| LOG_NOTICE | LOG_INFO | LOG_DEBUG
val setlogmask : level list -> level list
val openlog : ?ident:string -> options list -> facility -> unit
val closelog : unit -> unit
val syslog : ?facility:facility -> level -> ('a, unit, string, unit) format4 -> 'a
val log_upto : level -> level list
end = struct
type options = LOG_PID | LOG_CONS | LOG_NDELAY | LOG_ODELAY | LOG_NOWAIT
type facility = LOG_KERN | LOG_USER | LOG_MAIL | LOG_NEWS | LOG_UUCP
| LOG_DAEMON | LOG_AUTH | LOG_CRON | LOG_LPR | LOG_LOCAL0 | LOG_LOCAL1
| LOG_LOCAL2 | LOG_LOCAL3 | LOG_LOCAL4 | LOG_LOCAL5 | LOG_LOCAL6
| LOG_LOCAL7
type level = LOG_EMERG | LOG_ALERT | LOG_CRIT | LOG_ERR | LOG_WARNING
| LOG_NOTICE | LOG_INFO | LOG_DEBUG
external setlogmask : level list -> level list = "caml_extunix_setlogmask"
external openlog : ?ident:string -> options list -> facility -> unit = "caml_extunix_openlog"
external closelog : unit -> unit = "caml_extunix_closelog"
external ext_syslog : facility option -> level -> string -> unit = "caml_extunix_syslog"
let syslog ?facility lvl = Printf.ksprintf (ext_syslog facility lvl)
let log_upto lvl =
let rec f = function
| [] -> assert false
| x::xs -> if x=lvl then x::xs else f xs
in
f [LOG_DEBUG; LOG_INFO; LOG_NOTICE; LOG_WARNING; LOG_ERR; LOG_CRIT;
LOG_ALERT; LOG_EMERG]
end
]
[%%have UNAME
(** @author Sylvain Le Gall <[email protected]> *)
module Uname = struct
type t =
{
sysname: string;
nodename: string;
release: string;
version: string;
machine: string;
}
let to_string t =
String.concat " " [ t.sysname; t.nodename; t.release; t.version; t.machine ]
end
external uname : unit -> Uname.t = "caml_extunix_uname"
]
(** {2 Filesystem} *)
[%%have FSYNC
(** synchronize a file's in-core state with storage device *)
external fsync : Unix.file_descr -> unit = "caml_extunix_fsync"
]
[%%have FDATASYNC
external fdatasync : Unix.file_descr -> unit = "caml_extunix_fdatasync"
]
[%%have SYNC
(** causes all buffered modifications to file metadata and data to be written to the underlying file systems *)
external sync : unit -> unit = "caml_extunix_sync"
]
[%%have SYNCFS
(** like {!sync}, but synchronizes just the file system containing file referred to by the open file descriptor [fd] *)
external syncfs : Unix.file_descr -> unit = "caml_extunix_syncfs"
]
[%%have DIRFD
external dirfd : Unix.dir_handle -> Unix.file_descr = "caml_extunix_dirfd"
]
[%%have (STATVFS, FSTATVFS)
(** file system flags *)
type st_flag =
| ST_RDONLY (** Mount read-only. *)
| ST_NOSUID (** Ignore suid and sgid bits. *)
| ST_NODEV (** Disallow access to device special files. *)
| ST_NOEXEC (** Disallow program execution. *)
| ST_SYNCHRONOUS (** Writes are synced at once. *)
| ST_MANDLOCK (** Allow mandatory locks on an FS. *)
| ST_WRITE (** Write on file/directory/symlink. *)
| ST_APPEND (** Append-only file. *)
| ST_IMMUTABLE (** Immutable file. *)
| ST_NOATIME (** Do not update access times. *)
| ST_NODIRATIME (** Do not update directory access times. *)
| ST_RELATIME (** Update atime relative to mtime/ctime. *)
type statvfs = {
f_bsize : int; (** file system block size *)
f_blocks : int64; (** size of file system in blocks *)
f_bfree : int64; (** free blocks *)
f_bavail : int64; (** free blocks for unprivileged users *)
f_files : int64; (** inodes *)
f_ffree : int64; (** free inodes *)
f_favail : int64; (** free inodes for unprivileged users *)
f_fsid : int64; (** file system ID *)
f_flag : int; (** mount flags (raw value) *)
f_flags : st_flag list; (** mount flags (decoded) *)
f_namemax : int; (** maximum filename length *)
}
]
[%%have STATVFS
(** On Windows, [statvfs root] is emulated. [root] must be the root
directory of the volume to be described. A trailing backslash is
required. The [f_flag] and [f_fsid] fields are retrieved from a
call to [GetVolumeInformation]. Filesystem flags are provided raw
in [f_flag], and only [FILE_READ_ONLY_VOLUME] is mapped to
[ST_RDONLY] in [f_flags]. *)
external statvfs : string -> statvfs = "caml_extunix_statvfs"
]
[%%have FSTATVFS
external fstatvfs : Unix.file_descr -> statvfs = "caml_extunix_fstatvfs"
]
[%%have ATFILE
(*
external at_fdcwd : unit -> Unix.file_descr
(** Pseudo file descriptor denoting current directory *)
let at_fdcwd = at_fdcwd ()
*)
type at_flag = AT_EACCESS | AT_SYMLINK_NOFOLLOW | AT_REMOVEDIR | AT_SYMLINK_FOLLOW | AT_NO_AUTOMOUNT
external openat : Unix.file_descr -> string -> open_flag list -> Unix.file_perm -> Unix.file_descr = "caml_extunix_openat"
(** Supported flags : [AT_SYMLINK_NOFOLLOW AT_NO_AUTOMOUNT] *)
external fstatat : Unix.file_descr -> string -> at_flag list -> Unix.stats = "caml_extunix_fstatat"
(** Supported flags : [AT_REMOVEDIR] *)
external unlinkat : Unix.file_descr -> string -> at_flag list -> unit = "caml_extunix_unlinkat"
external renameat : Unix.file_descr -> string -> Unix.file_descr -> string -> unit = "caml_extunix_renameat"
external mkdirat : Unix.file_descr -> string -> int -> unit = "caml_extunix_mkdirat"
(** Supported flags : [AT_SYMLINK_FOLLOW] *)
external linkat : Unix.file_descr -> string -> Unix.file_descr -> string -> at_flag list -> unit = "caml_extunix_linkat"
external symlinkat : string -> Unix.file_descr -> string -> unit = "caml_extunix_symlinkat"
external readlinkat : Unix.file_descr -> string -> string = "caml_extunix_readlinkat"
external fchownat : Unix.file_descr -> string -> int -> int -> at_flag list -> unit = "caml_extunix_fchownat"
external fchmodat : Unix.file_descr -> string -> int -> at_flag list -> unit = "caml_extunix_fchmodat"
]
(** @raise Not_available if OS does not represent file descriptors as numbers *)
let int_of_file_descr : Unix.file_descr -> int =
if Obj.is_block (Obj.repr Unix.stdin) then
fun _ -> raise (Not_available "int_of_file_descr")
else
Obj.magic
(** @raise Not_available if OS does not represent file descriptors as numbers *)
let file_descr_of_int : int -> Unix.file_descr =
if Obj.is_block (Obj.repr Unix.stdin) then
fun _ -> raise (Not_available "file_descr_of_int")
else
Obj.magic
[%%have FCNTL
(** @return whether file descriptor is open *)
external is_open_descr : Unix.file_descr -> bool = "caml_extunix_is_open_descr"
]
[%%have REALPATH
(** [realpath path]
@return the canonicalized absolute pathname of [path]
*)
external realpath : string -> string = "caml_extunix_realpath"
let realpath p =
if not (Sys.win32) then realpath p else
let cleanup p = (* Remove any \\?\ prefix. *)
if String.length p <= 4 then p else
if p.[0] = '\\' && p.[1] = '\\' && p.[2] = '?' && p.[3] = '\\'
then (String.sub p 4 (String.length p - 4))
else p
in
try cleanup (realpath p) with
| (Unix.Unix_error (EACCES, _, _)) as e ->
(* On Windows this can happen on *files* on which you don't have
access. POSIX realpath(3) works in this case, we emulate this. *)
try
let dir = cleanup (realpath (Filename.dirname p)) in
Filename.concat dir (Filename.basename p)
with _ -> raise e
]
[%%have FADVISE
(** {3 posix_fadvise}
@author Sylvain Le Gall *)
(** access pattern *)
type advice =
| POSIX_FADV_NORMAL (** Indicates that the application has no advice to
give about its access pattern for the specified
data. *)
| POSIX_FADV_SEQUENTIAL (** The application expects to access the specified
data sequentially. *)
| POSIX_FADV_RANDOM (** The specified data will be accessed in random
order. *)
| POSIX_FADV_NOREUSE (** The specified data will be accessed only once. *)
| POSIX_FADV_WILLNEED (** The specified data will be accessed in the near
future. *)
| POSIX_FADV_DONTNEED (** The specified data will not be accessed in the
near future. *)
(** predeclare an access pattern for file data *)
external fadvise: Unix.file_descr -> int -> int -> advice -> unit = "caml_extunix_fadvise"
]
[%%have FALLOCATE
(** {3 posix_fallocate} *)
(** Allocate disk space for file
@author Sylvain Le Gall
*)
(** [fallocate fd off len] allocates disk space to ensure that subsequent writes
between [off] and [off + len] in [fd] will not fail because of lack of disk
space. The file size is modified if [off + len] is bigger than the current size.
*)
external fallocate: Unix.file_descr -> int -> int -> unit = "caml_extunix_fallocate"
]
[%%have PREAD
(** {3 pread}
@author Goswin von Brederlow *)
(** [all_pread fd off buf ofs len] reads up to [len] bytes from file
descriptor [fd] at offset [off] (from the start of the file) into
the string [buf] at offset [ofs]. The file offset is not changed.
[all_pread] repeats the read operation until all characters have
been read or an error occurs. Returns less than the number of
characters requested on EAGAIN, EWOULDBLOCK or End-of-file but
only ever returns 0 on End-of-file. Continues the read operation
on EINTR. Raises an Unix.Unix_error exception in all other
cases. *)
external unsafe_all_pread: Unix.file_descr -> int -> Bytes.t -> int -> int -> int = "caml_extunix_all_pread"
let all_pread fd off buf ofs len =
if off < 0 || ofs < 0 || len < 0 || ofs > Bytes.length buf - len
then invalid_arg "ExtUnix.all_pread"
else unsafe_all_pread fd off buf ofs len
(** [single_pread fd off buf ifs len] reads up to [len] bytes from
file descriptor [fd] at offset [off] (from the start of the file)
into the string [buf] at offset [ofs]. The file offset is not
changed.
[single_pread] attempts to read only once. Returns the number of
characters read or raises an Unix.Unix_error exception. *)
external unsafe_single_pread: Unix.file_descr -> int -> Bytes.t -> int -> int -> int = "caml_extunix_single_pread"
let single_pread fd off buf ofs len =
if off < 0 || ofs < 0 || len < 0 || ofs > Bytes.length buf - len
then invalid_arg "ExtUnix.single_pread"
else unsafe_single_pread fd off buf ofs len
(** [pread fd off buf ofs len] reads up to [len] bytes from file
descriptor [fd] at offset [off] (from the start of the file) into
the string [buf] at offset [ofs]. The file offset is not changed.
[pread] repeats the read operation until all characters have
been read or an error occurs. Raises an Unix.Unix_error exception
if 0 characters could be read before an error occurs. Continues
the read operation on EINTR. Returns the number of characters
written in all other cases. *)
external unsafe_pread: Unix.file_descr -> int -> Bytes.t -> int -> int -> int = "caml_extunix_pread"
let pread fd off buf ofs len =
if off < 0 || ofs < 0 || len < 0 || ofs > Bytes.length buf - len
then invalid_arg "ExtUnix.pread"
else unsafe_pread fd off buf ofs len
(** [intr_pread fd off buf ofs len] reads up to [len] bytes from file
descriptor [fd] at offset [off] (from the start of the file) into
the string [buf] at offset [ofs]. The file offset is not changed.
[intr_pread] repeats the read operation until all characters have
been read or an error occurs. Raises an Unix.Unix_error exception
if 0 characters could be read before an error occurs. Does NOT
continue on EINTR. Returns the number of characters written in all
other cases. *)
external unsafe_intr_pread: Unix.file_descr -> int -> Bytes.t -> int -> int -> int = "caml_extunix_intr_pread"
let intr_pread fd off buf ofs len =
if off < 0 || ofs < 0 || len < 0 || ofs > Bytes.length buf - len
then invalid_arg "ExtUnix.intr_pread"
else unsafe_intr_pread fd off buf ofs len
]
[%%have PWRITE
(** {3 pwrite}
@author Goswin von Brederlow *)
(** [all_pwrite fd off buf ofs len] writes up to [len] bytes from file
descriptor [fd] at offset [off] (from the start of the file) into
the string [buf] at offset [ofs]. The file offset is not changed.
[all_pwrite] repeats the write operation until all characters have
been written or an error occurs. Returns less than the number of
characters requested on EAGAIN, EWOULDBLOCK but never 0. Continues
the write operation on EINTR. Raises an Unix.Unix_error exception
in all other cases. *)
external unsafe_all_pwrite: Unix.file_descr -> int -> string -> int -> int -> int = "caml_extunix_all_pwrite"
let all_pwrite fd off buf ofs len =
if off < 0 || ofs < 0 || len < 0 || ofs > String.length buf - len
then invalid_arg "ExtUnix.all_pwrite"
else unsafe_all_pwrite fd off buf ofs len
(** [single_pwrite fd off buf ofs len] writes up to [len] bytes from
file descriptor [fd] at offset [off] (from the start of the file)
into the string [buf] at offset [ofs]. The file offset is not
changed.
[single_pwrite] attempts to write only once. Returns the number of
characters written or raises an Unix.Unix_error exception. *)
external unsafe_single_pwrite: Unix.file_descr -> int -> string -> int -> int -> int = "caml_extunix_single_pwrite"
let single_pwrite fd off buf ofs len =
if off < 0 || ofs < 0 || len < 0 || ofs > String.length buf - len
then invalid_arg "ExtUnix.single_pwrite"
else unsafe_single_pwrite fd off buf ofs len
(** [pwrite fd off buf ofs len] writes up to [len] bytes from file
descriptor [fd] at offset [off] (from the start of the file) into
the string [buf] at offset [ofs]. The file offset is not changed.
[pwrite] repeats the write operation until all characters have
been written or an error occurs. Raises an Unix.Unix_error exception
if 0 characters could be written before an error occurs. Continues
the write operation on EINTR. Returns the number of characters
written in all other cases. *)
external unsafe_pwrite: Unix.file_descr -> int -> string -> int -> int -> int = "caml_extunix_pwrite"
let pwrite fd off buf ofs len =
if off < 0 || ofs < 0 || len < 0 || ofs > String.length buf - len
then invalid_arg "ExtUnix.pwrite"
else unsafe_pwrite fd off buf ofs len
(** [intr_pwrite fd off buf ofs len] writes up to [len] bytes from
file descriptor [fd] at offset [off] (from the start of the file)
into the string [buf] at offset [ofs]. The file offset is not
changed.
[intr_pwrite] repeats the write operation until all characters have
been written or an error occurs. Raises an Unix.Unix_error exception
if 0 characters could be written before an error occurs. Does NOT
continue on EINTR. Returns the number of characters written in all
other cases. *)
external unsafe_intr_pwrite: Unix.file_descr -> int -> string -> int -> int -> int = "caml_extunix_intr_pwrite"
let intr_pwrite fd off buf ofs len =
if off < 0 || ofs < 0 || len < 0 || ofs > String.length buf - len
then invalid_arg "ExtUnix.intr_pwrite"
else unsafe_intr_pwrite fd off buf ofs len
]
[%%have READ
(** {3 read}
@author Goswin von Brederlow *)
(** [all_read fd buf ofs len] reads up to [len] bytes from file
descriptor [fd] into the string [buf] at offset [ofs].
[all_read] repeats the read operation until all characters have
been read or an error occurs. Returns less than the number of
characters requested on EAGAIN, EWOULDBLOCK or End-of-file but
only ever returns 0 on End-of-file. Continues the read operation
on EINTR. Raises an Unix.Unix_error exception in all other
cases. *)
external unsafe_all_read: Unix.file_descr -> Bytes.t -> int -> int -> int = "caml_extunix_all_read"
let all_read fd buf ofs len =
if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
then invalid_arg "ExtUnix.all_read"
else unsafe_all_read fd buf ofs len
(** [single_read fd buf ifs len] reads up to [len] bytes from file
descriptor [fd] into the string [buf] at offset [ofs].
[single_read] attempts to read only once. Returns the number of
characters read or raises an Unix.Unix_error exception. *)
external unsafe_single_read: Unix.file_descr -> Bytes.t -> int -> int -> int = "caml_extunix_single_read"
let single_read fd buf ofs len =
if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
then invalid_arg "ExtUnix.single_read"
else unsafe_single_read fd buf ofs len
(** [read fd buf ofs len] reads up to [len] bytes from file descriptor
[fd] into the string [buf] at offset [ofs].
[read] repeats the read operation until all characters have
been read or an error occurs. Raises an Unix.Unix_error exception
if 0 characters could be read before an error occurs. Continues
the read operation on EINTR. Returns the number of characters
written in all other cases. *)
external unsafe_read: Unix.file_descr -> Bytes.t -> int -> int -> int = "caml_extunix_read"
let read fd buf ofs len =
if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
then invalid_arg "ExtUnix.read"
else unsafe_read fd buf ofs len
(** [intr_read fd buf ofs len] reads up to [len] bytes from file
descriptor [fd] into the string [buf] at offset [ofs].
[intr_read] repeats the read operation until all characters have
been read or an error occurs. Raises an Unix.Unix_error exception
if 0 characters could be read before an error occurs. Does NOT
continue on EINTR. Returns the number of characters written in all
other cases. *)
external unsafe_intr_read: Unix.file_descr -> Bytes.t -> int -> int -> int = "caml_extunix_intr_read"
let intr_read fd buf ofs len =
if ofs < 0 || len < 0 || ofs > Bytes.length buf - len
then invalid_arg "ExtUnix.intr_read"
else unsafe_intr_read fd buf ofs len
]
[%%have WRITE
(** {3 write}
@author Goswin von Brederlow *)
(** [all_write fd buf ofs len] writes up to [len] bytes from file
descriptor [fd] into the string [buf] at offset [ofs].
[all_write] repeats the write operation until all characters have
been written or an error occurs. Returns less than the number of
characters requested on EAGAIN, EWOULDBLOCK but never 0. Continues
the write operation on EINTR. Raises an Unix.Unix_error exception
in all other cases. *)
external unsafe_all_write: Unix.file_descr -> string -> int -> int -> int = "caml_extunix_all_write"
let all_write fd buf ofs len =
if ofs < 0 || len < 0 || ofs > String.length buf - len
then invalid_arg "ExtUnix.all_write"
else unsafe_all_write fd buf ofs len
(** [single_write fd buf ofs len] writes up to [len] bytes from file
descriptor [fd] into the string [buf] at offset [ofs].
[single_write] attempts to write only once. Returns the number of
characters written or raises an Unix.Unix_error exception. *)
external unsafe_single_write: Unix.file_descr -> string -> int -> int -> int = "caml_extunix_single_write"
let single_write fd buf ofs len =
if ofs < 0 || len < 0 || ofs > String.length buf - len
then invalid_arg "ExtUnix.single_write"
else unsafe_single_write fd buf ofs len
(** [write fd buf ofs len] writes up to [len] bytes from file
descriptor [fd] into the string [buf] at offset [ofs].
[write] repeats the write operation until all characters have
been written or an error occurs. Raises an Unix.Unix_error exception
if 0 characters could be written before an error occurs. Continues
the write operation on EINTR. Returns the number of characters
written in all other cases. *)
external unsafe_write: Unix.file_descr -> string -> int -> int -> int = "caml_extunix_write"
let write fd buf ofs len =
if ofs < 0 || len < 0 || ofs > String.length buf - len
then invalid_arg "ExtUnix.write"
else unsafe_write fd buf ofs len
(** [intr_write fd buf ofs len] writes up to [len] bytes from file
descriptor [fd] into the string [buf] at offset [ofs].
[intr_write] repeats the write operation until all characters have
been written or an error occurs. Raises an Unix.Unix_error exception
if 0 characters could be written before an error occurs. Does NOT
continue on EINTR. Returns the number of characters written in all
other cases. *)
external unsafe_intr_write: Unix.file_descr -> string -> int -> int -> int = "caml_extunix_intr_write"
let intr_write fd buf ofs len =
if ofs < 0 || len < 0 || ofs > String.length buf - len
then invalid_arg "ExtUnix.intr_write"
else unsafe_intr_write fd buf ofs len
]
(** {2 File operations on large files} *)
(** File operations on large files. This sub-module provides 64-bit
variants of the functions [ExtUnix.fadvise] (for predeclaring an
access pattern for file data), [ExtUnix.fallocate] (for allocating
disk space for a file), [ExtUnix.all_pread], [ExtUnix.single_pread],
[ExtUnix.pread], [ExtUnix.intr_pread], [ExtUnix.all_pwrite],
[ExtUnix.single_pwrite], [ExtUnix.pwrite] and [ExtUnix.intr_pwrite]
(for reading from or writing to a file descriptor at a given
offset). These alternate functions represent positions and sizes
by 64-bit integers (type int64) instead of regular integers
(type int), thus allowing operating on files whose sizes are
greater than max_int. *)
module LargeFile =
struct
[%%have FADVISE
external fadvise: Unix.file_descr -> int64 -> int64 -> advice -> unit = "caml_extunix_fadvise64"
]
[%%have FALLOCATE
external fallocate: Unix.file_descr -> int64 -> int64 -> unit = "caml_extunix_fallocate64"
]
[%%have PREAD
external unsafe_all_pread: Unix.file_descr -> int64 -> Bytes.t -> int -> int -> int = "caml_extunix_all_pread64"
let all_pread fd off buf ofs len =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.all_pread"
else unsafe_all_pread fd off buf ofs len
external unsafe_single_pread: Unix.file_descr -> int64 -> Bytes.t -> int -> int -> int = "caml_extunix_single_pread64"
let single_pread fd off buf ofs len =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.single_pread"
else unsafe_single_pread fd off buf ofs len
external unsafe_pread: Unix.file_descr -> int64 -> Bytes.t -> int -> int -> int = "caml_extunix_pread64"
let pread fd off buf ofs len =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.pread"
else unsafe_pread fd off buf ofs len
external unsafe_intr_pread: Unix.file_descr -> int64 -> Bytes.t -> int -> int -> int = "caml_extunix_intr_pread64"
let intr_pread fd off buf ofs len =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.intr_pread"
else unsafe_intr_pread fd off buf ofs len
]
[%%have PWRITE
external unsafe_all_pwrite: Unix.file_descr -> int64 -> string -> int -> int -> int = "caml_extunix_all_pwrite64"
let all_pwrite fd off buf ofs len =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.all_pwrite"
else unsafe_all_pwrite fd off buf ofs len
external unsafe_single_pwrite: Unix.file_descr -> int64 -> string -> int -> int -> int = "caml_extunix_single_pwrite64"
let single_pwrite fd off buf ofs len =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.single_pwrite"
else unsafe_single_pwrite fd off buf ofs len
external unsafe_pwrite: Unix.file_descr -> int64 -> string -> int -> int -> int = "caml_extunix_pwrite64"
let pwrite fd off buf ofs len =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.pwrite"
else unsafe_pwrite fd off buf ofs len
external unsafe_intr_pwrite: Unix.file_descr -> int64 -> string -> int -> int -> int = "caml_extunix_intr_pwrite64"
let intr_pwrite fd off buf ofs len =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.intr_pwrite"
else unsafe_intr_pwrite fd off buf ofs len
]
(** {2 Bigarray variants} *)
(** *)
module BA = struct
[%%have PREAD
external unsafe_all_pread: Unix.file_descr -> int64 -> ('a, 'b) carray -> int = "caml_extunixba_all_pread64"
let all_pread fd off buf =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.all_pread"
else unsafe_all_pread fd off buf
external unsafe_single_pread: Unix.file_descr -> int64 -> ('a, 'b) carray -> int = "caml_extunixba_single_pread64"
let single_pread fd off buf =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.single_pread"
else unsafe_single_pread fd off buf
external unsafe_pread: Unix.file_descr -> int64 -> ('a, 'b) carray -> int = "caml_extunixba_pread64"
let pread fd off buf =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.pread"
else unsafe_pread fd off buf
external unsafe_intr_pread: Unix.file_descr -> int64 -> ('a, 'b) carray -> int = "caml_extunixba_intr_pread64"
let intr_pread fd off buf =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.intr_pread"
else unsafe_intr_pread fd off buf
]
[%%have PWRITE
external unsafe_all_pwrite: Unix.file_descr -> int64 -> ('a, 'b) carray -> int = "caml_extunixba_all_pwrite64"
let all_pwrite fd off buf =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.all_pwrite"
else unsafe_all_pwrite fd off buf
external unsafe_single_pwrite: Unix.file_descr -> int64 -> ('a, 'b) carray -> int = "caml_extunixba_single_pwrite64"
let single_pwrite fd off buf =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.single_pwrite"
else unsafe_single_pwrite fd off buf
external unsafe_pwrite: Unix.file_descr -> int64 -> ('a, 'b) carray -> int = "caml_extunixba_pwrite64"
let pwrite fd off buf =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.pwrite"
else unsafe_pwrite fd off buf
external unsafe_intr_pwrite: Unix.file_descr -> int64 -> ('a, 'b) carray -> int = "caml_extunixba_intr_pwrite64"
let intr_pwrite fd off buf =
if off < Int64.zero
then invalid_arg "ExtUnix.LargeFile.intr_pwrite"
else unsafe_intr_pwrite fd off buf
]
end (* module BA *)
end (* module LargeFile *)
[%%have MOUNT
(** {3 mount system call} *)
type mount_flag =
| MS_RDONLY | MS_NOSUID | MS_NODEV | MS_NOEXEC | MS_SYNCHRONOUS | MS_REMOUNT
| MS_MANDLOCK | MS_DIRSYNC | MS_NOATIME | MS_NODIRATIME | MS_BIND | MS_MOVE
| MS_REC | MS_SILENT | MS_POSIXACL | MS_UNBINDABLE | MS_PRIVATE | MS_SLAVE
| MS_SHARED | MS_RELATIME | MS_KERNMOUNT | MS_I_VERSION | MS_STRICTATIME
| MS_NOUSER
external mount: source:string -> target:string -> fstype:string ->
mount_flag list -> data:string -> unit = "caml_extunix_mount"
type umount2_flag =
| MNT_FORCE | MNT_DETACH | MNT_EXPIRE | UMOUNT_NOFOLLOW
external umount2: string -> umount2_flag list -> unit = "caml_extunix_umount2"
]
[%%have CHROOT
(** {3 chroot system call} *)
external chroot: string -> unit = "caml_extunix_chroot"
]
(** {2 namespace} *)
[%%have UNSHARE
type clone_flag =
| CLONE_FS | CLONE_FILES | CLONE_NEWNS | CLONE_SYSVSEM | CLONE_NEWUTS
| CLONE_NEWIPC | CLONE_NEWUSER | CLONE_NEWPID | CLONE_NEWNET
external unshare: clone_flag list -> unit = "caml_extunix_unshare"
]
(** {2 ioctl} *)
(** Control the underlying device parameters of special files *)
module Ioctl = struct
[%%have SIOCGIFCONF
(** [siocgifconf sock], where [sock] is any socket, e.g. [socket PF_INET SOCK_DGRAM 0]
@return the list of interfaces and corresponding addresses ({b FIXME max 32}) ({b may change}) *)
external siocgifconf : sock:Unix.file_descr -> (string * string) list = "caml_extunix_ioctl_siocgifconf"
]
[%%have TTY_IOCTL
(** Enable RTS/CTS (hardware) flow control. See CRTSCTS in tcsetattr(3).
{b FIXME this is likely to disappear when separate interface for [tcsetattr] and [tcgetattr] gets implemented} *)
external crtscts : Unix.file_descr -> int = "caml_extunix_crtscts"
(** Get the status of modem bits. See TIOCMGET in tty_ioctl(4). *)
external tiocmget : Unix.file_descr -> int = "caml_extunix_ioctl_TIOCMGET"
(** Set the status of modem bits. See TIOCMSET in tty_ioctl(4). *)
external tiocmset : Unix.file_descr -> int -> unit = "caml_extunix_ioctl_TIOCMSET"
(** Clear the indicated modem bits. See TIOCMBIC in tty_ioctl(4). *)
external tiocmbic : Unix.file_descr -> int -> unit = "caml_extunix_ioctl_TIOCMBIC"
(** Set the indicated modem bits. See TIOCMBIS in tty_ioctl(4). *)
external tiocmbis : Unix.file_descr -> int -> unit = "caml_extunix_ioctl_TIOCMBIS"
(** [tiocgwinsz fd] returns a tuple [(cols, rows, xpixel, ypixel)] representing
the size of the character device. [cols] is the number of character columns,
[rows] is the number of character rows, [xpixel] is width of the device in
pixels, and [ypixel] is the height of the device in pixels. *)
external tiocgwinsz : Unix.file_descr -> (int * int * int * int) = "caml_extunix_ioctl_TIOCGWINSZ"
]
end (* module Ioctl *)
(** {2 Miscellaneous} *)
[%%have TTYNAME
(** @return name of terminal *)
external ttyname : Unix.file_descr -> string = "caml_extunix_ttyname"
]
[%%have CTERMID
(** Get controlling terminal name *)
external ctermid : unit -> string = "caml_extunix_ctermid"
]
[%%have GETTID
(** @return thread id *)
external gettid : unit -> int = "caml_extunix_gettid"
]
[%%have PGID
(** [setpgid pid pgid] sets the process group of the process specified by [pid] to [pgid].
If [pid] is zero, then the process ID of the calling process is used. If
[pgid] is zero, then the PGID of the process specified by [pid] is made the same as its process ID. *)
external setpgid : int -> int -> unit = "caml_extunix_setpgid"
(** [getpgid pid] returns the PGID of the process specified by [pid].
If [pid] is zero, the process ID of the calling process is used. *)
external getpgid : int -> int = "caml_extunix_getpgid"
(** [getsid pid] returns the session ID of the process specified by [pid].
If [pid] is zero, the process ID of the calling process is used. *)
external getsid : int -> int = "caml_extunix_getsid"
]
[%%have SETREUID
(** [setreuid ruid euid] sets real and effective user IDs of the calling process.
Supplying a value of -1 for either the real or effective user ID forces the system to leave that ID unchanged.
*)
external setreuid : int -> int -> unit = "caml_extunix_setreuid"
(** [setregid rgid egid] sets real and effective group IDs of the calling process.
Supplying a value of -1 for either the real or effective group ID forces the system to leave that ID unchanged.
*)
external setregid : int -> int -> unit = "caml_extunix_setregid"
]
[%%have SETRESUID
(** [setresuid ruid euid suid] sets real, effective and saved user IDs of the calling process.
Supplying a value of -1 for either the real or effective user ID forces the system to leave that ID unchanged.
*)
external setresuid: int -> int -> int -> unit = "caml_extunix_setresuid"
(** [setresgid rgid egid sgid] sets real, effective and saved group IDs of the calling process.
Supplying a value of -1 for either the real or effective group ID forces the system to leave that ID unchanged.
*)
external setresgid: int -> int -> int -> unit = "caml_extunix_setresgid"
]
[%%have TCPGRP
external tcgetpgrp : Unix.file_descr -> int = "caml_extunix_tcgetpgrp"
external tcsetpgrp : Unix.file_descr -> int -> unit = "caml_extunix_tcsetpgrp"
]
(** Exit process without running any [at_exit] hooks (implemented in Pervasives) *)
external sys_exit : int -> 'a = "caml_sys_exit"
[%%have SYSINFO
(** NB all memory fields in this structure are the multiplies of [mem_unit] bytes *)
type sysinfo = {
uptime : int; (** Seconds since boot *)
loads : (float * float * float); (** 1, 5, and 15 minute load averages *)
totalram : int; (** Total usable main memory size *)
freeram : int; (** Available memory size *)
sharedram : int; (** Amount of shared memory *)
bufferram : int; (** Memory used by buffers *)
totalswap : int; (** Total swap space size *)
freeswap : int; (** swap space still available *)
procs : int; (** Number of current processes *)
totalhigh : int; (** Total high memory size *)
freehigh : int; (** Available high memory size *)
mem_unit : int; (** Memory unit size in bytes *)
}
(** @return overall system statistics *)
external sysinfo : unit -> sysinfo = "caml_extunix_sysinfo"
(** @return seconds since boot *)
external uptime : unit -> int = "caml_extunix_uptime"
]
(** {2 Network} *)
[%%have IFADDRS
(** @return the list of [AF_INET] and [AF_INET6] interfaces and corresponding addresses ({b may change}) *)
external getifaddrs : unit -> (string * string) list = "caml_extunix_getifaddrs"
]
[%%have SOCKOPT
(**/**)
type socket_int_option_ =
| TCP_KEEPCNT_
| TCP_KEEPIDLE_
| TCP_KEEPINTVL_
| SO_REUSEPORT_
| SO_ATTACH_BPF_
| SO_ATTACH_REUSEPORT_EBPF_
| SO_DETACH_FILTER_
| SO_DETACH_BPF_
| SO_LOCK_FILTER_
let string_of_socket_int_option_ = function
| TCP_KEEPCNT_ -> "TCP_KEEPCNT"
| TCP_KEEPIDLE_ -> "TCP_KEEPIDLE"
| TCP_KEEPINTVL_ -> "TCP_KEEPINTVL"
| SO_REUSEPORT_ -> "SO_REUSEPORT"
| SO_ATTACH_BPF_ -> "SO_ATTACH_BPF"
| SO_ATTACH_REUSEPORT_EBPF_ -> "SO_ATTACH_REUSEPORT_EBPF"
| SO_DETACH_FILTER_ -> "SO_DETACH_FILTER"
| SO_DETACH_BPF_ -> "SO_DETACH_BPF"
| SO_LOCK_FILTER_ -> "SO_LOCK_FILTER"
external setsockopt_int : Unix.file_descr -> socket_int_option_ -> int -> unit = "caml_extunix_setsockopt_int"
external getsockopt_int : Unix.file_descr -> socket_int_option_ -> int = "caml_extunix_getsockopt_int"
external have_sockopt_int : socket_int_option_ -> bool = "caml_extunix_have_sockopt"
let setsockopt_int sock opt v =
try setsockopt_int sock opt v
with Not_found -> raise (Not_available ("setsockopt " ^ string_of_socket_int_option_ opt))
let getsockopt_int sock opt =
try getsockopt_int sock opt
with Not_found -> raise (Not_available ("getsockopt " ^ string_of_socket_int_option_ opt))
(**/**)
(** Extra socket options with integer value not covered in {!Unix} module.
NB: Not all options available on all platforms, use {!have_sockopt_int} to check at runtime
(even when function is defined in [Specific] module).
*)
type socket_int_option =
| TCP_KEEPCNT (** The maximum number of keepalive probes TCP should send before dropping the connection *)
| TCP_KEEPIDLE (** The time (in seconds) the connection needs to remain idle before TCP starts sending
keepalive probes, if the socket option [SO_KEEPALIVE] has been set on this socket.
On Apple systems, [TCP_KEEPIDLE] is an alias to [TCP_KEEPALIVE]. *)
| TCP_KEEPINTVL (** The time (in seconds) between individual keepalive probes *)
| SO_ATTACH_BPF (** file descriptor returned by the bpf(2), with program of type [BPF_PROG_TYPE_SOCKET_FILTER] *)
| SO_ATTACH_REUSEPORT_EBPF (** same as for SO_ATTACH_BPF *)
type socket_bool_option =
| SO_REUSEPORT (** Permits multiple AF_INET or AF_INET6 sockets to be bound to an identical socket address. *)
| SO_LOCK_FILTER (** Prevent changing the filters associated with the socket *)
type socket_unit_option =
| SO_DETACH_FILTER (** Remove classic or extended BPF program attached to a socket *)
| SO_DETACH_BPF (** same *)
(**/**)
let make_socket_int_option = function
| TCP_KEEPCNT -> TCP_KEEPCNT_
| TCP_KEEPIDLE -> TCP_KEEPIDLE_
| TCP_KEEPINTVL -> TCP_KEEPINTVL_
| SO_ATTACH_BPF -> SO_ATTACH_BPF_
| SO_ATTACH_REUSEPORT_EBPF -> SO_ATTACH_REUSEPORT_EBPF_
let make_socket_bool_option = function
| SO_REUSEPORT -> SO_REUSEPORT_
| SO_LOCK_FILTER -> SO_LOCK_FILTER_
let make_socket_unit_option = function
| SO_DETACH_FILTER -> SO_DETACH_FILTER_
| SO_DETACH_BPF -> SO_DETACH_BPF_
(**/**)
let have_sockopt_unit x = have_sockopt_int (make_socket_unit_option x)
let have_sockopt_bool x = have_sockopt_int (make_socket_bool_option x)
let have_sockopt_int x = have_sockopt_int (make_socket_int_option x)
(** Obsolete, compatibility, use {!have_sockopt_int}.
@deprecated *)
let have_sockopt [@deprecated "Obsolete, compatibility, use have_sockopt_int."]
= have_sockopt_int
(** Set the option without value on the given socket *)
let setsockopt_unit sock opt = setsockopt_int sock (make_socket_unit_option opt) 0