diff options
Diffstat (limited to 'ocaml-binary-annot/otherlibs/unix')
107 files changed, 9698 insertions, 0 deletions
diff --git a/ocaml-binary-annot/otherlibs/unix/.cvsignore b/ocaml-binary-annot/otherlibs/unix/.cvsignore new file mode 100644 index 0000000000..29fea47264 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/.cvsignore @@ -0,0 +1,3 @@ +so_locations +*.so +*.a diff --git a/ocaml-binary-annot/otherlibs/unix/.depend b/ocaml-binary-annot/otherlibs/unix/.depend new file mode 100644 index 0000000000..42875bdcc8 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/.depend @@ -0,0 +1,456 @@ +accept.o: accept.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \ + socketaddr.h ../../byterun/misc.h +access.o: access.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h unixsupport.h +addrofstr.o: addrofstr.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/fail.h ../../byterun/mlvalues.h \ + unixsupport.h socketaddr.h ../../byterun/misc.h +alarm.o: alarm.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +bind.o: bind.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h socketaddr.h \ + ../../byterun/misc.h +chdir.o: chdir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +chmod.o: chmod.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +chown.o: chown.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +chroot.o: chroot.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +close.o: close.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +closedir.o: closedir.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h unixsupport.h +connect.o: connect.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h \ + socketaddr.h ../../byterun/misc.h +cst2constr.o: cst2constr.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/fail.h ../../byterun/mlvalues.h \ + cst2constr.h +cstringv.o: cstringv.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/mlvalues.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h +dup.o: dup.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +dup2.o: dup2.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +envir.o: envir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h +errmsg.o: errmsg.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h +execv.o: execv.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h +execve.o: execve.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h +execvp.o: execvp.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h +exit.o: exit.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +fchmod.o: fchmod.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +fchown.o: fchown.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +fcntl.o: fcntl.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +fork.o: fork.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h \ + ../../byterun/debugger.h ../../byterun/mlvalues.h unixsupport.h +ftruncate.o: ftruncate.c ../../byterun/fail.h \ + ../../byterun/compatibility.h ../../byterun/misc.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h ../../byterun/io.h unixsupport.h +getaddrinfo.o: getaddrinfo.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \ + cst2constr.h socketaddr.h ../../byterun/misc.h +getcwd.o: getcwd.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/fail.h unixsupport.h +getegid.o: getegid.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h unixsupport.h +geteuid.o: geteuid.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h unixsupport.h +getgid.o: getgid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +getgr.o: getgr.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/fail.h \ + ../../byterun/mlvalues.h ../../byterun/alloc.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h unixsupport.h +getgroups.o: getgroups.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h unixsupport.h +gethost.o: gethost.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \ + socketaddr.h ../../byterun/misc.h +gethostname.o: gethostname.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h unixsupport.h +getlogin.o: getlogin.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + unixsupport.h +getnameinfo.o: getnameinfo.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \ + socketaddr.h ../../byterun/misc.h +getpeername.o: getpeername.c ../../byterun/fail.h \ + ../../byterun/compatibility.h ../../byterun/misc.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h socketaddr.h \ + ../../byterun/misc.h +getpid.o: getpid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +getppid.o: getppid.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h unixsupport.h +getproto.o: getproto.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h unixsupport.h +getpw.o: getpw.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/fail.h unixsupport.h +getserv.o: getserv.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h unixsupport.h +getsockname.o: getsockname.c ../../byterun/fail.h \ + ../../byterun/compatibility.h ../../byterun/misc.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h socketaddr.h \ + ../../byterun/misc.h +gettimeofday.o: gettimeofday.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h unixsupport.h +getuid.o: getuid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +gmtime.o: gmtime.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h unixsupport.h +initgroups.o: initgroups.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h unixsupport.h +isatty.o: isatty.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +itimer.o: itimer.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h unixsupport.h +kill.o: kill.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/fail.h \ + ../../byterun/mlvalues.h unixsupport.h ../../byterun/signals.h +link.o: link.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +listen.o: listen.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +lockf.o: lockf.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h ../../byterun/signals.h unixsupport.h +lseek.o: lseek.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/io.h unixsupport.h +mkdir.o: mkdir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +mkfifo.o: mkfifo.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +nice.o: nice.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +open.o: open.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h +opendir.o: opendir.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + unixsupport.h +pipe.o: pipe.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h unixsupport.h +putenv.o: putenv.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h \ + ../../byterun/mlvalues.h unixsupport.h +read.o: read.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h \ + ../../byterun/signals.h unixsupport.h +readdir.o: readdir.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/fail.h ../../byterun/mlvalues.h \ + ../../byterun/alloc.h unixsupport.h +readlink.o: readlink.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h unixsupport.h +rename.o: rename.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +rewinddir.o: rewinddir.c ../../byterun/fail.h \ + ../../byterun/compatibility.h ../../byterun/misc.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +rmdir.o: rmdir.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +select.o: select.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h +sendrecv.o: sendrecv.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h \ + socketaddr.h ../../byterun/misc.h +setgid.o: setgid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +setgroups.o: setgroups.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h unixsupport.h +setsid.o: setsid.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +setuid.o: setuid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +shutdown.o: shutdown.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +signals.o: signals.c ../../byterun/alloc.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/mlvalues.h \ + ../../byterun/signals.h unixsupport.h +sleep.o: sleep.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h \ + ../../byterun/signals.h ../../byterun/mlvalues.h unixsupport.h +socket.o: socket.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +socketaddr.o: socketaddr.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h unixsupport.h \ + socketaddr.h ../../byterun/misc.h +socketpair.o: socketpair.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h unixsupport.h +sockopt.o: sockopt.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/mlvalues.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \ + ../../byterun/fail.h unixsupport.h socketaddr.h ../../byterun/misc.h +stat.o: stat.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h ../../byterun/alloc.h \ + unixsupport.h cst2constr.h ../../byterun/io.h +strofaddr.o: strofaddr.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h unixsupport.h socketaddr.h ../../byterun/misc.h +symlink.o: symlink.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +termios.o: termios.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/fail.h unixsupport.h +time.o: time.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h unixsupport.h +times.o: times.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h unixsupport.h +truncate.o: truncate.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/fail.h ../../byterun/mlvalues.h \ + ../../byterun/io.h unixsupport.h +umask.o: umask.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +unixsupport.o: unixsupport.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/mlvalues.h \ + ../../byterun/callback.h ../../byterun/memory.h ../../byterun/gc.h \ + ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/fail.h unixsupport.h \ + cst2constr.h +unlink.o: unlink.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h unixsupport.h +utimes.o: utimes.c ../../byterun/fail.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/mlvalues.h \ + ../../byterun/mlvalues.h unixsupport.h +wait.o: wait.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/alloc.h \ + ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/major_gc.h ../../byterun/freelist.h \ + ../../byterun/minor_gc.h ../../byterun/signals.h unixsupport.h +write.o: write.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/misc.h ../../byterun/memory.h \ + ../../byterun/gc.h ../../byterun/mlvalues.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/minor_gc.h \ + ../../byterun/signals.h unixsupport.h +unix.cmi: +unixLabels.cmi: unix.cmi +unix.cmo: unix.cmi +unix.cmx: unix.cmi +unixLabels.cmo: unix.cmi unixLabels.cmi +unixLabels.cmx: unix.cmx unixLabels.cmi diff --git a/ocaml-binary-annot/otherlibs/unix/Makefile b/ocaml-binary-annot/otherlibs/unix/Makefile new file mode 100644 index 0000000000..be72349694 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/Makefile @@ -0,0 +1,49 @@ +######################################################################### +# # +# Objective Caml # +# # +# Xavier Leroy, projet Cristal, INRIA Rocquencourt # +# # +# Copyright 1999 Institut National de Recherche en Informatique et # +# en Automatique. All rights reserved. This file is distributed # +# under the terms of the GNU Library General Public License, with # +# the special exception on linking described in file ../../LICENSE. # +# # +######################################################################### + +# $Id$ + +# Makefile for the Unix interface library + +LIBNAME=unix + +EXTRACAMLFLAGS=-nolabels + +COBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \ + chown.o chroot.o close.o closedir.o connect.o cst2constr.o cstringv.o \ + dup.o dup2.o envir.o errmsg.o execv.o execve.o execvp.o exit.o \ + fchmod.o fchown.o fcntl.o fork.o ftruncate.o \ + getaddrinfo.o getcwd.o getegid.o geteuid.o getgid.o \ + getgr.o getgroups.o gethost.o gethostname.o getlogin.o \ + getnameinfo.o getpeername.o getpid.o getppid.o getproto.o getpw.o \ + gettimeofday.o getserv.o getsockname.o getuid.o gmtime.o \ + initgroups.o isatty.o itimer.o kill.o link.o listen.o lockf.o lseek.o \ + mkdir.o mkfifo.o nice.o open.o opendir.o pipe.o putenv.o read.o \ + readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \ + setgid.o setgroups.o setsid.o setuid.o shutdown.o signals.o \ + sleep.o socket.o socketaddr.o \ + socketpair.o sockopt.o stat.o strofaddr.o symlink.o termios.o \ + time.o times.o truncate.o umask.o unixsupport.o unlink.o \ + utimes.o wait.o write.o + +CAMLOBJS=unix.cmo unixLabels.cmo + +HEADERS=unixsupport.h socketaddr.h + +include ../Makefile + +depend: + gcc -MM $(CFLAGS) *.c > .depend + ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend + +include .depend diff --git a/ocaml-binary-annot/otherlibs/unix/accept.c b/ocaml-binary-annot/otherlibs/unix/accept.c new file mode 100644 index 0000000000..a6e80f064f --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/accept.c @@ -0,0 +1,54 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include "socketaddr.h" + +CAMLprim value unix_accept(value sock) +{ + int retcode; + value res; + value a; + union sock_addr_union addr; + socklen_param_type addr_len; + + addr_len = sizeof(addr); + enter_blocking_section(); + retcode = accept(Int_val(sock), &addr.s_gen, &addr_len); + leave_blocking_section(); + if (retcode == -1) uerror("accept", Nothing); + a = alloc_sockaddr(&addr, addr_len, retcode); + Begin_root (a); + res = alloc_small(2, 0); + Field(res, 0) = Val_int(retcode); + Field(res, 1) = a; + End_roots(); + return res; +} + +#else + +CAMLprim value unix_accept(value sock) +{ invalid_argument("accept not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/access.c b/ocaml-binary-annot/otherlibs/unix/access.c new file mode 100644 index 0000000000..0c0c5fc1a3 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/access.c @@ -0,0 +1,52 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include "unixsupport.h" + +#ifdef HAS_UNISTD +# include <unistd.h> +#else +# ifndef _WIN32 +# include <sys/file.h> +# ifndef R_OK +# define R_OK 4/* test for read permission */ +# define W_OK 2/* test for write permission */ +# define X_OK 1/* test for execute (search) permission */ +# define F_OK 0/* test for presence of file */ +# endif +# else +# define R_OK 4/* test for read permission */ +# define W_OK 2/* test for write permission */ +# define X_OK 4/* test for execute permission - not implemented in Win32 */ +# define F_OK 0/* test for presence of file */ +# endif +#endif + +static int access_permission_table[] = { + R_OK, W_OK, X_OK, F_OK +}; + +CAMLprim value unix_access(value path, value perms) +{ + int ret, cv_flags; + + cv_flags = convert_flag_list(perms, access_permission_table); + ret = access(String_val(path), cv_flags); + if (ret == -1) + uerror("access", path); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/addrofstr.c b/ocaml-binary-annot/otherlibs/unix/addrofstr.c new file mode 100644 index 0000000000..6947d66f11 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/addrofstr.c @@ -0,0 +1,53 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <fail.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include "socketaddr.h" + +CAMLprim value unix_inet_addr_of_string(value s) +{ +#if defined(HAS_IPV6) + struct in_addr address; + struct in6_addr address6; + if (inet_pton(AF_INET, String_val(s), &address) > 0) + return alloc_inet_addr(&address); + else if (inet_pton(AF_INET6, String_val(s), &address6) > 0) + return alloc_inet6_addr(&address6); + else + failwith("inet_addr_of_string"); +#elif defined(HAS_INET_ATON) + struct in_addr address; + if (inet_aton(String_val(s), &address) == 0) + failwith("inet_addr_of_string"); + return alloc_inet_addr(&address); +#else + struct in_addr address; + address.s_addr = inet_addr(String_val(s)); + if (address.s_addr == (uint32) -1) failwith("inet_addr_of_string"); + return alloc_inet_addr(&address); +#endif +} + +#else + +CAMLprim value unix_inet_addr_of_string(value s) +{ invalid_argument("inet_addr_of_string not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/alarm.c b/ocaml-binary-annot/otherlibs/unix/alarm.c new file mode 100644 index 0000000000..55e4d6cf80 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/alarm.c @@ -0,0 +1,22 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_alarm(value t) +{ + return Val_int(alarm((unsigned int) Long_val(t))); +} diff --git a/ocaml-binary-annot/otherlibs/unix/bind.c b/ocaml-binary-annot/otherlibs/unix/bind.c new file mode 100644 index 0000000000..85cf1d28aa --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/bind.c @@ -0,0 +1,41 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include "socketaddr.h" + +CAMLprim value unix_bind(value socket, value address) +{ + int ret; + union sock_addr_union addr; + socklen_param_type addr_len; + + get_sockaddr(address, &addr, &addr_len); + ret = bind(Int_val(socket), &addr.s_gen, addr_len); + if (ret == -1) uerror("bind", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_bind(value socket, value address) +{ invalid_argument("bind not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/chdir.c b/ocaml-binary-annot/otherlibs/unix/chdir.c new file mode 100644 index 0000000000..7901eca0e4 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/chdir.c @@ -0,0 +1,25 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_chdir(value path) +{ + int ret; + ret = chdir(String_val(path)); + if (ret == -1) uerror("chdir", path); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/chmod.c b/ocaml-binary-annot/otherlibs/unix/chmod.c new file mode 100644 index 0000000000..dff837223e --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/chmod.c @@ -0,0 +1,27 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <sys/types.h> +#include <sys/stat.h> +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_chmod(value path, value perm) +{ + int ret; + ret = chmod(String_val(path), Int_val(perm)); + if (ret == -1) uerror("chmod", path); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/chown.c b/ocaml-binary-annot/otherlibs/unix/chown.c new file mode 100644 index 0000000000..bfd164008f --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/chown.c @@ -0,0 +1,25 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_chown(value path, value uid, value gid) +{ + int ret; + ret = chown(String_val(path), Int_val(uid), Int_val(gid)); + if (ret == -1) uerror("chown", path); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/chroot.c b/ocaml-binary-annot/otherlibs/unix/chroot.c new file mode 100644 index 0000000000..24f49877d5 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/chroot.c @@ -0,0 +1,25 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_chroot(value path) +{ + int ret; + ret = chroot(String_val(path)); + if (ret == -1) uerror("chroot", path); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/close.c b/ocaml-binary-annot/otherlibs/unix/close.c new file mode 100644 index 0000000000..27e1937df4 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/close.c @@ -0,0 +1,23 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_close(value fd) +{ + if (close(Int_val(fd)) == -1) uerror("close", Nothing); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/closedir.c b/ocaml-binary-annot/otherlibs/unix/closedir.c new file mode 100644 index 0000000000..b2fd51357d --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/closedir.c @@ -0,0 +1,33 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" +#include <errno.h> +#include <sys/types.h> +#ifdef HAS_DIRENT +#include <dirent.h> +#else +#include <sys/dir.h> +#endif + +CAMLprim value unix_closedir(value vd) +{ + DIR * d = DIR_Val(vd); + if (d == (DIR *) NULL) unix_error(EBADF, "closedir", Nothing); + closedir(d); + DIR_Val(vd) = (DIR *) NULL; + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/connect.c b/ocaml-binary-annot/otherlibs/unix/connect.c new file mode 100644 index 0000000000..669c347f3f --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/connect.c @@ -0,0 +1,44 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include <signals.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include "socketaddr.h" + +CAMLprim value unix_connect(value socket, value address) +{ + int retcode; + union sock_addr_union addr; + socklen_param_type addr_len; + + get_sockaddr(address, &addr, &addr_len); + enter_blocking_section(); + retcode = connect(Int_val(socket), &addr.s_gen, addr_len); + leave_blocking_section(); + if (retcode == -1) uerror("connect", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_connect(value socket, value address) +{ invalid_argument("connect not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/cst2constr.c b/ocaml-binary-annot/otherlibs/unix/cst2constr.c new file mode 100644 index 0000000000..9035160dcc --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/cst2constr.c @@ -0,0 +1,26 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <fail.h> +#include "cst2constr.h" + +value cst_to_constr(int n, int *tbl, int size, int deflt) +{ + int i; + for (i = 0; i < size; i++) + if (n == tbl[i]) return Val_int(i); + return Val_int(deflt); +} diff --git a/ocaml-binary-annot/otherlibs/unix/cst2constr.h b/ocaml-binary-annot/otherlibs/unix/cst2constr.h new file mode 100644 index 0000000000..3cb1c11824 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/cst2constr.h @@ -0,0 +1,16 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +extern value cst_to_constr(int n, int * tbl, int size, int deflt); diff --git a/ocaml-binary-annot/otherlibs/unix/cstringv.c b/ocaml-binary-annot/otherlibs/unix/cstringv.c new file mode 100644 index 0000000000..0e37914d82 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/cstringv.c @@ -0,0 +1,30 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <memory.h> +#include "unixsupport.h" + +char ** cstringvect(value arg) +{ + char ** res; + mlsize_t size, i; + + size = Wosize_val(arg); + res = (char **) stat_alloc((size + 1) * sizeof(char *)); + for (i = 0; i < size; i++) res[i] = String_val(Field(arg, i)); + res[size] = NULL; + return res; +} diff --git a/ocaml-binary-annot/otherlibs/unix/dup.c b/ocaml-binary-annot/otherlibs/unix/dup.c new file mode 100644 index 0000000000..5935d0b440 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/dup.c @@ -0,0 +1,25 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_dup(value fd) +{ + int ret; + ret = dup(Int_val(fd)); + if (ret == -1) uerror("dup", Nothing); + return Val_int(ret); +} diff --git a/ocaml-binary-annot/otherlibs/unix/dup2.c b/ocaml-binary-annot/otherlibs/unix/dup2.c new file mode 100644 index 0000000000..beb987133b --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/dup2.c @@ -0,0 +1,49 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_DUP2 + +CAMLprim value unix_dup2(value fd1, value fd2) +{ + if (dup2(Int_val(fd1), Int_val(fd2)) == -1) uerror("dup2", Nothing); + return Val_unit; +} + +#else + +static int do_dup2(int fd1, int fd2) +{ + int fd; + int res; + + fd = dup(fd1); + if (fd == -1) return -1; + if (fd == fd2) return 0; + res = do_dup2(fd1, fd2); + close(fd); + return res; +} + +CAMLprim value unix_dup2(value fd1, value fd2) +{ + close(Int_val(fd2)); + if (do_dup2(Int_val(fd1), Int_val(fd2)) == -1) uerror("dup2", Nothing); + return Val_unit; +} + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/envir.c b/ocaml-binary-annot/otherlibs/unix/envir.c new file mode 100644 index 0000000000..1df842c593 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/envir.c @@ -0,0 +1,26 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> + +#ifndef _WIN32 +extern char ** environ; +#endif + +CAMLprim value unix_environment(value unit) +{ + return copy_string_array((const char**)environ); +} diff --git a/ocaml-binary-annot/otherlibs/unix/errmsg.c b/ocaml-binary-annot/otherlibs/unix/errmsg.c new file mode 100644 index 0000000000..ae8793e196 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/errmsg.c @@ -0,0 +1,28 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <errno.h> +#include <string.h> +#include <mlvalues.h> +#include <alloc.h> + +extern int error_table[]; + +CAMLprim value unix_error_message(value err) +{ + int errnum; + errnum = Is_block(err) ? Int_val(Field(err, 0)) : error_table[Int_val(err)]; + return copy_string(strerror(errnum)); +} diff --git a/ocaml-binary-annot/otherlibs/unix/execv.c b/ocaml-binary-annot/otherlibs/unix/execv.c new file mode 100644 index 0000000000..bc0330b356 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/execv.c @@ -0,0 +1,31 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <memory.h> +#include "unixsupport.h" + +extern char ** cstringvect(); + +CAMLprim value unix_execv(value path, value args) +{ + char ** argv; + argv = cstringvect(args); + (void) execv(String_val(path), argv); + stat_free((char *) argv); + uerror("execv", path); + return Val_unit; /* never reached, but suppress warnings */ + /* from smart compilers */ +} diff --git a/ocaml-binary-annot/otherlibs/unix/execve.c b/ocaml-binary-annot/otherlibs/unix/execve.c new file mode 100644 index 0000000000..4d29fb55b7 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/execve.c @@ -0,0 +1,34 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <memory.h> +#include "unixsupport.h" + +extern char ** cstringvect(); + +CAMLprim value unix_execve(value path, value args, value env) +{ + char ** argv; + char ** envp; + argv = cstringvect(args); + envp = cstringvect(env); + (void) execve(String_val(path), argv, envp); + stat_free((char *) argv); + stat_free((char *) envp); + uerror("execve", path); + return Val_unit; /* never reached, but suppress warnings */ + /* from smart compilers */ +} diff --git a/ocaml-binary-annot/otherlibs/unix/execvp.c b/ocaml-binary-annot/otherlibs/unix/execvp.c new file mode 100644 index 0000000000..6d03a29ea4 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/execvp.c @@ -0,0 +1,50 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <memory.h> +#include "unixsupport.h" + +extern char ** cstringvect(); +#ifndef _WIN32 +extern char ** environ; +#endif + +CAMLprim value unix_execvp(value path, value args) +{ + char ** argv; + argv = cstringvect(args); + (void) execvp(String_val(path), argv); + stat_free((char *) argv); + uerror("execvp", path); + return Val_unit; /* never reached, but suppress warnings */ + /* from smart compilers */ +} + +CAMLprim value unix_execvpe(value path, value args, value env) +{ + char ** argv; + char ** saved_environ; + argv = cstringvect(args); + saved_environ = environ; + environ = cstringvect(env); + (void) execvp(String_val(path), argv); + stat_free((char *) argv); + stat_free((char *) environ); + environ = saved_environ; + uerror("execvp", path); + return Val_unit; /* never reached, but suppress warnings */ + /* from smart compilers */ +} diff --git a/ocaml-binary-annot/otherlibs/unix/exit.c b/ocaml-binary-annot/otherlibs/unix/exit.c new file mode 100644 index 0000000000..8f1df6d532 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/exit.c @@ -0,0 +1,24 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_exit(value n) +{ + _exit(Int_val(n)); + return Val_unit; /* never reached, but suppress warnings */ + /* from smart compilers */ +} diff --git a/ocaml-binary-annot/otherlibs/unix/fchmod.c b/ocaml-binary-annot/otherlibs/unix/fchmod.c new file mode 100644 index 0000000000..a90de6ef1f --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/fchmod.c @@ -0,0 +1,35 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <sys/types.h> +#include <sys/stat.h> +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_FCHMOD + +CAMLprim value unix_fchmod(value fd, value perm) +{ + if (fchmod(Int_val(fd), Int_val(perm)) == -1) uerror("fchmod", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_fchmod(value fd, value perm) +{ invalid_argument("fchmod not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/fchown.c b/ocaml-binary-annot/otherlibs/unix/fchown.c new file mode 100644 index 0000000000..29683a5c79 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/fchown.c @@ -0,0 +1,34 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_FCHMOD + +CAMLprim value unix_fchown(value fd, value uid, value gid) +{ + if (fchown(Int_val(fd), Int_val(uid), Int_val(gid)) == -1) + uerror("fchown", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_fchown(value fd, value uid, value gid) +{ invalid_argument("fchown not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/fcntl.c b/ocaml-binary-annot/otherlibs/unix/fcntl.c new file mode 100644 index 0000000000..a0891b2c30 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/fcntl.c @@ -0,0 +1,78 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" +#ifdef HAS_UNISTD +#include <unistd.h> +#endif +#include <fcntl.h> + +#ifndef O_NONBLOCK +#define O_NONBLOCK O_NDELAY +#endif + +CAMLprim value unix_set_nonblock(value fd) +{ + int retcode; + retcode = fcntl(Int_val(fd), F_GETFL, 0); + if (retcode == -1 || + fcntl(Int_val(fd), F_SETFL, retcode | O_NONBLOCK) == -1) + uerror("set_nonblock", Nothing); + return Val_unit; +} + +CAMLprim value unix_clear_nonblock(value fd) +{ + int retcode; + retcode = fcntl(Int_val(fd), F_GETFL, 0); + if (retcode == -1 || + fcntl(Int_val(fd), F_SETFL, retcode & ~O_NONBLOCK) == -1) + uerror("clear_nonblock", Nothing); + return Val_unit; +} + +#ifdef FD_CLOEXEC + +CAMLprim value unix_set_close_on_exec(value fd) +{ + int retcode; + retcode = fcntl(Int_val(fd), F_GETFD, 0); + if (retcode == -1 || + fcntl(Int_val(fd), F_SETFD, retcode | FD_CLOEXEC) == -1) + uerror("set_close_on_exec", Nothing); + return Val_unit; +} + +CAMLprim value unix_clear_close_on_exec(value fd) +{ + int retcode; + retcode = fcntl(Int_val(fd), F_GETFD, 0); + if (retcode == -1 || + fcntl(Int_val(fd), F_SETFD, retcode & ~FD_CLOEXEC) == -1) + uerror("clear_close_on_exec", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_set_close_on_exec(value fd) +{ invalid_argument("set_close_on_exec not implemented"); } + +CAMLprim value unix_clear_close_on_exec(value fd) +{ invalid_argument("clear_close_on_exec not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/fork.c b/ocaml-binary-annot/otherlibs/unix/fork.c new file mode 100644 index 0000000000..74ec6294d0 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/fork.c @@ -0,0 +1,30 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <debugger.h> +#include "unixsupport.h" + +CAMLprim value unix_fork(value unit) +{ + int ret; + ret = fork(); + if (ret == -1) uerror("fork", Nothing); + if (caml_debugger_in_use) + if ((caml_debugger_fork_mode && ret == 0) || + (!caml_debugger_fork_mode && ret != 0)) + caml_debugger_cleanup_fork(); + return Val_int(ret); +} diff --git a/ocaml-binary-annot/otherlibs/unix/ftruncate.c b/ocaml-binary-annot/otherlibs/unix/ftruncate.c new file mode 100644 index 0000000000..661640e353 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/ftruncate.c @@ -0,0 +1,49 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <sys/types.h> +#include <fail.h> +#include <mlvalues.h> +#include <io.h> +#include "unixsupport.h" +#ifdef HAS_UNISTD +#include <unistd.h> +#endif + +#ifdef HAS_TRUNCATE + +CAMLprim value unix_ftruncate(value fd, value len) +{ + if (ftruncate(Int_val(fd), Long_val(len)) == -1) + uerror("ftruncate", Nothing); + return Val_unit; +} + +CAMLprim value unix_ftruncate_64(value fd, value len) +{ + if (ftruncate(Int_val(fd), File_offset_val(len)) == -1) + uerror("ftruncate", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_ftruncate(value fd, value len) +{ invalid_argument("ftruncate not implemented"); } + +CAMLprim value unix_ftruncate_64(value fd, value len) +{ invalid_argument("ftruncate not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/getaddrinfo.c b/ocaml-binary-annot/otherlibs/unix/getaddrinfo.c new file mode 100644 index 0000000000..adc54998a7 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getaddrinfo.c @@ -0,0 +1,136 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2004 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <string.h> +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" +#include "cst2constr.h" + +#if defined(HAS_SOCKETS) && defined(HAS_IPV6) + +#include "socketaddr.h" +#ifndef _WIN32 +#include <sys/types.h> +#include <netdb.h> +#endif + +extern int socket_domain_table[]; /* from socket.c */ +extern int socket_type_table[]; /* from socket.c */ + +static value convert_addrinfo(struct addrinfo * a) +{ + CAMLparam0(); + CAMLlocal3(vres,vaddr,vcanonname); + union sock_addr_union sa; + socklen_param_type len; + + len = a->ai_addrlen; + if (len > sizeof(sa)) len = sizeof(sa); + memcpy(&sa.s_gen, a->ai_addr, len); + vaddr = alloc_sockaddr(&sa, len, -1); + vcanonname = copy_string(a->ai_canonname == NULL ? "" : a->ai_canonname); + vres = alloc_small(5, 0); + Field(vres, 0) = cst_to_constr(a->ai_family, socket_domain_table, 3, 0); + Field(vres, 1) = cst_to_constr(a->ai_socktype, socket_type_table, 4, 0); + Field(vres, 2) = Val_int(a->ai_protocol); + Field(vres, 3) = vaddr; + Field(vres, 4) = vcanonname; + CAMLreturn(vres); +} + +CAMLprim value unix_getaddrinfo(value vnode, value vserv, value vopts) +{ + CAMLparam3(vnode, vserv, vopts); + CAMLlocal3(vres, v, e); + mlsize_t len; + char * node, * serv; + struct addrinfo hints; + struct addrinfo * res, * r; + int retcode; + + /* Extract "node" parameter */ + len = string_length(vnode); + if (len == 0) { + node = NULL; + } else { + node = stat_alloc(len + 1); + strcpy(node, String_val(vnode)); + } + /* Extract "service" parameter */ + len = string_length(vserv); + if (len == 0) { + serv = NULL; + } else { + serv = stat_alloc(len + 1); + strcpy(serv, String_val(vserv)); + } + /* Parse options, set hints */ + memset(&hints, 0, sizeof(hints)); + hints.ai_family = PF_UNSPEC; + for (/*nothing*/; Is_block(vopts); vopts = Field(vopts, 1)) { + v = Field(vopts, 0); + if (Is_block(v)) + switch (Tag_val(v)) { + case 0: /* AI_FAMILY of socket_domain */ + hints.ai_family = socket_domain_table[Int_val(Field(v, 0))]; + break; + case 1: /* AI_SOCKTYPE of socket_type */ + hints.ai_socktype = socket_type_table[Int_val(Field(v, 0))]; + break; + case 2: /* AI_PROTOCOL of int */ + hints.ai_protocol = Int_val(Field(v, 0)); + break; + } + else + switch (Int_val(v)) { + case 0: /* AI_NUMERICHOST */ + hints.ai_flags |= AI_NUMERICHOST; break; + case 1: /* AI_CANONNAME */ + hints.ai_flags |= AI_CANONNAME; break; + case 2: /* AI_PASSIVE */ + hints.ai_flags |= AI_PASSIVE; break; + } + } + /* Do the call */ + enter_blocking_section(); + retcode = getaddrinfo(node, serv, &hints, &res); + leave_blocking_section(); + if (node != NULL) stat_free(node); + if (serv != NULL) stat_free(serv); + /* Convert result */ + vres = Val_int(0); + if (retcode == 0) { + for (r = res; r != NULL; r = r->ai_next) { + e = convert_addrinfo(r); + v = alloc_small(2, 0); + Field(v, 0) = e; + Field(v, 1) = vres; + vres = v; + } + freeaddrinfo(res); + } + CAMLreturn(vres); +} + +#else + +CAMLprim value unix_getaddrinfo(value vnode, value vserv, value vopts) +{ invalid_argument("getaddrinfo not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/getcwd.c b/ocaml-binary-annot/otherlibs/unix/getcwd.c new file mode 100644 index 0000000000..7c735b68dc --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getcwd.c @@ -0,0 +1,58 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include "unixsupport.h" + +#if !defined (_WIN32) && !macintosh +#include <sys/param.h> +#endif + +#ifndef PATH_MAX +#ifdef MAXPATHLEN +#define PATH_MAX MAXPATHLEN +#else +#define PATH_MAX 512 +#endif +#endif + +#ifdef HAS_GETCWD + +CAMLprim value unix_getcwd(value unit) +{ + char buff[PATH_MAX]; + if (getcwd(buff, sizeof(buff)) == 0) uerror("getcwd", Nothing); + return copy_string(buff); +} + +#else +#ifdef HAS_GETWD + +CAMLprim value unix_getcwd(value unit) +{ + char buff[PATH_MAX]; + if (getwd(buff) == 0) uerror("getcwd", copy_string(buff)); + return copy_string(buff); +} + +#else + +CAMLprim value unix_getcwd(value unit) +{ invalid_argument("getcwd not implemented"); } + +#endif +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/getegid.c b/ocaml-binary-annot/otherlibs/unix/getegid.c new file mode 100644 index 0000000000..02beaf1241 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getegid.c @@ -0,0 +1,22 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_getegid(value unit) +{ + return Val_int(getegid()); +} diff --git a/ocaml-binary-annot/otherlibs/unix/geteuid.c b/ocaml-binary-annot/otherlibs/unix/geteuid.c new file mode 100644 index 0000000000..7c9f660afe --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/geteuid.c @@ -0,0 +1,22 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_geteuid(value unit) +{ + return Val_int(geteuid()); +} diff --git a/ocaml-binary-annot/otherlibs/unix/getgid.c b/ocaml-binary-annot/otherlibs/unix/getgid.c new file mode 100644 index 0000000000..d0ed4bff74 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getgid.c @@ -0,0 +1,22 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_getgid(value unit) +{ + return Val_int(getgid()); +} diff --git a/ocaml-binary-annot/otherlibs/unix/getgr.c b/ocaml-binary-annot/otherlibs/unix/getgr.c new file mode 100644 index 0000000000..eefaa5979c --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getgr.c @@ -0,0 +1,56 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <fail.h> +#include <alloc.h> +#include <memory.h> +#include "unixsupport.h" +#include <stdio.h> +#include <grp.h> + +static value alloc_group_entry(struct group *entry) +{ + value res; + value name = Val_unit, pass = Val_unit, mem = Val_unit; + + Begin_roots3 (name, pass, mem); + name = copy_string(entry->gr_name); + pass = copy_string(entry->gr_passwd); + mem = copy_string_array((const char**)entry->gr_mem); + res = alloc_small(4, 0); + Field(res,0) = name; + Field(res,1) = pass; + Field(res,2) = Val_int(entry->gr_gid); + Field(res,3) = mem; + End_roots(); + return res; +} + +CAMLprim value unix_getgrnam(value name) +{ + struct group * entry; + entry = getgrnam(String_val(name)); + if (entry == NULL) raise_not_found(); + return alloc_group_entry(entry); +} + +CAMLprim value unix_getgrgid(value gid) +{ + struct group * entry; + entry = getgrgid(Int_val(gid)); + if (entry == NULL) raise_not_found(); + return alloc_group_entry(entry); +} diff --git a/ocaml-binary-annot/otherlibs/unix/getgroups.c b/ocaml-binary-annot/otherlibs/unix/getgroups.c new file mode 100644 index 0000000000..4d34d5be90 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getgroups.c @@ -0,0 +1,49 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> + +#ifdef HAS_GETGROUPS + +#include <sys/types.h> +#ifdef HAS_UNISTD +#include <unistd.h> +#endif +#include <limits.h> +#include "unixsupport.h" + +CAMLprim value unix_getgroups(value unit) +{ + gid_t gidset[NGROUPS_MAX]; + int n; + value res; + int i; + + n = getgroups(NGROUPS_MAX, gidset); + if (n == -1) uerror("getgroups", Nothing); + res = alloc_tuple(n); + for (i = 0; i < n; i++) + Field(res, i) = Val_int(gidset[i]); + return res; +} + +#else + +CAMLprim value unix_getgroups(value unit) +{ invalid_argument("getgroups not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/gethost.c b/ocaml-binary-annot/otherlibs/unix/gethost.c new file mode 100644 index 0000000000..36fdfd8ef9 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/gethost.c @@ -0,0 +1,183 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <string.h> +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include "socketaddr.h" +#ifndef _WIN32 +#include <sys/types.h> +#include <netdb.h> +#endif + +#define NETDB_BUFFER_SIZE 10000 + +#ifdef _WIN32 +#define GETHOSTBYADDR_IS_REENTRANT 1 +#define GETHOSTBYNAME_IS_REENTRANT 1 +#endif + +static int entry_h_length; + +extern int socket_domain_table[]; + +static value alloc_one_addr(char const *a) +{ + struct in_addr addr; +#ifdef HAS_IPV6 + struct in6_addr addr6; + if (entry_h_length == 16) { + memmove(&addr6, a, 16); + return alloc_inet6_addr(&addr6); + } +#endif + memmove (&addr, a, 4); + return alloc_inet_addr(&addr); +} + +static value alloc_host_entry(struct hostent *entry) +{ + value res; + value name = Val_unit, aliases = Val_unit; + value addr_list = Val_unit, adr = Val_unit; + + Begin_roots4 (name, aliases, addr_list, adr); + name = copy_string((char *)(entry->h_name)); + /* PR#4043: protect against buggy implementations of gethostbyname() + that return a NULL pointer in h_aliases */ + if (entry->h_aliases) + aliases = copy_string_array((const char**)entry->h_aliases); + else + aliases = Atom(0); + entry_h_length = entry->h_length; +#ifdef h_addr + addr_list = alloc_array(alloc_one_addr, (const char**)entry->h_addr_list); +#else + adr = alloc_one_addr(entry->h_addr); + addr_list = alloc_small(1, 0); + Field(addr_list, 0) = adr; +#endif + res = alloc_small(4, 0); + Field(res, 0) = name; + Field(res, 1) = aliases; + switch (entry->h_addrtype) { + case PF_UNIX: Field(res, 2) = Val_int(0); break; + case PF_INET: Field(res, 2) = Val_int(1); break; + default: /*PF_INET6 */ Field(res, 2) = Val_int(2); break; + } + Field(res, 3) = addr_list; + End_roots(); + return res; +} + +CAMLprim value unix_gethostbyaddr(value a) +{ + struct in_addr adr = GET_INET_ADDR(a); + struct hostent * hp; +#if HAS_GETHOSTBYADDR_R == 7 + struct hostent h; + char buffer[NETDB_BUFFER_SIZE]; + int h_errnop; + enter_blocking_section(); + hp = gethostbyaddr_r((char *) &adr, 4, AF_INET, + &h, buffer, sizeof(buffer), &h_errnop); + leave_blocking_section(); +#elif HAS_GETHOSTBYADDR_R == 8 + struct hostent h; + char buffer[NETDB_BUFFER_SIZE]; + int h_errnop, rc; + enter_blocking_section(); + rc = gethostbyaddr_r((char *) &adr, 4, AF_INET, + &h, buffer, sizeof(buffer), &hp, &h_errnop); + leave_blocking_section(); + if (rc != 0) hp = NULL; +#else +#ifdef GETHOSTBYADDR_IS_REENTRANT + enter_blocking_section(); +#endif + hp = gethostbyaddr((char *) &adr, 4, AF_INET); +#ifdef GETHOSTBYADDR_IS_REENTRANT + leave_blocking_section(); +#endif +#endif + if (hp == (struct hostent *) NULL) raise_not_found(); + return alloc_host_entry(hp); +} + +CAMLprim value unix_gethostbyname(value name) +{ + struct hostent * hp; + char * hostname; + +#if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT + hostname = stat_alloc(string_length(name) + 1); + strcpy(hostname, String_val(name)); +#else + hostname = String_val(name); +#endif + +#if HAS_GETHOSTBYNAME_R == 5 + { + struct hostent h; + char buffer[NETDB_BUFFER_SIZE]; + int h_errno; + enter_blocking_section(); + hp = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &h_errno); + leave_blocking_section(); + } +#elif HAS_GETHOSTBYNAME_R == 6 + { + struct hostent h; + char buffer[NETDB_BUFFER_SIZE]; + int h_errno, rc; + enter_blocking_section(); + rc = gethostbyname_r(hostname, &h, buffer, sizeof(buffer), &hp, &h_errno); + leave_blocking_section(); + if (rc != 0) hp = NULL; + } +#else +#ifdef GETHOSTBYNAME_IS_REENTRANT + enter_blocking_section(); +#endif + hp = gethostbyname(hostname); +#ifdef GETHOSTBYNAME_IS_REENTRANT + leave_blocking_section(); +#endif +#endif + +#if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT + stat_free(hostname); +#endif + + if (hp == (struct hostent *) NULL) raise_not_found(); + return alloc_host_entry(hp); +} + +#else + +CAMLprim value unix_gethostbyaddr(value name) +{ invalid_argument("gethostbyaddr not implemented"); } + +CAMLprim value unix_gethostbyname(value name) +{ invalid_argument("gethostbyname not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/gethostname.c b/ocaml-binary-annot/otherlibs/unix/gethostname.c new file mode 100644 index 0000000000..f84f8f5b56 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/gethostname.c @@ -0,0 +1,58 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#if defined (_WIN32) +#include <winsock.h> +#else +#include <sys/param.h> +#endif +#include "unixsupport.h" + +#ifdef HAS_GETHOSTNAME + +#ifndef MAXHOSTNAMELEN +#define MAXHOSTNAMELEN 256 +#endif + +CAMLprim value unix_gethostname(value unit) +{ + char name[MAXHOSTNAMELEN]; + gethostname(name, MAXHOSTNAMELEN); + name[MAXHOSTNAMELEN-1] = 0; + return copy_string(name); +} + +#else +#ifdef HAS_UNAME + +#include <sys/utsname.h> + +CAMLprim value unix_gethostname(value unit) +{ + struct utsname un; + uname(&un); + return copy_string(un.nodename); +} + +#else + +CAMLprim value unix_gethostname(value unit) +{ invalid_argument("gethostname not implemented"); } + +#endif +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/getlogin.c b/ocaml-binary-annot/otherlibs/unix/getlogin.c new file mode 100644 index 0000000000..132ed443a4 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getlogin.c @@ -0,0 +1,29 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include "unixsupport.h" +#include <errno.h> + +extern char * getlogin(void); + +CAMLprim value unix_getlogin(value unit) +{ + char * name; + name = getlogin(); + if (name == NULL) unix_error(ENOENT, "getlogin", Nothing); + return copy_string(name); +} diff --git a/ocaml-binary-annot/otherlibs/unix/getnameinfo.c b/ocaml-binary-annot/otherlibs/unix/getnameinfo.c new file mode 100644 index 0000000000..c887856993 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getnameinfo.c @@ -0,0 +1,67 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2004 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <string.h> +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" + +#if defined(HAS_SOCKETS) && defined(HAS_IPV6) + +#include "socketaddr.h" +#ifndef _WIN32 +#include <sys/types.h> +#include <netdb.h> +#endif + +static int getnameinfo_flag_table[] = { + NI_NOFQDN, NI_NUMERICHOST, NI_NAMEREQD, NI_NUMERICSERV, NI_DGRAM +}; + +CAMLprim value unix_getnameinfo(value vaddr, value vopts) +{ + CAMLparam0(); + CAMLlocal3(vhost, vserv, vres); + union sock_addr_union addr; + socklen_param_type addr_len; + char host[4096]; + char serv[1024]; + int opts, retcode; + + get_sockaddr(vaddr, &addr, &addr_len); + opts = convert_flag_list(vopts, getnameinfo_flag_table); + enter_blocking_section(); + retcode = + getnameinfo((const struct sockaddr *) &addr.s_gen, addr_len, + host, sizeof(host), serv, sizeof(serv), opts); + leave_blocking_section(); + if (retcode != 0) raise_not_found(); /* TODO: detailed error reporting? */ + vhost = copy_string(host); + vserv = copy_string(serv); + vres = alloc_small(2, 0); + Field(vres, 0) = vhost; + Field(vres, 1) = vserv; + CAMLreturn(vres); +} + +#else + +CAMLprim value unix_getnameinfo(value vaddr, value vopts) +{ invalid_argument("getnameinfo not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/getpeername.c b/ocaml-binary-annot/otherlibs/unix/getpeername.c new file mode 100644 index 0000000000..20a837ca19 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getpeername.c @@ -0,0 +1,41 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include "socketaddr.h" + +CAMLprim value unix_getpeername(value sock) +{ + int retcode; + union sock_addr_union addr; + socklen_param_type addr_len; + + addr_len = sizeof(addr); + retcode = getpeername(Int_val(sock), &addr.s_gen, &addr_len); + if (retcode == -1) uerror("getpeername", Nothing); + return alloc_sockaddr(&addr, addr_len, -1); +} + +#else + +CAMLprim value unix_getpeername(value sock) +{ invalid_argument("getpeername not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/getpid.c b/ocaml-binary-annot/otherlibs/unix/getpid.c new file mode 100644 index 0000000000..cb522749de --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getpid.c @@ -0,0 +1,22 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_getpid(value unit) +{ + return Val_int(getpid()); +} diff --git a/ocaml-binary-annot/otherlibs/unix/getppid.c b/ocaml-binary-annot/otherlibs/unix/getppid.c new file mode 100644 index 0000000000..0d69aafb4a --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getppid.c @@ -0,0 +1,22 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_getppid(value unit) +{ + return Val_int(getppid()); +} diff --git a/ocaml-binary-annot/otherlibs/unix/getproto.c b/ocaml-binary-annot/otherlibs/unix/getproto.c new file mode 100644 index 0000000000..c9ca1a5c9e --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getproto.c @@ -0,0 +1,70 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#ifndef _WIN32 +#include <netdb.h> +#else +#include <winsock.h> +#endif + +static value alloc_proto_entry(struct protoent *entry) +{ + value res; + value name = Val_unit, aliases = Val_unit; + + Begin_roots2 (name, aliases); + name = copy_string(entry->p_name); + aliases = copy_string_array((const char**)entry->p_aliases); + res = alloc_small(3, 0); + Field(res,0) = name; + Field(res,1) = aliases; + Field(res,2) = Val_int(entry->p_proto); + End_roots(); + return res; +} + +CAMLprim value unix_getprotobyname(value name) +{ + struct protoent * entry; + entry = getprotobyname(String_val(name)); + if (entry == (struct protoent *) NULL) raise_not_found(); + return alloc_proto_entry(entry); +} + +CAMLprim value unix_getprotobynumber(value proto) +{ + struct protoent * entry; + entry = getprotobynumber(Int_val(proto)); + if (entry == (struct protoent *) NULL) raise_not_found(); + return alloc_proto_entry(entry); +} + +#else + +CAMLprim value unix_getprotobynumber(value proto) +{ invalid_argument("getprotobynumber not implemented"); } + +CAMLprim value unix_getprotobyname(value name) +{ invalid_argument("getprotobyname not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/getpw.c b/ocaml-binary-annot/otherlibs/unix/getpw.c new file mode 100644 index 0000000000..eba9d6c3c3 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getpw.c @@ -0,0 +1,65 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <memory.h> +#include <fail.h> +#include "unixsupport.h" +#include <pwd.h> + +static value alloc_passwd_entry(struct passwd *entry) +{ + value res; + value name = Val_unit, passwd = Val_unit, gecos = Val_unit; + value dir = Val_unit, shell = Val_unit; + + Begin_roots5 (name, passwd, gecos, dir, shell); + name = copy_string(entry->pw_name); + passwd = copy_string(entry->pw_passwd); +#ifndef __BEOS__ + gecos = copy_string(entry->pw_gecos); +#else + gecos = copy_string(""); +#endif + dir = copy_string(entry->pw_dir); + shell = copy_string(entry->pw_shell); + res = alloc_small(7, 0); + Field(res,0) = name; + Field(res,1) = passwd; + Field(res,2) = Val_int(entry->pw_uid); + Field(res,3) = Val_int(entry->pw_gid); + Field(res,4) = gecos; + Field(res,5) = dir; + Field(res,6) = shell; + End_roots(); + return res; +} + +CAMLprim value unix_getpwnam(value name) +{ + struct passwd * entry; + entry = getpwnam(String_val(name)); + if (entry == (struct passwd *) NULL) raise_not_found(); + return alloc_passwd_entry(entry); +} + +CAMLprim value unix_getpwuid(value uid) +{ + struct passwd * entry; + entry = getpwuid(Int_val(uid)); + if (entry == (struct passwd *) NULL) raise_not_found(); + return alloc_passwd_entry(entry); +} diff --git a/ocaml-binary-annot/otherlibs/unix/getserv.c b/ocaml-binary-annot/otherlibs/unix/getserv.c new file mode 100644 index 0000000000..e252aacb70 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getserv.c @@ -0,0 +1,76 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include <sys/types.h> + +#ifndef _WIN32 +#include <sys/socket.h> +#include <netinet/in.h> +#include <netdb.h> +#else +#include <winsock.h> +#endif + +static value alloc_service_entry(struct servent *entry) +{ + value res; + value name = Val_unit, aliases = Val_unit, proto = Val_unit; + + Begin_roots3 (name, aliases, proto); + name = copy_string(entry->s_name); + aliases = copy_string_array((const char**)entry->s_aliases); + proto = copy_string(entry->s_proto); + res = alloc_small(4, 0); + Field(res,0) = name; + Field(res,1) = aliases; + Field(res,2) = Val_int(ntohs(entry->s_port)); + Field(res,3) = proto; + End_roots(); + return res; +} + +CAMLprim value unix_getservbyname(value name, value proto) +{ + struct servent * entry; + entry = getservbyname(String_val(name), String_val(proto)); + if (entry == (struct servent *) NULL) raise_not_found(); + return alloc_service_entry(entry); +} + +CAMLprim value unix_getservbyport(value port, value proto) +{ + struct servent * entry; + entry = getservbyport(htons(Int_val(port)), String_val(proto)); + if (entry == (struct servent *) NULL) raise_not_found(); + return alloc_service_entry(entry); +} + +#else + +CAMLprim value unix_getservbyport(value port, value proto) +{ invalid_argument("getservbyport not implemented"); } + +CAMLprim value unix_getservbyname(value name, value proto) +{ invalid_argument("getservbyname not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/getsockname.c b/ocaml-binary-annot/otherlibs/unix/getsockname.c new file mode 100644 index 0000000000..6f0b64dcd3 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getsockname.c @@ -0,0 +1,41 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include "socketaddr.h" + +CAMLprim value unix_getsockname(value sock) +{ + int retcode; + union sock_addr_union addr; + socklen_param_type addr_len; + + addr_len = sizeof(addr); + retcode = getsockname(Int_val(sock), &addr.s_gen, &addr_len); + if (retcode == -1) uerror("getsockname", Nothing); + return alloc_sockaddr(&addr, addr_len, -1); +} + +#else + +CAMLprim value unix_getsockname(value sock) +{ invalid_argument("getsockname not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/gettimeofday.c b/ocaml-binary-annot/otherlibs/unix/gettimeofday.c new file mode 100644 index 0000000000..e095326e67 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/gettimeofday.c @@ -0,0 +1,38 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include "unixsupport.h" + +#ifdef HAS_GETTIMEOFDAY + +#include <sys/types.h> +#include <sys/time.h> + +CAMLprim value unix_gettimeofday(value unit) +{ + struct timeval tp; + if (gettimeofday(&tp, NULL) == -1) uerror("gettimeofday", Nothing); + return copy_double((double) tp.tv_sec + (double) tp.tv_usec / 1e6); +} + +#else + +CAMLprim value unix_gettimeofday(value unit) +{ invalid_argument("gettimeofday not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/getuid.c b/ocaml-binary-annot/otherlibs/unix/getuid.c new file mode 100644 index 0000000000..780a8d8ec4 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/getuid.c @@ -0,0 +1,22 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_getuid(value unit) +{ + return Val_int(getuid()); +} diff --git a/ocaml-binary-annot/otherlibs/unix/gmtime.c b/ocaml-binary-annot/otherlibs/unix/gmtime.c new file mode 100644 index 0000000000..2ffeb3927b --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/gmtime.c @@ -0,0 +1,95 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include "unixsupport.h" +#include <time.h> +#include <errno.h> + +static value alloc_tm(struct tm *tm) +{ + value res; + res = alloc_small(9, 0); + Field(res,0) = Val_int(tm->tm_sec); + Field(res,1) = Val_int(tm->tm_min); + Field(res,2) = Val_int(tm->tm_hour); + Field(res,3) = Val_int(tm->tm_mday); + Field(res,4) = Val_int(tm->tm_mon); + Field(res,5) = Val_int(tm->tm_year); + Field(res,6) = Val_int(tm->tm_wday); + Field(res,7) = Val_int(tm->tm_yday); + Field(res,8) = tm->tm_isdst ? Val_true : Val_false; + return res; +} + +CAMLprim value unix_gmtime(value t) +{ + time_t clock; + struct tm * tm; + clock = (time_t) Double_val(t); + tm = gmtime(&clock); + if (tm == NULL) unix_error(EINVAL, "gmtime", Nothing); + return alloc_tm(tm); +} + +CAMLprim value unix_localtime(value t) +{ + time_t clock; + struct tm * tm; + clock = (time_t) Double_val(t); + tm = localtime(&clock); + if (tm == NULL) unix_error(EINVAL, "localtime", Nothing); + return alloc_tm(tm); +} + +#ifdef HAS_MKTIME + +CAMLprim value unix_mktime(value t) +{ + struct tm tm; + time_t clock; + value res; + value tmval = Val_unit, clkval = Val_unit; + + Begin_roots2(tmval, clkval); + tm.tm_sec = Int_val(Field(t, 0)); + tm.tm_min = Int_val(Field(t, 1)); + tm.tm_hour = Int_val(Field(t, 2)); + tm.tm_mday = Int_val(Field(t, 3)); + tm.tm_mon = Int_val(Field(t, 4)); + tm.tm_year = Int_val(Field(t, 5)); + tm.tm_wday = Int_val(Field(t, 6)); + tm.tm_yday = Int_val(Field(t, 7)); + tm.tm_isdst = -1; /* tm.tm_isdst = Bool_val(Field(t, 8)); */ + clock = mktime(&tm); + if (clock == (time_t) -1) unix_error(ERANGE, "mktime", Nothing); + tmval = alloc_tm(&tm); + clkval = copy_double((double) clock); + res = alloc_small(2, 0); + Field(res, 0) = clkval; + Field(res, 1) = tmval; + End_roots (); + return res; +} + +#else + +CAMLprim value unix_mktime(value t) +{ invalid_argument("mktime not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/initgroups.c b/ocaml-binary-annot/otherlibs/unix/initgroups.c new file mode 100644 index 0000000000..df358dae16 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/initgroups.c @@ -0,0 +1,43 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Copyright 2009 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* Contributed by Stephane Glondu <steph@glondu.net> */ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> + +#ifdef HAS_INITGROUPS + +#include <sys/types.h> +#ifdef HAS_UNISTD +#include <unistd.h> +#endif +#include <limits.h> +#include <grp.h> +#include "unixsupport.h" + +CAMLprim value unix_initgroups(value user, value group) +{ + if (initgroups(String_val(user), Int_val(group)) == -1) { + uerror("initgroups", Nothing); + } + return Val_unit; +} + +#else + +CAMLprim value unix_initgroups(value user, value group) +{ invalid_argument("initgroups not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/isatty.c b/ocaml-binary-annot/otherlibs/unix/isatty.c new file mode 100644 index 0000000000..f534dd773b --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/isatty.c @@ -0,0 +1,22 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ +/* */ +/* Copyright 2006 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_isatty(value fd) +{ + return (Val_bool(isatty(Int_val(fd)))); +} diff --git a/ocaml-binary-annot/otherlibs/unix/itimer.c b/ocaml-binary-annot/otherlibs/unix/itimer.c new file mode 100644 index 0000000000..14bac626ab --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/itimer.c @@ -0,0 +1,75 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include "unixsupport.h" + +#ifdef HAS_SETITIMER + +#include <math.h> +#include <sys/time.h> + +static void unix_set_timeval(struct timeval * tv, double d) +{ + double integr, frac; + frac = modf(d, &integr); + /* Round time up so that if d is small but not 0, we end up with + a non-0 timeval. */ + tv->tv_sec = integr; + tv->tv_usec = ceil(1e6 * frac); + if (tv->tv_usec >= 1000000) { tv->tv_sec++; tv->tv_usec = 0; } +} + +static value unix_convert_itimer(struct itimerval *tp) +{ +#define Get_timeval(tv) (double) tv.tv_sec + (double) tv.tv_usec / 1e6 + value res = alloc_small(Double_wosize * 2, Double_array_tag); + Store_double_field(res, 0, Get_timeval(tp->it_interval)); + Store_double_field(res, 1, Get_timeval(tp->it_value)); + return res; +#undef Get_timeval +} + +static int itimers[3] = { ITIMER_REAL, ITIMER_VIRTUAL, ITIMER_PROF }; + +CAMLprim value unix_setitimer(value which, value newval) +{ + struct itimerval new, old; + unix_set_timeval(&new.it_interval, Double_field(newval, 0)); + unix_set_timeval(&new.it_value, Double_field(newval, 1)); + if (setitimer(itimers[Int_val(which)], &new, &old) == -1) + uerror("setitimer", Nothing); + return unix_convert_itimer(&old); +} + +CAMLprim value unix_getitimer(value which) +{ + struct itimerval val; + if (getitimer(itimers[Int_val(which)], &val) == -1) + uerror("getitimer", Nothing); + return unix_convert_itimer(&val); +} + +#else + +CAMLprim value unix_setitimer(value which, value newval) +{ invalid_argument("setitimer not implemented"); } +CAMLprim value unix_getitimer(value which) +{ invalid_argument("getitimer not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/kill.c b/ocaml-binary-annot/otherlibs/unix/kill.c new file mode 100644 index 0000000000..8d8a47340c --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/kill.c @@ -0,0 +1,29 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <fail.h> +#include "unixsupport.h" +#include <signal.h> +#include <signals.h> + +CAMLprim value unix_kill(value pid, value signal) +{ + int sig; + sig = convert_signal_number(Int_val(signal)); + if (kill(Int_val(pid), sig) == -1) + uerror("kill", Nothing); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/libunix.clib b/ocaml-binary-annot/otherlibs/unix/libunix.clib new file mode 100644 index 0000000000..b866ea06de --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/libunix.clib @@ -0,0 +1,16 @@ +accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o +chown.o chroot.o close.o closedir.o connect.o cst2constr.o cstringv.o +dup.o dup2.o envir.o errmsg.o execv.o execve.o execvp.o exit.o +fchmod.o fchown.o fcntl.o fork.o ftruncate.o +getaddrinfo.o getcwd.o getegid.o geteuid.o getgid.o +getgr.o getgroups.o gethost.o gethostname.o getlogin.o +getnameinfo.o getpeername.o getpid.o getppid.o getproto.o getpw.o +gettimeofday.o getserv.o getsockname.o getuid.o gmtime.o +initgroups.o isatty.o itimer.o kill.o link.o listen.o lockf.o lseek.o +mkdir.o mkfifo.o nice.o open.o opendir.o pipe.o putenv.o read.o +readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o +setgid.o setgroups.o setsid.o setuid.o shutdown.o signals.o +sleep.o socket.o socketaddr.o +socketpair.o sockopt.o stat.o strofaddr.o symlink.o termios.o +time.o times.o truncate.o umask.o unixsupport.o unlink.o +utimes.o wait.o write.o diff --git a/ocaml-binary-annot/otherlibs/unix/link.c b/ocaml-binary-annot/otherlibs/unix/link.c new file mode 100644 index 0000000000..181e9c1800 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/link.c @@ -0,0 +1,23 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_link(value path1, value path2) +{ + if (link(String_val(path1), String_val(path2)) == -1) uerror("link", path2); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/listen.c b/ocaml-binary-annot/otherlibs/unix/listen.c new file mode 100644 index 0000000000..2f40cfbafa --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/listen.c @@ -0,0 +1,35 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include <sys/socket.h> + +CAMLprim value unix_listen(value sock, value backlog) +{ + if (listen(Int_val(sock), Int_val(backlog)) == -1) uerror("listen", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_listen(value sock, value backlog) +{ invalid_argument("listen not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/lockf.c b/ocaml-binary-annot/otherlibs/unix/lockf.c new file mode 100644 index 0000000000..6e6ce5c173 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/lockf.c @@ -0,0 +1,116 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <errno.h> +#include <fcntl.h> +#include <fail.h> +#include <mlvalues.h> +#include <signals.h> +#include "unixsupport.h" + +#if defined(F_GETLK) && defined(F_SETLK) && defined(F_SETLKW) + +CAMLprim value unix_lockf(value fd, value cmd, value span) +{ + struct flock l; + int ret; + int fildes; + long size; + + fildes = Int_val(fd); + size = Long_val(span); + l.l_whence = 1; + if (size < 0) { + l.l_start = size; + l.l_len = -size; + } else { + l.l_start = 0L; + l.l_len = size; + } + switch (Int_val(cmd)) { + case 0: /* F_ULOCK */ + l.l_type = F_UNLCK; + ret = fcntl(fildes, F_SETLK, &l); + break; + case 1: /* F_LOCK */ + l.l_type = F_WRLCK; + enter_blocking_section(); + ret = fcntl(fildes, F_SETLKW, &l); + leave_blocking_section(); + break; + case 2: /* F_TLOCK */ + l.l_type = F_WRLCK; + ret = fcntl(fildes, F_SETLK, &l); + break; + case 3: /* F_TEST */ + l.l_type = F_WRLCK; + ret = fcntl(fildes, F_GETLK, &l); + if (ret != -1) { + if (l.l_type == F_UNLCK) + ret = 0; + else { + errno = EACCES; + ret = -1; + } + } + break; + case 4: /* F_RLOCK */ + l.l_type = F_RDLCK; + enter_blocking_section(); + ret = fcntl(fildes, F_SETLKW, &l); + leave_blocking_section(); + break; + case 5: /* F_TRLOCK */ + l.l_type = F_RDLCK; + ret = fcntl(fildes, F_SETLK, &l); + break; + default: + errno = EINVAL; + ret = -1; + } + if (ret == -1) uerror("lockf", Nothing); + return Val_unit; +} + +#else + +#ifdef HAS_LOCKF +#ifdef HAS_UNISTD +#include <unistd.h> +#else +#define F_ULOCK 0 +#define F_LOCK 1 +#define F_TLOCK 2 +#define F_TEST 3 +#endif + +static int lock_command_table[] = { + F_ULOCK, F_LOCK, F_TLOCK, F_TEST, F_LOCK, F_TLOCK +}; + +CAMLprim value unix_lockf(value fd, value cmd, value span) +{ + if (lockf(Int_val(fd), lock_command_table[Int_val(cmd)], Long_val(span)) + == -1) uerror("lockf", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_lockf(value fd, value cmd, value span) +{ invalid_argument("lockf not implemented"); } + +#endif +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/lseek.c b/ocaml-binary-annot/otherlibs/unix/lseek.c new file mode 100644 index 0000000000..cb59bb5517 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/lseek.c @@ -0,0 +1,63 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <errno.h> +#include <sys/types.h> +#include <mlvalues.h> +#include <alloc.h> +#include <io.h> +#include "unixsupport.h" + +#ifdef HAS_UNISTD +#include <unistd.h> +#else +#define SEEK_SET 0 +#define SEEK_CUR 1 +#define SEEK_END 2 +#endif + +#ifndef EOVERFLOW +#define EOVERFLOW ERANGE +#endif + +static int seek_command_table[] = { + SEEK_SET, SEEK_CUR, SEEK_END +}; + +CAMLprim value unix_lseek(value fd, value ofs, value cmd) +{ + file_offset ret; + caml_enter_blocking_section(); + ret = lseek(Int_val(fd), Long_val(ofs), + seek_command_table[Int_val(cmd)]); + caml_leave_blocking_section(); + if (ret == -1) uerror("lseek", Nothing); + if (ret > Max_long) unix_error(EOVERFLOW, "lseek", Nothing); + return Val_long(ret); +} + +CAMLprim value unix_lseek_64(value fd, value ofs, value cmd) +{ + file_offset ret; + /* [ofs] is an Int64, which is stored as a custom block; we must therefore + extract its contents before dropping the runtime lock, or it might be + moved. */ + file_offset ofs_c = File_offset_val(ofs); + caml_enter_blocking_section(); + ret = lseek(Int_val(fd), ofs_c, seek_command_table[Int_val(cmd)]); + caml_leave_blocking_section(); + if (ret == -1) uerror("lseek", Nothing); + return Val_file_offset(ret); +} diff --git a/ocaml-binary-annot/otherlibs/unix/mkdir.c b/ocaml-binary-annot/otherlibs/unix/mkdir.c new file mode 100644 index 0000000000..1b8fd6242f --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/mkdir.c @@ -0,0 +1,25 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <sys/types.h> +#include <sys/stat.h> +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_mkdir(value path, value perm) +{ + if (mkdir(String_val(path), Int_val(perm)) == -1) uerror("mkdir", path); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/mkfifo.c b/ocaml-binary-annot/otherlibs/unix/mkfifo.c new file mode 100644 index 0000000000..3e2cf3ddb5 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/mkfifo.c @@ -0,0 +1,53 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <sys/types.h> +#include <sys/stat.h> +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_MKFIFO + +CAMLprim value unix_mkfifo(value path, value mode) +{ + if (mkfifo(String_val(path), Int_val(mode)) == -1) + uerror("mkfifo", path); + return Val_unit; +} + +#else + +#include <sys/types.h> +#include <sys/stat.h> + +#ifdef S_IFIFO + +CAMLprim value unix_mkfifo(value path, value mode) +{ + if (mknod(String_val(path), (Int_val(mode) & 07777) | S_IFIFO, 0) == -1) + uerror("mkfifo", path); + return Val_unit; +} + +#else + +CAMLprim value unix_mkfifo(value path, value mode) +{ + invalid_argument("mkfifo not implemented"); +} + +#endif +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/nice.c b/ocaml-binary-annot/otherlibs/unix/nice.c new file mode 100644 index 0000000000..77def267c1 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/nice.c @@ -0,0 +1,30 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" +#include <errno.h> +#ifdef HAS_UNISTD +#include <unistd.h> +#endif + +CAMLprim value unix_nice(value incr) +{ + int ret; + errno = 0; + ret = nice(Int_val(incr)); + if (ret == -1 && errno != 0) uerror("nice", Nothing); + return Val_int(ret); +} diff --git a/ocaml-binary-annot/otherlibs/unix/open.c b/ocaml-binary-annot/otherlibs/unix/open.c new file mode 100644 index 0000000000..421218308c --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/open.c @@ -0,0 +1,58 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" +#include <string.h> +#include <fcntl.h> + +#ifndef O_NONBLOCK +#define O_NONBLOCK O_NDELAY +#endif +#ifndef O_DSYNC +#define O_DSYNC 0 +#endif +#ifndef O_SYNC +#define O_SYNC 0 +#endif +#ifndef O_RSYNC +#define O_RSYNC 0 +#endif + +static int open_flag_table[] = { + O_RDONLY, O_WRONLY, O_RDWR, O_NONBLOCK, O_APPEND, O_CREAT, O_TRUNC, O_EXCL, + O_NOCTTY, O_DSYNC, O_SYNC, O_RSYNC +}; + +CAMLprim value unix_open(value path, value flags, value perm) +{ + CAMLparam3(path, flags, perm); + int ret, cv_flags; + char * p; + + cv_flags = convert_flag_list(flags, open_flag_table); + p = stat_alloc(string_length(path) + 1); + strcpy(p, String_val(path)); + /* open on a named FIFO can block (PR#1533) */ + enter_blocking_section(); + ret = open(p, cv_flags, Int_val(perm)); + leave_blocking_section(); + stat_free(p); + if (ret == -1) uerror("open", path); + CAMLreturn (Val_int(ret)); +} diff --git a/ocaml-binary-annot/otherlibs/unix/opendir.c b/ocaml-binary-annot/otherlibs/unix/opendir.c new file mode 100644 index 0000000000..0497ef1f4f --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/opendir.c @@ -0,0 +1,35 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include "unixsupport.h" +#include <sys/types.h> +#ifdef HAS_DIRENT +#include <dirent.h> +#else +#include <sys/dir.h> +#endif + +CAMLprim value unix_opendir(value path) +{ + DIR * d; + value res; + d = opendir(String_val(path)); + if (d == (DIR *) NULL) uerror("opendir", path); + res = alloc_small(1, Abstract_tag); + DIR_Val(res) = d; + return res; +} diff --git a/ocaml-binary-annot/otherlibs/unix/pipe.c b/ocaml-binary-annot/otherlibs/unix/pipe.c new file mode 100644 index 0000000000..b68705e9ff --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/pipe.c @@ -0,0 +1,29 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include "unixsupport.h" + +CAMLprim value unix_pipe(value unit) +{ + int fd[2]; + value res; + if (pipe(fd) == -1) uerror("pipe", Nothing); + res = alloc_small(2, 0); + Field(res, 0) = Val_int(fd[0]); + Field(res, 1) = Val_int(fd[1]); + return res; +} diff --git a/ocaml-binary-annot/otherlibs/unix/putenv.c b/ocaml-binary-annot/otherlibs/unix/putenv.c new file mode 100644 index 0000000000..e403d2966f --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/putenv.c @@ -0,0 +1,46 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <stdlib.h> +#include <string.h> + +#include <fail.h> +#include <memory.h> +#include <mlvalues.h> + +#include "unixsupport.h" + +#ifdef HAS_PUTENV + +CAMLprim value unix_putenv(value name, value val) +{ + mlsize_t namelen = string_length(name); + mlsize_t vallen = string_length(val); + char * s = (char *) stat_alloc(namelen + 1 + vallen + 1); + + memmove (s, String_val(name), namelen); + s[namelen] = '='; + memmove (s + namelen + 1, String_val(val), vallen); + s[namelen + 1 + vallen] = 0; + if (putenv(s) == -1) uerror("putenv", name); + return Val_unit; +} + +#else + +CAMLprim value unix_putenv(value name, value val) +{ invalid_argument("putenv not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/read.c b/ocaml-binary-annot/otherlibs/unix/read.c new file mode 100644 index 0000000000..03a9e6aaa7 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/read.c @@ -0,0 +1,38 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <string.h> +#include <mlvalues.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" + +CAMLprim value unix_read(value fd, value buf, value ofs, value len) +{ + long numbytes; + int ret; + char iobuf[UNIX_BUFFER_SIZE]; + + Begin_root (buf); + numbytes = Long_val(len); + if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE; + enter_blocking_section(); + ret = read(Int_val(fd), iobuf, (int) numbytes); + leave_blocking_section(); + if (ret == -1) uerror("read", Nothing); + memmove (&Byte(buf, Long_val(ofs)), iobuf, ret); + End_roots(); + return Val_int(ret); +} diff --git a/ocaml-binary-annot/otherlibs/unix/readdir.c b/ocaml-binary-annot/otherlibs/unix/readdir.c new file mode 100644 index 0000000000..fb8a67b20e --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/readdir.c @@ -0,0 +1,39 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <fail.h> +#include <alloc.h> +#include "unixsupport.h" +#include <errno.h> +#include <sys/types.h> +#ifdef HAS_DIRENT +#include <dirent.h> +typedef struct dirent directory_entry; +#else +#include <sys/dir.h> +typedef struct direct directory_entry; +#endif + +CAMLprim value unix_readdir(value vd) +{ + DIR * d; + directory_entry * e; + d = DIR_Val(vd); + if (d == (DIR *) NULL) unix_error(EBADF, "readdir", Nothing); + e = readdir((DIR *) d); + if (e == (directory_entry *) NULL) raise_end_of_file(); + return copy_string(e->d_name); +} diff --git a/ocaml-binary-annot/otherlibs/unix/readlink.c b/ocaml-binary-annot/otherlibs/unix/readlink.c new file mode 100644 index 0000000000..d2b9c4e125 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/readlink.c @@ -0,0 +1,48 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> + +#ifdef HAS_SYMLINK + +#include <sys/param.h> +#include "unixsupport.h" + +#ifndef PATH_MAX +#ifdef MAXPATHLEN +#define PATH_MAX MAXPATHLEN +#else +#define PATH_MAX 512 +#endif +#endif + +CAMLprim value unix_readlink(value path) +{ + char buffer[PATH_MAX]; + int len; + len = readlink(String_val(path), buffer, sizeof(buffer) - 1); + if (len == -1) uerror("readlink", path); + buffer[len] = '\0'; + return copy_string(buffer); +} + +#else + +CAMLprim value unix_readlink(value path) +{ invalid_argument("readlink not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/rename.c b/ocaml-binary-annot/otherlibs/unix/rename.c new file mode 100644 index 0000000000..65f33c8b57 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/rename.c @@ -0,0 +1,25 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <stdio.h> +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_rename(value path1, value path2) +{ + if (rename(String_val(path1), String_val(path2)) == -1) + uerror("rename", path1); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/rewinddir.c b/ocaml-binary-annot/otherlibs/unix/rewinddir.c new file mode 100644 index 0000000000..d14c526d96 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/rewinddir.c @@ -0,0 +1,42 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" +#include <errno.h> +#include <sys/types.h> +#ifdef HAS_DIRENT +#include <dirent.h> +#else +#include <sys/dir.h> +#endif + +#ifdef HAS_REWINDDIR + +CAMLprim value unix_rewinddir(value vd) +{ + DIR * d = DIR_Val(vd); + if (d == (DIR *) NULL) unix_error(EBADF, "rewinddir", Nothing); + rewinddir(d); + return Val_unit; +} + +#else + +CAMLprim value unix_rewinddir(value d) +{ invalid_argument("rewinddir not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/rmdir.c b/ocaml-binary-annot/otherlibs/unix/rmdir.c new file mode 100644 index 0000000000..8de223464d --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/rmdir.c @@ -0,0 +1,23 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_rmdir(value path) +{ + if (rmdir(String_val(path)) == -1) uerror("rmdir", path); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/select.c b/ocaml-binary-annot/otherlibs/unix/select.c new file mode 100644 index 0000000000..612d597014 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/select.c @@ -0,0 +1,110 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" + +#ifdef HAS_SELECT + +#include <sys/types.h> +#include <sys/time.h> +#ifdef HAS_SYS_SELECT_H +#include <sys/select.h> +#endif +#include <string.h> +#include <unistd.h> + +typedef fd_set file_descr_set; + +static void fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd) +{ + value l; + FD_ZERO(fdset); + for (l = fdlist; l != Val_int(0); l = Field(l, 1)) { + int fd = Int_val(Field(l, 0)); + FD_SET(fd, fdset); + if (fd > *maxfd) *maxfd = fd; + } +} + +static value fdset_to_fdlist(value fdlist, fd_set *fdset) +{ + value l; + value res = Val_int(0); + + Begin_roots2(l, res); + for (l = fdlist; l != Val_int(0); l = Field(l, 1)) { + int fd = Int_val(Field(l, 0)); + if (FD_ISSET(fd, fdset)) { + value newres = alloc_small(2, 0); + Field(newres, 0) = Val_int(fd); + Field(newres, 1) = res; + res = newres; + } + } + End_roots(); + return res; +} + +CAMLprim value unix_select(value readfds, value writefds, value exceptfds, + value timeout) +{ + fd_set read, write, except; + int maxfd; + double tm; + struct timeval tv; + struct timeval * tvp; + int retcode; + value res; + + Begin_roots3 (readfds, writefds, exceptfds); + maxfd = -1; + fdlist_to_fdset(readfds, &read, &maxfd); + fdlist_to_fdset(writefds, &write, &maxfd); + fdlist_to_fdset(exceptfds, &except, &maxfd); + tm = Double_val(timeout); + if (tm < 0.0) + tvp = (struct timeval *) NULL; + else { + tv.tv_sec = (int) tm; + tv.tv_usec = (int) (1e6 * (tm - tv.tv_sec)); + tvp = &tv; + } + enter_blocking_section(); + retcode = select(maxfd + 1, &read, &write, &except, tvp); + leave_blocking_section(); + if (retcode == -1) uerror("select", Nothing); + readfds = fdset_to_fdlist(readfds, &read); + writefds = fdset_to_fdlist(writefds, &write); + exceptfds = fdset_to_fdlist(exceptfds, &except); + res = alloc_small(3, 0); + Field(res, 0) = readfds; + Field(res, 1) = writefds; + Field(res, 2) = exceptfds; + End_roots(); + return res; +} + +#else + +CAMLprim value unix_select(value readfds, value writefds, value exceptfds, + value timeout) +{ invalid_argument("select not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/sendrecv.c b/ocaml-binary-annot/otherlibs/unix/sendrecv.c new file mode 100644 index 0000000000..bb3989af78 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/sendrecv.c @@ -0,0 +1,148 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <string.h> +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS +#include "socketaddr.h" + +static int msg_flag_table[] = { + MSG_OOB, MSG_DONTROUTE, MSG_PEEK +}; + +CAMLprim value unix_recv(value sock, value buff, value ofs, value len, + value flags) +{ + int ret, cv_flags; + long numbytes; + char iobuf[UNIX_BUFFER_SIZE]; + + cv_flags = convert_flag_list(flags, msg_flag_table); + Begin_root (buff); + numbytes = Long_val(len); + if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE; + enter_blocking_section(); + ret = recv(Int_val(sock), iobuf, (int) numbytes, cv_flags); + leave_blocking_section(); + if (ret == -1) uerror("recv", Nothing); + memmove (&Byte(buff, Long_val(ofs)), iobuf, ret); + End_roots(); + return Val_int(ret); +} + +CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, + value flags) +{ + int ret, cv_flags; + long numbytes; + char iobuf[UNIX_BUFFER_SIZE]; + value res; + value adr = Val_unit; + union sock_addr_union addr; + socklen_param_type addr_len; + + cv_flags = convert_flag_list(flags, msg_flag_table); + Begin_roots2 (buff, adr); + numbytes = Long_val(len); + if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE; + addr_len = sizeof(addr); + enter_blocking_section(); + ret = recvfrom(Int_val(sock), iobuf, (int) numbytes, cv_flags, + &addr.s_gen, &addr_len); + leave_blocking_section(); + if (ret == -1) uerror("recvfrom", Nothing); + memmove (&Byte(buff, Long_val(ofs)), iobuf, ret); + adr = alloc_sockaddr(&addr, addr_len, -1); + res = alloc_small(2, 0); + Field(res, 0) = Val_int(ret); + Field(res, 1) = adr; + End_roots(); + return res; +} + +CAMLprim value unix_send(value sock, value buff, value ofs, value len, + value flags) +{ + int ret, cv_flags; + long numbytes; + char iobuf[UNIX_BUFFER_SIZE]; + + cv_flags = convert_flag_list(flags, msg_flag_table); + numbytes = Long_val(len); + if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE; + memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes); + enter_blocking_section(); + ret = send(Int_val(sock), iobuf, (int) numbytes, cv_flags); + leave_blocking_section(); + if (ret == -1) uerror("send", Nothing); + return Val_int(ret); +} + +CAMLprim value unix_sendto_native(value sock, value buff, value ofs, value len, + value flags, value dest) +{ + int ret, cv_flags; + long numbytes; + char iobuf[UNIX_BUFFER_SIZE]; + union sock_addr_union addr; + socklen_param_type addr_len; + + cv_flags = convert_flag_list(flags, msg_flag_table); + get_sockaddr(dest, &addr, &addr_len); + numbytes = Long_val(len); + if (numbytes > UNIX_BUFFER_SIZE) numbytes = UNIX_BUFFER_SIZE; + memmove (iobuf, &Byte(buff, Long_val(ofs)), numbytes); + enter_blocking_section(); + ret = sendto(Int_val(sock), iobuf, (int) numbytes, cv_flags, + &addr.s_gen, addr_len); + leave_blocking_section(); + if (ret == -1) uerror("sendto", Nothing); + return Val_int(ret); +} + +CAMLprim value unix_sendto(value *argv, int argc) +{ + return unix_sendto_native + (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); +} + +#else + +CAMLprim value unix_recv(value sock, value buff, value ofs, value len, + value flags) +{ invalid_argument("recv not implemented"); } + +CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, + value flags) +{ invalid_argument("recvfrom not implemented"); } + +CAMLprim value unix_send(value sock, value buff, value ofs, value len, + value flags) +{ invalid_argument("send not implemented"); } + +CAMLprim value unix_sendto_native(value sock, value buff, value ofs, value len, + value flags, value dest) +{ invalid_argument("sendto not implemented"); } + +CAMLprim value unix_sendto(value *argv, int argc) +{ invalid_argument("sendto not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/setgid.c b/ocaml-binary-annot/otherlibs/unix/setgid.c new file mode 100644 index 0000000000..bd8810f819 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/setgid.c @@ -0,0 +1,23 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_setgid(value gid) +{ + if (setgid(Int_val(gid)) == -1) uerror("setgid", Nothing); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/setgroups.c b/ocaml-binary-annot/otherlibs/unix/setgroups.c new file mode 100644 index 0000000000..dd4592ad00 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/setgroups.c @@ -0,0 +1,53 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Copyright 2009 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* Contributed by Stephane Glondu <steph@glondu.net> */ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> + +#ifdef HAS_SETGROUPS + +#include <sys/types.h> +#ifdef HAS_UNISTD +#include <unistd.h> +#endif +#include <limits.h> +#include <grp.h> +#include "unixsupport.h" + +CAMLprim value unix_setgroups(value groups) +{ + gid_t * gidset; + mlsize_t size, i; + int n; + + size = Wosize_val(groups); + gidset = (gid_t *) stat_alloc(size * sizeof(gid_t)); + for (i = 0; i < size; i++) gidset[i] = Int_val(Field(groups, i)); + + n = setgroups(size, gidset); + + stat_free(gidset); + if (n == -1) uerror("setgroups", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_setgroups(value groups) +{ invalid_argument("setgroups not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/setsid.c b/ocaml-binary-annot/otherlibs/unix/setsid.c new file mode 100644 index 0000000000..bfa9dac0b2 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/setsid.c @@ -0,0 +1,31 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" +#ifdef HAS_UNISTD +#include <unistd.h> +#endif + +CAMLprim value unix_setsid(value unit) +{ +#ifdef HAS_SETSID + return Val_int(setsid()); +#else + invalid_argument("setsid not implemented"); + return Val_unit; +#endif +} diff --git a/ocaml-binary-annot/otherlibs/unix/setuid.c b/ocaml-binary-annot/otherlibs/unix/setuid.c new file mode 100644 index 0000000000..c867f4c68b --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/setuid.c @@ -0,0 +1,23 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_setuid(value uid) +{ + if (setuid(Int_val(uid)) == -1) uerror("setuid", Nothing); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/shutdown.c b/ocaml-binary-annot/otherlibs/unix/shutdown.c new file mode 100644 index 0000000000..d51b1a3de9 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/shutdown.c @@ -0,0 +1,40 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include <sys/socket.h> + +static int shutdown_command_table[] = { + 0, 1, 2 +}; + +CAMLprim value unix_shutdown(value sock, value cmd) +{ + if (shutdown(Int_val(sock), shutdown_command_table[Int_val(cmd)]) == -1) + uerror("shutdown", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_shutdown(value sock, value cmd) +{ invalid_argument("shutdown not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/signals.c b/ocaml-binary-annot/otherlibs/unix/signals.c new file mode 100644 index 0000000000..c388b13936 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/signals.c @@ -0,0 +1,106 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <errno.h> +#include <signal.h> + +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include <mlvalues.h> +#include <signals.h> +#include "unixsupport.h" + +#ifndef NSIG +#define NSIG 64 +#endif + +#ifdef POSIX_SIGNALS + +static void decode_sigset(value vset, sigset_t * set) +{ + sigemptyset(set); + while (vset != Val_int(0)) { + int sig = caml_convert_signal_number(Int_val(Field(vset, 0))); + sigaddset(set, sig); + vset = Field(vset, 1); + } +} + +static value encode_sigset(sigset_t * set) +{ + value res = Val_int(0); + int i; + + Begin_root(res) + for (i = 1; i < NSIG; i++) + if (sigismember(set, i) > 0) { + value newcons = alloc_small(2, 0); + Field(newcons, 0) = Val_int(caml_rev_convert_signal_number(i)); + Field(newcons, 1) = res; + res = newcons; + } + End_roots(); + return res; +} + +static int sigprocmask_cmd[3] = { SIG_SETMASK, SIG_BLOCK, SIG_UNBLOCK }; + +CAMLprim value unix_sigprocmask(value vaction, value vset) +{ + int how; + sigset_t set, oldset; + int retcode; + + how = sigprocmask_cmd[Int_val(vaction)]; + decode_sigset(vset, &set); + enter_blocking_section(); + retcode = sigprocmask(how, &set, &oldset); + leave_blocking_section(); + if (retcode == -1) uerror("sigprocmask", Nothing); + return encode_sigset(&oldset); +} + +CAMLprim value unix_sigpending(value unit) +{ + sigset_t pending; + if (sigpending(&pending) == -1) uerror("sigpending", Nothing); + return encode_sigset(&pending); +} + +CAMLprim value unix_sigsuspend(value vset) +{ + sigset_t set; + int retcode; + decode_sigset(vset, &set); + enter_blocking_section(); + retcode = sigsuspend(&set); + leave_blocking_section(); + if (retcode == -1 && errno != EINTR) uerror("sigsuspend", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_sigprocmask(value vaction, value vset) +{ invalid_argument("Unix.sigprocmask not available"); } + +CAMLprim value unix_sigpending(value unit) +{ invalid_argument("Unix.sigpending not available"); } + +CAMLprim value unix_sigsuspend(value vset) +{ invalid_argument("Unix.sigsuspend not available"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/sleep.c b/ocaml-binary-annot/otherlibs/unix/sleep.c new file mode 100644 index 0000000000..ec14e39d0b --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/sleep.c @@ -0,0 +1,26 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <signals.h> +#include "unixsupport.h" + +CAMLprim value unix_sleep(value t) +{ + enter_blocking_section(); + sleep(Int_val(t)); + leave_blocking_section(); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/socket.c b/ocaml-binary-annot/otherlibs/unix/socket.c new file mode 100644 index 0000000000..82f6329c03 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/socket.c @@ -0,0 +1,56 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include <sys/types.h> +#include <sys/socket.h> + +int socket_domain_table[] = { + PF_UNIX, PF_INET, +#if defined(HAS_IPV6) + PF_INET6 +#elif defined(PF_UNDEF) + PF_UNDEF +#else + 0 +#endif +}; + +int socket_type_table[] = { + SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET +}; + +CAMLprim value unix_socket(value domain, value type, value proto) +{ + int retcode; + retcode = socket(socket_domain_table[Int_val(domain)], + socket_type_table[Int_val(type)], + Int_val(proto)); + if (retcode == -1) uerror("socket", Nothing); + return Val_int(retcode); + +} + +#else + +CAMLprim value unix_socket(value domain, value type, value proto) +{ invalid_argument("socket not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/socketaddr.c b/ocaml-binary-annot/otherlibs/unix/socketaddr.c new file mode 100644 index 0000000000..f285d15a7b --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/socketaddr.c @@ -0,0 +1,144 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <string.h> +#include <mlvalues.h> +#include <alloc.h> +#include <memory.h> +#include <errno.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include "socketaddr.h" + +#ifdef _WIN32 +#define EAFNOSUPPORT WSAEAFNOSUPPORT +#endif + +CAMLexport value alloc_inet_addr(struct in_addr * a) +{ + value res; + /* Use a string rather than an abstract block so that it can be + marshaled safely. Remember that a is in network byte order, + hence is marshaled in an endian-independent manner. */ + res = alloc_string(4); + memcpy(String_val(res), a, 4); + return res; +} + +#ifdef HAS_IPV6 + +CAMLexport value alloc_inet6_addr(struct in6_addr * a) +{ + value res; + res = alloc_string(16); + memcpy(String_val(res), a, 16); + return res; +} + +#endif + +void get_sockaddr(value mladr, + union sock_addr_union * adr /*out*/, + socklen_param_type * adr_len /*out*/) +{ + switch(Tag_val(mladr)) { +#ifndef _WIN32 + case 0: /* ADDR_UNIX */ + { value path; + mlsize_t len; + path = Field(mladr, 0); + len = string_length(path); + adr->s_unix.sun_family = AF_UNIX; + if (len >= sizeof(adr->s_unix.sun_path)) { + unix_error(ENAMETOOLONG, "", path); + } + memmove (adr->s_unix.sun_path, String_val(path), len + 1); + *adr_len = + ((char *)&(adr->s_unix.sun_path) - (char *)&(adr->s_unix)) + + len; + break; + } +#endif + case 1: /* ADDR_INET */ +#ifdef HAS_IPV6 + if (string_length(Field(mladr, 0)) == 16) { + memset(&adr->s_inet6, 0, sizeof(struct sockaddr_in6)); + adr->s_inet6.sin6_family = AF_INET6; + adr->s_inet6.sin6_addr = GET_INET6_ADDR(Field(mladr, 0)); + adr->s_inet6.sin6_port = htons(Int_val(Field(mladr, 1))); +#ifdef SIN6_LEN + adr->s_inet6.sin6_len = sizeof(struct sockaddr_in6); +#endif + *adr_len = sizeof(struct sockaddr_in6); + break; + } +#endif + memset(&adr->s_inet, 0, sizeof(struct sockaddr_in)); + adr->s_inet.sin_family = AF_INET; + adr->s_inet.sin_addr = GET_INET_ADDR(Field(mladr, 0)); + adr->s_inet.sin_port = htons(Int_val(Field(mladr, 1))); +#ifdef SIN6_LEN + adr->s_inet.sin_len = sizeof(struct sockaddr_in); +#endif + *adr_len = sizeof(struct sockaddr_in); + break; + } +} + +value alloc_sockaddr(union sock_addr_union * adr /*in*/, + socklen_param_type adr_len, int close_on_error) +{ + value res; + switch(adr->s_gen.sa_family) { +#ifndef _WIN32 + case AF_UNIX: + { value n = copy_string(adr->s_unix.sun_path); + Begin_root (n); + res = alloc_small(1, 0); + Field(res,0) = n; + End_roots(); + break; + } +#endif + case AF_INET: + { value a = alloc_inet_addr(&adr->s_inet.sin_addr); + Begin_root (a); + res = alloc_small(2, 1); + Field(res,0) = a; + Field(res,1) = Val_int(ntohs(adr->s_inet.sin_port)); + End_roots(); + break; + } +#ifdef HAS_IPV6 + case AF_INET6: + { value a = alloc_inet6_addr(&adr->s_inet6.sin6_addr); + Begin_root (a); + res = alloc_small(2, 1); + Field(res,0) = a; + Field(res,1) = Val_int(ntohs(adr->s_inet6.sin6_port)); + End_roots(); + break; + } +#endif + default: + if (close_on_error != -1) close (close_on_error); + unix_error(EAFNOSUPPORT, "", Nothing); + } + return res; +} + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/socketaddr.h b/ocaml-binary-annot/otherlibs/unix/socketaddr.h new file mode 100644 index 0000000000..79bc80fa7a --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/socketaddr.h @@ -0,0 +1,49 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <misc.h> +#include <sys/types.h> +#include <sys/socket.h> +#include <sys/un.h> +#include <netinet/in.h> +#include <arpa/inet.h> + +union sock_addr_union { + struct sockaddr s_gen; + struct sockaddr_un s_unix; + struct sockaddr_in s_inet; +#ifdef HAS_IPV6 + struct sockaddr_in6 s_inet6; +#endif +}; + +#ifdef HAS_SOCKLEN_T +typedef socklen_t socklen_param_type; +#else +typedef int socklen_param_type; +#endif + +extern void get_sockaddr (value mladdr, + union sock_addr_union * addr /*out*/, + socklen_param_type * addr_len /*out*/); +CAMLexport value alloc_sockaddr (union sock_addr_union * addr /*in*/, + socklen_param_type addr_len, int close_on_error); +CAMLexport value alloc_inet_addr (struct in_addr * inaddr); +#define GET_INET_ADDR(v) (*((struct in_addr *) (v))) + +#ifdef HAS_IPV6 +CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr); +#define GET_INET6_ADDR(v) (*((struct in6_addr *) (v))) +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/socketpair.c b/ocaml-binary-annot/otherlibs/unix/socketpair.c new file mode 100644 index 0000000000..df4dcff036 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/socketpair.c @@ -0,0 +1,46 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include <sys/socket.h> + +extern int socket_domain_table[], socket_type_table[]; + +CAMLprim value unix_socketpair(value domain, value type, value proto) +{ + int sv[2]; + value res; + if (socketpair(socket_domain_table[Int_val(domain)], + socket_type_table[Int_val(type)], + Int_val(proto), sv) == -1) + uerror("socketpair", Nothing); + res = alloc_small(2, 0); + Field(res,0) = Val_int(sv[0]); + Field(res,1) = Val_int(sv[1]); + return res; +} + +#else + +CAMLprim value unix_socketpair(value domain, value type, value proto) +{ invalid_argument("socketpair not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/sockopt.c b/ocaml-binary-annot/otherlibs/unix/sockopt.c new file mode 100644 index 0000000000..31c95c1f55 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/sockopt.c @@ -0,0 +1,300 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <memory.h> +#include <alloc.h> +#include <fail.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include <errno.h> +#include <sys/time.h> +#include <sys/types.h> +#include <sys/socket.h> +#include <netinet/tcp.h> + +#include "socketaddr.h" + +#ifndef SO_DEBUG +#define SO_DEBUG (-1) +#endif +#ifndef SO_BROADCAST +#define SO_BROADCAST (-1) +#endif +#ifndef SO_REUSEADDR +#define SO_REUSEADDR (-1) +#endif +#ifndef SO_KEEPALIVE +#define SO_KEEPALIVE (-1) +#endif +#ifndef SO_DONTROUTE +#define SO_DONTROUTE (-1) +#endif +#ifndef SO_OOBINLINE +#define SO_OOBINLINE (-1) +#endif +#ifndef SO_ACCEPTCONN +#define SO_ACCEPTCONN (-1) +#endif +#ifndef SO_SNDBUF +#define SO_SNDBUF (-1) +#endif +#ifndef SO_RCVBUF +#define SO_RCVBUF (-1) +#endif +#ifndef SO_ERROR +#define SO_ERROR (-1) +#endif +#ifndef SO_TYPE +#define SO_TYPE (-1) +#endif +#ifndef SO_RCVLOWAT +#define SO_RCVLOWAT (-1) +#endif +#ifndef SO_SNDLOWAT +#define SO_SNDLOWAT (-1) +#endif +#ifndef SO_LINGER +#define SO_LINGER (-1) +#endif +#ifndef SO_RCVTIMEO +#define SO_RCVTIMEO (-1) +#endif +#ifndef SO_SNDTIMEO +#define SO_SNDTIMEO (-1) +#endif +#ifndef TCP_NODELAY +#define TCP_NODELAY (-1) +#endif +#ifndef SO_ERROR +#define SO_ERROR (-1) +#endif +#ifndef IPPROTO_IPV6 +#define IPPROTO_IPV6 (-1) +#endif +#ifndef IPV6_V6ONLY +#define IPV6_V6ONLY (-1) +#endif + +enum option_type { + TYPE_BOOL = 0, + TYPE_INT = 1, + TYPE_LINGER = 2, + TYPE_TIMEVAL = 3, + TYPE_UNIX_ERROR = 4 +}; + +struct socket_option { + int level; + int option; +}; + +/* Table of options, indexed by type */ + +static struct socket_option sockopt_bool[] = { + { SOL_SOCKET, SO_DEBUG }, + { SOL_SOCKET, SO_BROADCAST }, + { SOL_SOCKET, SO_REUSEADDR }, + { SOL_SOCKET, SO_KEEPALIVE }, + { SOL_SOCKET, SO_DONTROUTE }, + { SOL_SOCKET, SO_OOBINLINE }, + { SOL_SOCKET, SO_ACCEPTCONN }, + { IPPROTO_TCP, TCP_NODELAY }, + { IPPROTO_IPV6, IPV6_V6ONLY} +}; + +static struct socket_option sockopt_int[] = { + { SOL_SOCKET, SO_SNDBUF }, + { SOL_SOCKET, SO_RCVBUF }, + { SOL_SOCKET, SO_ERROR }, + { SOL_SOCKET, SO_TYPE }, + { SOL_SOCKET, SO_RCVLOWAT }, + { SOL_SOCKET, SO_SNDLOWAT } }; + +static struct socket_option sockopt_linger[] = { + { SOL_SOCKET, SO_LINGER } +}; + +static struct socket_option sockopt_timeval[] = { + { SOL_SOCKET, SO_RCVTIMEO }, + { SOL_SOCKET, SO_SNDTIMEO } +}; + +static struct socket_option sockopt_unix_error[] = { + { SOL_SOCKET, SO_ERROR } +}; + +static struct socket_option * sockopt_table[] = { + sockopt_bool, + sockopt_int, + sockopt_linger, + sockopt_timeval, + sockopt_unix_error +}; + +static char * getsockopt_fun_name[] = { + "getsockopt", + "getsockopt_int", + "getsockopt_optint", + "getsockopt_float", + "getsockopt_error" +}; + +static char * setsockopt_fun_name[] = { + "setsockopt", + "setsockopt_int", + "setsockopt_optint", + "setsockopt_float", + "setsockopt_error" +}; + +union option_value { + int i; + struct linger lg; + struct timeval tv; +}; + +CAMLexport value +unix_getsockopt_aux(char * name, + enum option_type ty, int level, int option, + value socket) +{ + union option_value optval; + socklen_param_type optsize; + + + switch (ty) { + case TYPE_BOOL: + case TYPE_INT: + case TYPE_UNIX_ERROR: + optsize = sizeof(optval.i); break; + case TYPE_LINGER: + optsize = sizeof(optval.lg); break; + case TYPE_TIMEVAL: + optsize = sizeof(optval.tv); break; + default: + unix_error(EINVAL, name, Nothing); + } + + if (getsockopt(Int_val(socket), level, option, + (void *) &optval, &optsize) == -1) + uerror(name, Nothing); + + switch (ty) { + case TYPE_BOOL: + case TYPE_INT: + return Val_int(optval.i); + case TYPE_LINGER: + if (optval.lg.l_onoff == 0) { + return Val_int(0); /* None */ + } else { + value res = alloc_small(1, 0); /* Some */ + Field(res, 0) = Val_int(optval.lg.l_linger); + return res; + } + case TYPE_TIMEVAL: + return copy_double((double) optval.tv.tv_sec + + (double) optval.tv.tv_usec / 1e6); + case TYPE_UNIX_ERROR: + if (optval.i == 0) { + return Val_int(0); /* None */ + } else { + value err, res; + err = unix_error_of_code(optval.i); + Begin_root(err); + res = alloc_small(1, 0); /* Some */ + Field(res, 0) = err; + End_roots(); + return res; + } + default: + unix_error(EINVAL, name, Nothing); + } +} + +CAMLexport value +unix_setsockopt_aux(char * name, + enum option_type ty, int level, int option, + value socket, value val) +{ + union option_value optval; + socklen_param_type optsize; + double f; + + switch (ty) { + case TYPE_BOOL: + case TYPE_INT: + optsize = sizeof(optval.i); + optval.i = Int_val(val); + break; + case TYPE_LINGER: + optsize = sizeof(optval.lg); + optval.lg.l_onoff = Is_block (val); + if (optval.lg.l_onoff) + optval.lg.l_linger = Int_val (Field (val, 0)); + break; + case TYPE_TIMEVAL: + f = Double_val(val); + optsize = sizeof(optval.tv); + optval.tv.tv_sec = (int) f; + optval.tv.tv_usec = (int) (1e6 * (f - optval.tv.tv_sec)); + break; + case TYPE_UNIX_ERROR: + default: + unix_error(EINVAL, name, Nothing); + } + + if (setsockopt(Int_val(socket), level, option, + (void *) &optval, optsize) == -1) + uerror(name, Nothing); + + return Val_unit; +} + +CAMLprim value unix_getsockopt(value vty, value vsocket, value voption) +{ + enum option_type ty = Int_val(vty); + struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]); + return unix_getsockopt_aux(getsockopt_fun_name[ty], + ty, + opt->level, + opt->option, + vsocket); +} + +CAMLprim value unix_setsockopt(value vty, value vsocket, value voption, + value val) +{ + enum option_type ty = Int_val(vty); + struct socket_option * opt = &(sockopt_table[ty][Int_val(voption)]); + return unix_setsockopt_aux(setsockopt_fun_name[ty], + ty, + opt->level, + opt->option, + vsocket, + val); +} + +#else + +CAMLprim value unix_getsockopt(value vty, value socket, value option) +{ invalid_argument("getsockopt not implemented"); } + +CAMLprim value unix_setsockopt(value vty, value socket, value option, value val) +{ invalid_argument("setsockopt not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/stat.c b/ocaml-binary-annot/otherlibs/unix/stat.c new file mode 100644 index 0000000000..9cd0000632 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/stat.c @@ -0,0 +1,139 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <errno.h> +#include <mlvalues.h> +#include <memory.h> +#include <alloc.h> +#include "unixsupport.h" +#include "cst2constr.h" +#include <sys/types.h> +#include <sys/stat.h> +#include <io.h> + +#ifndef S_IFLNK +#define S_IFLNK 0 +#endif +#ifndef S_IFIFO +#define S_IFIFO 0 +#endif +#ifndef S_IFSOCK +#define S_IFSOCK 0 +#endif +#ifndef S_IFBLK +#define S_IFBLK 0 +#endif + +#ifndef EOVERFLOW +#define EOVERFLOW ERANGE +#endif + +static int file_kind_table[] = { + S_IFREG, S_IFDIR, S_IFCHR, S_IFBLK, S_IFLNK, S_IFIFO, S_IFSOCK +}; + +static value stat_aux(int use_64, struct stat *buf) +{ + CAMLparam0(); + CAMLlocal5(atime, mtime, ctime, offset, v); + + atime = copy_double((double) buf->st_atime); + mtime = copy_double((double) buf->st_mtime); + ctime = copy_double((double) buf->st_ctime); + offset = use_64 ? Val_file_offset(buf->st_size) : Val_int (buf->st_size); + v = alloc_small(12, 0); + Field (v, 0) = Val_int (buf->st_dev); + Field (v, 1) = Val_int (buf->st_ino); + Field (v, 2) = cst_to_constr(buf->st_mode & S_IFMT, file_kind_table, + sizeof(file_kind_table) / sizeof(int), 0); + Field (v, 3) = Val_int (buf->st_mode & 07777); + Field (v, 4) = Val_int (buf->st_nlink); + Field (v, 5) = Val_int (buf->st_uid); + Field (v, 6) = Val_int (buf->st_gid); + Field (v, 7) = Val_int (buf->st_rdev); + Field (v, 8) = offset; + Field (v, 9) = atime; + Field (v, 10) = mtime; + Field (v, 11) = ctime; + CAMLreturn(v); +} + +CAMLprim value unix_stat(value path) +{ + int ret; + struct stat buf; + ret = stat(String_val(path), &buf); + if (ret == -1) uerror("stat", path); + if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG) + unix_error(EOVERFLOW, "stat", path); + return stat_aux(0, &buf); +} + +CAMLprim value unix_lstat(value path) +{ + int ret; + struct stat buf; +#ifdef HAS_SYMLINK + ret = lstat(String_val(path), &buf); +#else + ret = stat(String_val(path), &buf); +#endif + if (ret == -1) uerror("lstat", path); + if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG) + unix_error(EOVERFLOW, "lstat", path); + return stat_aux(0, &buf); +} + +CAMLprim value unix_fstat(value fd) +{ + int ret; + struct stat buf; + ret = fstat(Int_val(fd), &buf); + if (ret == -1) uerror("fstat", Nothing); + if (buf.st_size > Max_long && (buf.st_mode & S_IFMT) == S_IFREG) + unix_error(EOVERFLOW, "fstat", Nothing); + return stat_aux(0, &buf); +} + +CAMLprim value unix_stat_64(value path) +{ + int ret; + struct stat buf; + ret = stat(String_val(path), &buf); + if (ret == -1) uerror("stat", path); + return stat_aux(1, &buf); +} + +CAMLprim value unix_lstat_64(value path) +{ + int ret; + struct stat buf; +#ifdef HAS_SYMLINK + ret = lstat(String_val(path), &buf); +#else + ret = stat(String_val(path), &buf); +#endif + if (ret == -1) uerror("lstat", path); + return stat_aux(1, &buf); +} + +CAMLprim value unix_fstat_64(value fd) +{ + int ret; + struct stat buf; + ret = fstat(Int_val(fd), &buf); + if (ret == -1) uerror("fstat", Nothing); + return stat_aux(1, &buf); +} diff --git a/ocaml-binary-annot/otherlibs/unix/strofaddr.c b/ocaml-binary-annot/otherlibs/unix/strofaddr.c new file mode 100644 index 0000000000..ad9ea19117 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/strofaddr.c @@ -0,0 +1,50 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include "unixsupport.h" + +#ifdef HAS_SOCKETS + +#include "socketaddr.h" + +CAMLprim value unix_string_of_inet_addr(value a) +{ + char * res; +#ifdef HAS_IPV6 + char buffer[64]; + if (string_length(a) == 16) + res = (char *) + inet_ntop(AF_INET6, (const void *) &GET_INET6_ADDR(a), + buffer, sizeof(buffer)); + else + res = (char *) + inet_ntop(AF_INET, (const void *) &GET_INET_ADDR(a), + buffer, sizeof(buffer)); +#else + res = inet_ntoa(GET_INET_ADDR(a)); +#endif + if (res == NULL) uerror("string_of_inet_addr", Nothing); + return copy_string(res); +} + +#else + +CAMLprim value unix_string_of_inet_addr(value a) +{ invalid_argument("string_of_inet_addr not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/symlink.c b/ocaml-binary-annot/otherlibs/unix/symlink.c new file mode 100644 index 0000000000..6085fd516d --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/symlink.c @@ -0,0 +1,34 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_SYMLINK + +CAMLprim value unix_symlink(value path1, value path2) +{ + if (symlink(String_val(path1), String_val(path2)) == -1) + uerror("symlink", path2); + return Val_unit; +} + +#else + +CAMLprim value unix_symlink(value path1, value path2) +{ invalid_argument("symlink not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/termios.c b/ocaml-binary-annot/otherlibs/unix/termios.c new file mode 100644 index 0000000000..ce49d77e09 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/termios.c @@ -0,0 +1,316 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include "unixsupport.h" + +#ifdef HAS_TERMIOS + +#include <termios.h> +#include <errno.h> + +static struct termios terminal_status; + +enum { Bool, Enum, Speed, Char, End }; + +enum { Input, Output }; + +#define iflags ((long)(&terminal_status.c_iflag)) +#define oflags ((long)(&terminal_status.c_oflag)) +#define cflags ((long)(&terminal_status.c_cflag)) +#define lflags ((long)(&terminal_status.c_lflag)) + +/* Number of fields in the terminal_io record field. Cf. unix.mli */ + +#define NFIELDS 38 + +/* Structure of the terminal_io record. Cf. unix.mli */ + +static long terminal_io_descr[] = { + /* Input modes */ + Bool, iflags, IGNBRK, + Bool, iflags, BRKINT, + Bool, iflags, IGNPAR, + Bool, iflags, PARMRK, + Bool, iflags, INPCK, + Bool, iflags, ISTRIP, + Bool, iflags, INLCR, + Bool, iflags, IGNCR, + Bool, iflags, ICRNL, + Bool, iflags, IXON, + Bool, iflags, IXOFF, + /* Output modes */ + Bool, oflags, OPOST, + /* Control modes */ + Speed, Output, + Speed, Input, + Enum, cflags, 5, 4, CSIZE, CS5, CS6, CS7, CS8, + Enum, cflags, 1, 2, CSTOPB, 0, CSTOPB, + Bool, cflags, CREAD, + Bool, cflags, PARENB, + Bool, cflags, PARODD, + Bool, cflags, HUPCL, + Bool, cflags, CLOCAL, + /* Local modes */ + Bool, lflags, ISIG, + Bool, lflags, ICANON, + Bool, lflags, NOFLSH, + Bool, lflags, ECHO, + Bool, lflags, ECHOE, + Bool, lflags, ECHOK, + Bool, lflags, ECHONL, + /* Control characters */ + Char, VINTR, + Char, VQUIT, + Char, VERASE, + Char, VKILL, + Char, VEOF, + Char, VEOL, + Char, VMIN, + Char, VTIME, + Char, VSTART, + Char, VSTOP, + End +}; + +#undef iflags +#undef oflags +#undef cflags +#undef lflags + +struct speedtable_entry ; + +static struct { + speed_t speed; + int baud; +} speedtable[] = { + {B50, 50}, + {B75, 75}, + {B110, 110}, + {B134, 134}, + {B150, 150}, + {B300, 300}, + {B600, 600}, + {B1200, 1200}, + {B1800, 1800}, + {B2400, 2400}, + {B4800, 4800}, + {B9600, 9600}, + {B19200, 19200}, + {B38400, 38400}, +#ifdef B57600 + {B57600, 57600}, +#endif +#ifdef B115200 + {B115200, 115200}, +#endif +#ifdef B230400 + {B230400, 230400}, +#endif + {B0, 0} +}; + +#define NSPEEDS (sizeof(speedtable) / sizeof(speedtable[0])) + +static void encode_terminal_status(value *dst) +{ + long * pc; + int i; + + for(pc = terminal_io_descr; *pc != End; dst++) { + switch(*pc++) { + case Bool: + { int * src = (int *) (*pc++); + int msk = *pc++; + *dst = Val_bool(*src & msk); + break; } + case Enum: + { int * src = (int *) (*pc++); + int ofs = *pc++; + int num = *pc++; + int msk = *pc++; + for (i = 0; i < num; i++) { + if ((*src & msk) == pc[i]) { + *dst = Val_int(i + ofs); + break; + } + } + pc += num; + break; } + case Speed: + { int which = *pc++; + speed_t speed = 0; + *dst = Val_int(9600); /* in case no speed in speedtable matches */ + switch (which) { + case Output: + speed = cfgetospeed(&terminal_status); break; + case Input: + speed = cfgetispeed(&terminal_status); break; + } + for (i = 0; i < NSPEEDS; i++) { + if (speed == speedtable[i].speed) { + *dst = Val_int(speedtable[i].baud); + break; + } + } + break; } + case Char: + { int which = *pc++; + *dst = Val_int(terminal_status.c_cc[which]); + break; } + } + } +} + +static void decode_terminal_status(value *src) +{ + long * pc; + int i; + + for (pc = terminal_io_descr; *pc != End; src++) { + switch(*pc++) { + case Bool: + { int * dst = (int *) (*pc++); + int msk = *pc++; + if (Bool_val(*src)) + *dst |= msk; + else + *dst &= ~msk; + break; } + case Enum: + { int * dst = (int *) (*pc++); + int ofs = *pc++; + int num = *pc++; + int msk = *pc++; + i = Int_val(*src) - ofs; + if (i >= 0 && i < num) { + *dst = (*dst & ~msk) | pc[i]; + } else { + unix_error(EINVAL, "tcsetattr", Nothing); + } + pc += num; + break; } + case Speed: + { int which = *pc++; + int baud = Int_val(*src); + int res = 0; + for (i = 0; i < NSPEEDS; i++) { + if (baud == speedtable[i].baud) { + switch (which) { + case Output: + res = cfsetospeed(&terminal_status, speedtable[i].speed); break; + case Input: + res = cfsetispeed(&terminal_status, speedtable[i].speed); break; + } + if (res == -1) uerror("tcsetattr", Nothing); + goto ok; + } + } + unix_error(EINVAL, "tcsetattr", Nothing); + ok: + break; } + case Char: + { int which = *pc++; + terminal_status.c_cc[which] = Int_val(*src); + break; } + } + } +} + +CAMLprim value unix_tcgetattr(value fd) +{ + value res; + + if (tcgetattr(Int_val(fd), &terminal_status) == -1) + uerror("tcgetattr", Nothing); + res = alloc_tuple(NFIELDS); + encode_terminal_status(&Field(res, 0)); + return res; +} + +static int when_flag_table[] = { + TCSANOW, TCSADRAIN, TCSAFLUSH +}; + +CAMLprim value unix_tcsetattr(value fd, value when, value arg) +{ + if (tcgetattr(Int_val(fd), &terminal_status) == -1) + uerror("tcsetattr", Nothing); + decode_terminal_status(&Field(arg, 0)); + if (tcsetattr(Int_val(fd), + when_flag_table[Int_val(when)], + &terminal_status) == -1) + uerror("tcsetattr", Nothing); + return Val_unit; +} + +CAMLprim value unix_tcsendbreak(value fd, value delay) +{ + if (tcsendbreak(Int_val(fd), Int_val(delay)) == -1) + uerror("tcsendbreak", Nothing); + return Val_unit; +} + +CAMLprim value unix_tcdrain(value fd) +{ + if (tcdrain(Int_val(fd)) == -1) uerror("tcdrain", Nothing); + return Val_unit; +} + +static int queue_flag_table[] = { + TCIFLUSH, TCOFLUSH, TCIOFLUSH +}; + +CAMLprim value unix_tcflush(value fd, value queue) +{ + if (tcflush(Int_val(fd), queue_flag_table[Int_val(queue)]) == -1) + uerror("tcflush", Nothing); + return Val_unit; +} + +static int action_flag_table[] = { + TCOOFF, TCOON, TCIOFF, TCION +}; + +CAMLprim value unix_tcflow(value fd, value action) +{ + if (tcflow(Int_val(fd), action_flag_table[Int_val(action)]) == -1) + uerror("tcflow", Nothing); + return Val_unit; +} + +#else + +CAMLprim value unix_tcgetattr(value fd) +{ invalid_argument("tcgetattr not implemented"); } + +CAMLprim value unix_tcsetattr(value fd, value when, value arg) +{ invalid_argument("tcsetattr not implemented"); } + +CAMLprim value unix_tcsendbreak(value fd, value delay) +{ invalid_argument("tcsendbreak not implemented"); } + +CAMLprim value unix_tcdrain(value fd) +{ invalid_argument("tcdrain not implemented"); } + +CAMLprim value unix_tcflush(value fd, value queue) +{ invalid_argument("tcflush not implemented"); } + +CAMLprim value unix_tcflow(value fd, value action) +{ invalid_argument("tcflow not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/time.c b/ocaml-binary-annot/otherlibs/unix/time.c new file mode 100644 index 0000000000..2fdf4978e4 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/time.c @@ -0,0 +1,24 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <time.h> +#include <mlvalues.h> +#include <alloc.h> +#include "unixsupport.h" + +CAMLprim value unix_time(value unit) +{ + return copy_double((double) time((time_t *) NULL)); +} diff --git a/ocaml-binary-annot/otherlibs/unix/times.c b/ocaml-binary-annot/otherlibs/unix/times.c new file mode 100644 index 0000000000..aa32f10db0 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/times.c @@ -0,0 +1,67 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <memory.h> +#include "unixsupport.h" +#include <time.h> +#include <sys/types.h> +#include <sys/times.h> +#ifdef HAS_GETRUSAGE +#include <sys/time.h> +#include <sys/resource.h> +#endif + +#ifndef CLK_TCK +#ifdef HZ +#define CLK_TCK HZ +#else +#define CLK_TCK 60 +#endif +#endif + +CAMLprim value unix_times(value unit) +{ +#ifdef HAS_GETRUSAGE + + value res; + struct rusage ru; + + res = alloc_small(4 * Double_wosize, Double_array_tag); + + getrusage (RUSAGE_SELF, &ru); + Store_double_field (res, 0, ru.ru_utime.tv_sec + ru.ru_utime.tv_usec / 1e6); + Store_double_field (res, 1, ru.ru_stime.tv_sec + ru.ru_stime.tv_usec / 1e6); + getrusage (RUSAGE_CHILDREN, &ru); + Store_double_field (res, 2, ru.ru_utime.tv_sec + ru.ru_utime.tv_usec / 1e6); + Store_double_field (res, 3, ru.ru_stime.tv_sec + ru.ru_stime.tv_usec / 1e6); + return res; + +#else + + value res; + struct tms buffer; + + times(&buffer); + res = alloc_small(4 * Double_wosize, Double_array_tag); + Store_double_field(res, 0, (double) buffer.tms_utime / CLK_TCK); + Store_double_field(res, 1, (double) buffer.tms_stime / CLK_TCK); + Store_double_field(res, 2, (double) buffer.tms_cutime / CLK_TCK); + Store_double_field(res, 3, (double) buffer.tms_cstime / CLK_TCK); + return res; + +#endif +} diff --git a/ocaml-binary-annot/otherlibs/unix/truncate.c b/ocaml-binary-annot/otherlibs/unix/truncate.c new file mode 100644 index 0000000000..c23eb47b52 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/truncate.c @@ -0,0 +1,49 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <sys/types.h> +#include <mlvalues.h> +#include <fail.h> +#include <io.h> +#include "unixsupport.h" +#ifdef HAS_UNISTD +#include <unistd.h> +#endif + +#ifdef HAS_TRUNCATE + +CAMLprim value unix_truncate(value path, value len) +{ + if (truncate(String_val(path), Long_val(len)) == -1) + uerror("truncate", path); + return Val_unit; +} + +CAMLprim value unix_truncate_64(value path, value len) +{ + if (truncate(String_val(path), File_offset_val(len)) == -1) + uerror("truncate", path); + return Val_unit; +} + +#else + +CAMLprim value unix_truncate(value path, value len) +{ invalid_argument("truncate not implemented"); } + +CAMLprim value unix_truncate_64(value path, value len) +{ invalid_argument("truncate not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/umask.c b/ocaml-binary-annot/otherlibs/unix/umask.c new file mode 100644 index 0000000000..6f5d14fd0c --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/umask.c @@ -0,0 +1,24 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <sys/types.h> +#include <sys/stat.h> +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_umask(value perm) +{ + return Val_int(umask(Int_val(perm))); +} diff --git a/ocaml-binary-annot/otherlibs/unix/unix.ml b/ocaml-binary-annot/otherlibs/unix/unix.ml new file mode 100644 index 0000000000..8de827b0c8 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/unix.ml @@ -0,0 +1,967 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../../LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +type error = + E2BIG + | EACCES + | EAGAIN + | EBADF + | EBUSY + | ECHILD + | EDEADLK + | EDOM + | EEXIST + | EFAULT + | EFBIG + | EINTR + | EINVAL + | EIO + | EISDIR + | EMFILE + | EMLINK + | ENAMETOOLONG + | ENFILE + | ENODEV + | ENOENT + | ENOEXEC + | ENOLCK + | ENOMEM + | ENOSPC + | ENOSYS + | ENOTDIR + | ENOTEMPTY + | ENOTTY + | ENXIO + | EPERM + | EPIPE + | ERANGE + | EROFS + | ESPIPE + | ESRCH + | EXDEV + | EWOULDBLOCK + | EINPROGRESS + | EALREADY + | ENOTSOCK + | EDESTADDRREQ + | EMSGSIZE + | EPROTOTYPE + | ENOPROTOOPT + | EPROTONOSUPPORT + | ESOCKTNOSUPPORT + | EOPNOTSUPP + | EPFNOSUPPORT + | EAFNOSUPPORT + | EADDRINUSE + | EADDRNOTAVAIL + | ENETDOWN + | ENETUNREACH + | ENETRESET + | ECONNABORTED + | ECONNRESET + | ENOBUFS + | EISCONN + | ENOTCONN + | ESHUTDOWN + | ETOOMANYREFS + | ETIMEDOUT + | ECONNREFUSED + | EHOSTDOWN + | EHOSTUNREACH + | ELOOP + | EOVERFLOW + | EUNKNOWNERR of int + +exception Unix_error of error * string * string + +let _ = Callback.register_exception "Unix.Unix_error" + (Unix_error(E2BIG, "", "")) + +external error_message : error -> string = "unix_error_message" + +let handle_unix_error f arg = + try + f arg + with Unix_error(err, fun_name, arg) -> + prerr_string Sys.argv.(0); + prerr_string ": \""; + prerr_string fun_name; + prerr_string "\" failed"; + if String.length arg > 0 then begin + prerr_string " on \""; + prerr_string arg; + prerr_string "\"" + end; + prerr_string ": "; + prerr_endline (error_message err); + exit 2 + +external environment : unit -> string array = "unix_environment" +external getenv: string -> string = "caml_sys_getenv" +external putenv: string -> string -> unit = "unix_putenv" + +type process_status = + WEXITED of int + | WSIGNALED of int + | WSTOPPED of int + +type wait_flag = + WNOHANG + | WUNTRACED + +external execv : string -> string array -> 'a = "unix_execv" +external execve : string -> string array -> string array -> 'a = "unix_execve" +external execvp : string -> string array -> 'a = "unix_execvp" +external execvpe : string -> string array -> string array -> 'a = "unix_execvpe" +external fork : unit -> int = "unix_fork" +external wait : unit -> int * process_status = "unix_wait" +external waitpid : wait_flag list -> int -> int * process_status = "unix_waitpid" +external getpid : unit -> int = "unix_getpid" +external getppid : unit -> int = "unix_getppid" +external nice : int -> int = "unix_nice" + +type file_descr = int + +let stdin = 0 +let stdout = 1 +let stderr = 2 + +type 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 + +type file_perm = int + + +external openfile : string -> open_flag list -> file_perm -> file_descr + = "unix_open" + +external close : file_descr -> unit = "unix_close" +external unsafe_read : file_descr -> string -> int -> int -> int = "unix_read" +external unsafe_write : file_descr -> string -> int -> int -> int = "unix_write" +external unsafe_single_write : file_descr -> string -> int -> int -> int = "unix_single_write" + +let read fd buf ofs len = + if ofs < 0 || len < 0 || ofs > String.length buf - len + then invalid_arg "Unix.read" + else unsafe_read fd buf ofs len +let write fd buf ofs len = + if ofs < 0 || len < 0 || ofs > String.length buf - len + then invalid_arg "Unix.write" + else unsafe_write fd buf ofs len +(* write misbehaves because it attempts to write all data by making repeated + calls to the Unix write function (see comment in write.c and unix.mli). + partial_write fixes this by never calling write twice. *) +let single_write fd buf ofs len = + if ofs < 0 || len < 0 || ofs > String.length buf - len + then invalid_arg "Unix.single_write" + else unsafe_single_write fd buf ofs len + +external in_channel_of_descr : file_descr -> in_channel + = "caml_ml_open_descriptor_in" +external out_channel_of_descr : file_descr -> out_channel + = "caml_ml_open_descriptor_out" +external descr_of_in_channel : in_channel -> file_descr + = "caml_channel_descriptor" +external descr_of_out_channel : out_channel -> file_descr + = "caml_channel_descriptor" + +type seek_command = + SEEK_SET + | SEEK_CUR + | SEEK_END + +external lseek : file_descr -> int -> seek_command -> int = "unix_lseek" +external truncate : string -> int -> unit = "unix_truncate" +external ftruncate : file_descr -> int -> unit = "unix_ftruncate" + +type file_kind = + S_REG + | S_DIR + | S_CHR + | S_BLK + | S_LNK + | S_FIFO + | S_SOCK + +type stats = + { st_dev : int; + st_ino : int; + st_kind : file_kind; + st_perm : file_perm; + st_nlink : int; + st_uid : int; + st_gid : int; + st_rdev : int; + st_size : int; + st_atime : float; + st_mtime : float; + st_ctime : float } + +external stat : string -> stats = "unix_stat" +external lstat : string -> stats = "unix_lstat" +external fstat : file_descr -> stats = "unix_fstat" +external isatty : file_descr -> bool = "unix_isatty" +external unlink : string -> unit = "unix_unlink" +external rename : string -> string -> unit = "unix_rename" +external link : string -> string -> unit = "unix_link" + +module LargeFile = + struct + external lseek : file_descr -> int64 -> seek_command -> int64 = "unix_lseek_64" + external truncate : string -> int64 -> unit = "unix_truncate_64" + external ftruncate : file_descr -> int64 -> unit = "unix_ftruncate_64" + type stats = + { st_dev : int; + st_ino : int; + st_kind : file_kind; + st_perm : file_perm; + st_nlink : int; + st_uid : int; + st_gid : int; + st_rdev : int; + st_size : int64; + st_atime : float; + st_mtime : float; + st_ctime : float; + } + external stat : string -> stats = "unix_stat_64" + external lstat : string -> stats = "unix_lstat_64" + external fstat : file_descr -> stats = "unix_fstat_64" + end + +type access_permission = + R_OK + | W_OK + | X_OK + | F_OK + +external chmod : string -> file_perm -> unit = "unix_chmod" +external fchmod : file_descr -> file_perm -> unit = "unix_fchmod" +external chown : string -> int -> int -> unit = "unix_chown" +external fchown : file_descr -> int -> int -> unit = "unix_fchown" +external umask : int -> int = "unix_umask" +external access : string -> access_permission list -> unit = "unix_access" + +external dup : file_descr -> file_descr = "unix_dup" +external dup2 : file_descr -> file_descr -> unit = "unix_dup2" +external set_nonblock : file_descr -> unit = "unix_set_nonblock" +external clear_nonblock : file_descr -> unit = "unix_clear_nonblock" +external set_close_on_exec : file_descr -> unit = "unix_set_close_on_exec" +external clear_close_on_exec : file_descr -> unit = "unix_clear_close_on_exec" + +(* FD_CLOEXEC should be supported on all Unix systems these days, + but just in case... *) +let try_set_close_on_exec fd = + try set_close_on_exec fd; true with Invalid_argument _ -> false + +external mkdir : string -> file_perm -> unit = "unix_mkdir" +external rmdir : string -> unit = "unix_rmdir" +external chdir : string -> unit = "unix_chdir" +external getcwd : unit -> string = "unix_getcwd" +external chroot : string -> unit = "unix_chroot" + +type dir_handle + +external opendir : string -> dir_handle = "unix_opendir" +external readdir : dir_handle -> string = "unix_readdir" +external rewinddir : dir_handle -> unit = "unix_rewinddir" +external closedir : dir_handle -> unit = "unix_closedir" + +external pipe : unit -> file_descr * file_descr = "unix_pipe" +external symlink : string -> string -> unit = "unix_symlink" +external readlink : string -> string = "unix_readlink" +external mkfifo : string -> file_perm -> unit = "unix_mkfifo" +external select : + file_descr list -> file_descr list -> file_descr list -> float -> + file_descr list * file_descr list * file_descr list = "unix_select" + +type lock_command = + F_ULOCK + | F_LOCK + | F_TLOCK + | F_TEST + | F_RLOCK + | F_TRLOCK + +external lockf : file_descr -> lock_command -> int -> unit = "unix_lockf" +external kill : int -> int -> unit = "unix_kill" +type sigprocmask_command = SIG_SETMASK | SIG_BLOCK | SIG_UNBLOCK +external sigprocmask: sigprocmask_command -> int list -> int list + = "unix_sigprocmask" +external sigpending: unit -> int list = "unix_sigpending" +external sigsuspend: int list -> unit = "unix_sigsuspend" + +let pause() = + let sigs = sigprocmask SIG_BLOCK [] in sigsuspend sigs + +type process_times = + { tms_utime : float; + tms_stime : float; + tms_cutime : float; + tms_cstime : float } + +type tm = + { tm_sec : int; + tm_min : int; + tm_hour : int; + tm_mday : int; + tm_mon : int; + tm_year : int; + tm_wday : int; + tm_yday : int; + tm_isdst : bool } + +external time : unit -> float = "unix_time" +external gettimeofday : unit -> float = "unix_gettimeofday" +external gmtime : float -> tm = "unix_gmtime" +external localtime : float -> tm = "unix_localtime" +external mktime : tm -> float * tm = "unix_mktime" +external alarm : int -> int = "unix_alarm" +external sleep : int -> unit = "unix_sleep" +external times : unit -> process_times = "unix_times" +external utimes : string -> float -> float -> unit = "unix_utimes" + +type interval_timer = + ITIMER_REAL + | ITIMER_VIRTUAL + | ITIMER_PROF + +type interval_timer_status = + { it_interval: float; (* Period *) + it_value: float } (* Current value of the timer *) + +external getitimer: interval_timer -> interval_timer_status = "unix_getitimer" +external setitimer: + interval_timer -> interval_timer_status -> interval_timer_status + = "unix_setitimer" + +external getuid : unit -> int = "unix_getuid" +external geteuid : unit -> int = "unix_geteuid" +external setuid : int -> unit = "unix_setuid" +external getgid : unit -> int = "unix_getgid" +external getegid : unit -> int = "unix_getegid" +external setgid : int -> unit = "unix_setgid" +external getgroups : unit -> int array = "unix_getgroups" +external setgroups : int array -> unit = "unix_setgroups" +external initgroups : string -> int -> unit = "unix_initgroups" + +type passwd_entry = + { pw_name : string; + pw_passwd : string; + pw_uid : int; + pw_gid : int; + pw_gecos : string; + pw_dir : string; + pw_shell : string } + +type group_entry = + { gr_name : string; + gr_passwd : string; + gr_gid : int; + gr_mem : string array } + + +external getlogin : unit -> string = "unix_getlogin" +external getpwnam : string -> passwd_entry = "unix_getpwnam" +external getgrnam : string -> group_entry = "unix_getgrnam" +external getpwuid : int -> passwd_entry = "unix_getpwuid" +external getgrgid : int -> group_entry = "unix_getgrgid" + +type inet_addr = string + +let is_inet6_addr s = String.length s = 16 + +external inet_addr_of_string : string -> inet_addr + = "unix_inet_addr_of_string" +external string_of_inet_addr : inet_addr -> string + = "unix_string_of_inet_addr" + +let inet_addr_any = inet_addr_of_string "0.0.0.0" +let inet_addr_loopback = inet_addr_of_string "127.0.0.1" +let inet6_addr_any = + try inet_addr_of_string "::" with Failure _ -> inet_addr_any +let inet6_addr_loopback = + try inet_addr_of_string "::1" with Failure _ -> inet_addr_loopback + +type socket_domain = + PF_UNIX + | PF_INET + | PF_INET6 + +type socket_type = + SOCK_STREAM + | SOCK_DGRAM + | SOCK_RAW + | SOCK_SEQPACKET + +type sockaddr = + ADDR_UNIX of string + | ADDR_INET of inet_addr * int + +let domain_of_sockaddr = function + ADDR_UNIX _ -> PF_UNIX + | ADDR_INET(a, _) -> if is_inet6_addr a then PF_INET6 else PF_INET + +type shutdown_command = + SHUTDOWN_RECEIVE + | SHUTDOWN_SEND + | SHUTDOWN_ALL + +type msg_flag = + MSG_OOB + | MSG_DONTROUTE + | MSG_PEEK + +external socket : socket_domain -> socket_type -> int -> file_descr + = "unix_socket" +external socketpair : + socket_domain -> socket_type -> int -> file_descr * file_descr + = "unix_socketpair" +external accept : file_descr -> file_descr * sockaddr = "unix_accept" +external bind : file_descr -> sockaddr -> unit = "unix_bind" +external connect : file_descr -> sockaddr -> unit = "unix_connect" +external listen : file_descr -> int -> unit = "unix_listen" +external shutdown : file_descr -> shutdown_command -> unit = "unix_shutdown" +external getsockname : file_descr -> sockaddr = "unix_getsockname" +external getpeername : file_descr -> sockaddr = "unix_getpeername" + +external unsafe_recv : + file_descr -> string -> int -> int -> msg_flag list -> int + = "unix_recv" +external unsafe_recvfrom : + file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr + = "unix_recvfrom" +external unsafe_send : + file_descr -> string -> int -> int -> msg_flag list -> int + = "unix_send" +external unsafe_sendto : + file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int + = "unix_sendto" "unix_sendto_native" + +let recv fd buf ofs len flags = + if ofs < 0 || len < 0 || ofs > String.length buf - len + then invalid_arg "Unix.recv" + else unsafe_recv fd buf ofs len flags +let recvfrom fd buf ofs len flags = + if ofs < 0 || len < 0 || ofs > String.length buf - len + then invalid_arg "Unix.recvfrom" + else unsafe_recvfrom fd buf ofs len flags +let send fd buf ofs len flags = + if ofs < 0 || len < 0 || ofs > String.length buf - len + then invalid_arg "Unix.send" + else unsafe_send fd buf ofs len flags +let sendto fd buf ofs len flags addr = + if ofs < 0 || len < 0 || ofs > String.length buf - len + then invalid_arg "Unix.sendto" + else unsafe_sendto fd buf ofs len flags addr + +type socket_bool_option = + SO_DEBUG + | SO_BROADCAST + | SO_REUSEADDR + | SO_KEEPALIVE + | SO_DONTROUTE + | SO_OOBINLINE + | SO_ACCEPTCONN + | TCP_NODELAY + | IPV6_ONLY + +type socket_int_option = + SO_SNDBUF + | SO_RCVBUF + | SO_ERROR + | SO_TYPE + | SO_RCVLOWAT + | SO_SNDLOWAT + +type socket_optint_option = SO_LINGER + +type socket_float_option = + SO_RCVTIMEO + | SO_SNDTIMEO + +type socket_error_option = SO_ERROR + +module SO: sig + type ('opt, 'v) t + val bool: (socket_bool_option, bool) t + val int: (socket_int_option, int) t + val optint: (socket_optint_option, int option) t + val float: (socket_float_option, float) t + val error: (socket_error_option, error option) t + val get: ('opt, 'v) t -> file_descr -> 'opt -> 'v + val set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit +end = struct + type ('opt, 'v) t = int + let bool = 0 + let int = 1 + let optint = 2 + let float = 3 + let error = 4 + external get: ('opt, 'v) t -> file_descr -> 'opt -> 'v + = "unix_getsockopt" + external set: ('opt, 'v) t -> file_descr -> 'opt -> 'v -> unit + = "unix_setsockopt" +end + +let getsockopt fd opt = SO.get SO.bool fd opt +let setsockopt fd opt v = SO.set SO.bool fd opt v + +let getsockopt_int fd opt = SO.get SO.int fd opt +let setsockopt_int fd opt v = SO.set SO.int fd opt v + +let getsockopt_optint fd opt = SO.get SO.optint fd opt +let setsockopt_optint fd opt v = SO.set SO.optint fd opt v + +let getsockopt_float fd opt = SO.get SO.float fd opt +let setsockopt_float fd opt v = SO.set SO.float fd opt v + +let getsockopt_error fd = SO.get SO.error fd SO_ERROR + +type host_entry = + { h_name : string; + h_aliases : string array; + h_addrtype : socket_domain; + h_addr_list : inet_addr array } + +type protocol_entry = + { p_name : string; + p_aliases : string array; + p_proto : int } + +type service_entry = + { s_name : string; + s_aliases : string array; + s_port : int; + s_proto : string } + +external gethostname : unit -> string = "unix_gethostname" +external gethostbyname : string -> host_entry = "unix_gethostbyname" +external gethostbyaddr : inet_addr -> host_entry = "unix_gethostbyaddr" +external getprotobyname : string -> protocol_entry + = "unix_getprotobyname" +external getprotobynumber : int -> protocol_entry + = "unix_getprotobynumber" +external getservbyname : string -> string -> service_entry + = "unix_getservbyname" +external getservbyport : int -> string -> service_entry + = "unix_getservbyport" + +type addr_info = + { ai_family : socket_domain; + ai_socktype : socket_type; + ai_protocol : int; + ai_addr : sockaddr; + ai_canonname : string } + +type getaddrinfo_option = + AI_FAMILY of socket_domain + | AI_SOCKTYPE of socket_type + | AI_PROTOCOL of int + | AI_NUMERICHOST + | AI_CANONNAME + | AI_PASSIVE + +external getaddrinfo_system + : string -> string -> getaddrinfo_option list -> addr_info list + = "unix_getaddrinfo" + +let getaddrinfo_emulation node service opts = + (* Parse options *) + let opt_socktype = ref None + and opt_protocol = ref 0 + and opt_passive = ref false in + List.iter + (function AI_SOCKTYPE s -> opt_socktype := Some s + | AI_PROTOCOL p -> opt_protocol := p + | AI_PASSIVE -> opt_passive := true + | _ -> ()) + opts; + (* Determine socket types and port numbers *) + let get_port ty kind = + if service = "" then [ty, 0] else + try + [ty, int_of_string service] + with Failure _ -> + try + [ty, (getservbyname service kind).s_port] + with Not_found -> [] + in + let ports = + match !opt_socktype with + | None -> + get_port SOCK_STREAM "tcp" @ get_port SOCK_DGRAM "udp" + | Some SOCK_STREAM -> + get_port SOCK_STREAM "tcp" + | Some SOCK_DGRAM -> + get_port SOCK_DGRAM "udp" + | Some ty -> + if service = "" then [ty, 0] else [] in + (* Determine IP addresses *) + let addresses = + if node = "" then + if List.mem AI_PASSIVE opts + then [inet_addr_any, "0.0.0.0"] + else [inet_addr_loopback, "127.0.0.1"] + else + try + [inet_addr_of_string node, node] + with Failure _ -> + try + let he = gethostbyname node in + List.map + (fun a -> (a, he.h_name)) + (Array.to_list he.h_addr_list) + with Not_found -> + [] in + (* Cross-product of addresses and ports *) + List.flatten + (List.map + (fun (ty, port) -> + List.map + (fun (addr, name) -> + { ai_family = PF_INET; + ai_socktype = ty; + ai_protocol = !opt_protocol; + ai_addr = ADDR_INET(addr, port); + ai_canonname = name }) + addresses) + ports) + +let getaddrinfo node service opts = + try + List.rev(getaddrinfo_system node service opts) + with Invalid_argument _ -> + getaddrinfo_emulation node service opts + +type name_info = + { ni_hostname : string; + ni_service : string } + +type getnameinfo_option = + NI_NOFQDN + | NI_NUMERICHOST + | NI_NAMEREQD + | NI_NUMERICSERV + | NI_DGRAM + +external getnameinfo_system + : sockaddr -> getnameinfo_option list -> name_info + = "unix_getnameinfo" + +let getnameinfo_emulation addr opts = + match addr with + | ADDR_UNIX f -> + { ni_hostname = ""; ni_service = f } (* why not? *) + | ADDR_INET(a, p) -> + let hostname = + try + if List.mem NI_NUMERICHOST opts then raise Not_found; + (gethostbyaddr a).h_name + with Not_found -> + if List.mem NI_NAMEREQD opts then raise Not_found; + string_of_inet_addr a in + let service = + try + if List.mem NI_NUMERICSERV opts then raise Not_found; + let kind = if List.mem NI_DGRAM opts then "udp" else "tcp" in + (getservbyport p kind).s_name + with Not_found -> + string_of_int p in + { ni_hostname = hostname; ni_service = service } + +let getnameinfo addr opts = + try + getnameinfo_system addr opts + with Invalid_argument _ -> + getnameinfo_emulation addr opts + +type terminal_io = { + mutable c_ignbrk: bool; + mutable c_brkint: bool; + mutable c_ignpar: bool; + mutable c_parmrk: bool; + mutable c_inpck: bool; + mutable c_istrip: bool; + mutable c_inlcr: bool; + mutable c_igncr: bool; + mutable c_icrnl: bool; + mutable c_ixon: bool; + mutable c_ixoff: bool; + mutable c_opost: bool; + mutable c_obaud: int; + mutable c_ibaud: int; + mutable c_csize: int; + mutable c_cstopb: int; + mutable c_cread: bool; + mutable c_parenb: bool; + mutable c_parodd: bool; + mutable c_hupcl: bool; + mutable c_clocal: bool; + mutable c_isig: bool; + mutable c_icanon: bool; + mutable c_noflsh: bool; + mutable c_echo: bool; + mutable c_echoe: bool; + mutable c_echok: bool; + mutable c_echonl: bool; + mutable c_vintr: char; + mutable c_vquit: char; + mutable c_verase: char; + mutable c_vkill: char; + mutable c_veof: char; + mutable c_veol: char; + mutable c_vmin: int; + mutable c_vtime: int; + mutable c_vstart: char; + mutable c_vstop: char + } + +external tcgetattr: file_descr -> terminal_io = "unix_tcgetattr" + +type setattr_when = TCSANOW | TCSADRAIN | TCSAFLUSH + +external tcsetattr: file_descr -> setattr_when -> terminal_io -> unit + = "unix_tcsetattr" +external tcsendbreak: file_descr -> int -> unit = "unix_tcsendbreak" +external tcdrain: file_descr -> unit = "unix_tcdrain" + +type flush_queue = TCIFLUSH | TCOFLUSH | TCIOFLUSH + +external tcflush: file_descr -> flush_queue -> unit = "unix_tcflush" + +type flow_action = TCOOFF | TCOON | TCIOFF | TCION + +external tcflow: file_descr -> flow_action -> unit = "unix_tcflow" + +external setsid : unit -> int = "unix_setsid" + +(* High-level process management (system, popen) *) + +let system cmd = + match fork() with + 0 -> begin try + execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |] + with _ -> + exit 127 + end + | id -> snd(waitpid [] id) + +let rec safe_dup fd = + let new_fd = dup fd in + if new_fd >= 3 then + new_fd + else begin + let res = safe_dup fd in + close new_fd; + res + end + +let safe_close fd = + try close fd with Unix_error(_,_,_) -> () + +let perform_redirections new_stdin new_stdout new_stderr = + let newnewstdin = safe_dup new_stdin in + let newnewstdout = safe_dup new_stdout in + let newnewstderr = safe_dup new_stderr in + safe_close new_stdin; + safe_close new_stdout; + safe_close new_stderr; + dup2 newnewstdin stdin; close newnewstdin; + dup2 newnewstdout stdout; close newnewstdout; + dup2 newnewstderr stderr; close newnewstderr + +let create_process cmd args new_stdin new_stdout new_stderr = + match fork() with + 0 -> + begin try + perform_redirections new_stdin new_stdout new_stderr; + execvp cmd args + with _ -> + exit 127 + end + | id -> id + +let create_process_env cmd args env new_stdin new_stdout new_stderr = + match fork() with + 0 -> + begin try + perform_redirections new_stdin new_stdout new_stderr; + execvpe cmd args env + with _ -> + exit 127 + end + | id -> id + +type popen_process = + Process of in_channel * out_channel + | Process_in of in_channel + | Process_out of out_channel + | Process_full of in_channel * out_channel * in_channel + +let popen_processes = (Hashtbl.create 7 : (popen_process, int) Hashtbl.t) + +let open_proc cmd proc input output toclose = + let cloexec = List.for_all try_set_close_on_exec toclose in + match fork() with + 0 -> if input <> stdin then begin dup2 input stdin; close input end; + if output <> stdout then begin dup2 output stdout; close output end; + if not cloexec then List.iter close toclose; + begin try execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |] + with _ -> exit 127 + end + | id -> Hashtbl.add popen_processes proc id + +let open_process_in cmd = + let (in_read, in_write) = pipe() in + let inchan = in_channel_of_descr in_read in + open_proc cmd (Process_in inchan) stdin in_write [in_read]; + close in_write; + inchan + +let open_process_out cmd = + let (out_read, out_write) = pipe() in + let outchan = out_channel_of_descr out_write in + open_proc cmd (Process_out outchan) out_read stdout [out_write]; + close out_read; + outchan + +let open_process cmd = + let (in_read, in_write) = pipe() in + let (out_read, out_write) = pipe() in + let inchan = in_channel_of_descr in_read in + let outchan = out_channel_of_descr out_write in + open_proc cmd (Process(inchan, outchan)) out_read in_write + [in_read; out_write]; + close out_read; + close in_write; + (inchan, outchan) + +let open_proc_full cmd env proc input output error toclose = + let cloexec = List.for_all try_set_close_on_exec toclose in + match fork() with + 0 -> dup2 input stdin; close input; + dup2 output stdout; close output; + dup2 error stderr; close error; + if not cloexec then List.iter close toclose; + begin try execve "/bin/sh" [| "/bin/sh"; "-c"; cmd |] env + with _ -> exit 127 + end + | id -> Hashtbl.add popen_processes proc id + +let open_process_full cmd env = + let (in_read, in_write) = pipe() in + let (out_read, out_write) = pipe() in + let (err_read, err_write) = pipe() in + let inchan = in_channel_of_descr in_read in + let outchan = out_channel_of_descr out_write in + let errchan = in_channel_of_descr err_read in + open_proc_full cmd env (Process_full(inchan, outchan, errchan)) + out_read in_write err_write [in_read; out_write; err_read]; + close out_read; + close in_write; + close err_write; + (inchan, outchan, errchan) + +let find_proc_id fun_name proc = + try + let pid = Hashtbl.find popen_processes proc in + Hashtbl.remove popen_processes proc; + pid + with Not_found -> + raise(Unix_error(EBADF, fun_name, "")) + +let rec waitpid_non_intr pid = + try waitpid [] pid + with Unix_error (EINTR, _, _) -> waitpid_non_intr pid + +let close_process_in inchan = + let pid = find_proc_id "close_process_in" (Process_in inchan) in + close_in inchan; + snd(waitpid_non_intr pid) + +let close_process_out outchan = + let pid = find_proc_id "close_process_out" (Process_out outchan) in + close_out outchan; + snd(waitpid_non_intr pid) + +let close_process (inchan, outchan) = + let pid = find_proc_id "close_process" (Process(inchan, outchan)) in + close_in inchan; + begin try close_out outchan with Sys_error _ -> () end; + snd(waitpid_non_intr pid) + +let close_process_full (inchan, outchan, errchan) = + let pid = + find_proc_id "close_process_full" + (Process_full(inchan, outchan, errchan)) in + close_in inchan; + begin try close_out outchan with Sys_error _ -> () end; + close_in errchan; + snd(waitpid_non_intr pid) + +(* High-level network functions *) + +let open_connection sockaddr = + let sock = + socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in + try + connect sock sockaddr; + ignore(try_set_close_on_exec sock); + (in_channel_of_descr sock, out_channel_of_descr sock) + with exn -> + close sock; raise exn + +let shutdown_connection inchan = + shutdown (descr_of_in_channel inchan) SHUTDOWN_SEND + +let rec accept_non_intr s = + try accept s + with Unix_error (EINTR, _, _) -> accept_non_intr s + +let establish_server server_fun sockaddr = + let sock = + socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in + setsockopt sock SO_REUSEADDR true; + bind sock sockaddr; + listen sock 5; + while true do + let (s, caller) = accept_non_intr sock in + (* The "double fork" trick, the process which calls server_fun will not + leave a zombie process *) + match fork() with + 0 -> if fork() <> 0 then exit 0; (* The son exits, the grandson works *) + close sock; + ignore(try_set_close_on_exec s); + let inchan = in_channel_of_descr s in + let outchan = out_channel_of_descr s in + server_fun inchan outchan; + (* Do not close inchan nor outchan, as the server_fun could + have done it already, and we are about to exit anyway + (PR#3794) *) + exit 0 + | id -> close s; ignore(waitpid_non_intr id) (* Reclaim the son *) + done diff --git a/ocaml-binary-annot/otherlibs/unix/unix.mli b/ocaml-binary-annot/otherlibs/unix/unix.mli new file mode 100644 index 0000000000..0a6fe0885b --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/unix.mli @@ -0,0 +1,1323 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../../LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(** Interface to the Unix system *) + + +(** {6 Error report} *) + + +type error = + E2BIG (** Argument list too long *) + | EACCES (** Permission denied *) + | EAGAIN (** Resource temporarily unavailable; try again *) + | EBADF (** Bad file descriptor *) + | EBUSY (** Resource unavailable *) + | ECHILD (** No child process *) + | EDEADLK (** Resource deadlock would occur *) + | EDOM (** Domain error for math functions, etc. *) + | EEXIST (** File exists *) + | EFAULT (** Bad address *) + | EFBIG (** File too large *) + | EINTR (** Function interrupted by signal *) + | EINVAL (** Invalid argument *) + | EIO (** Hardware I/O error *) + | EISDIR (** Is a directory *) + | EMFILE (** Too many open files by the process *) + | EMLINK (** Too many links *) + | ENAMETOOLONG (** Filename too long *) + | ENFILE (** Too many open files in the system *) + | ENODEV (** No such device *) + | ENOENT (** No such file or directory *) + | ENOEXEC (** Not an executable file *) + | ENOLCK (** No locks available *) + | ENOMEM (** Not enough memory *) + | ENOSPC (** No space left on device *) + | ENOSYS (** Function not supported *) + | ENOTDIR (** Not a directory *) + | ENOTEMPTY (** Directory not empty *) + | ENOTTY (** Inappropriate I/O control operation *) + | ENXIO (** No such device or address *) + | EPERM (** Operation not permitted *) + | EPIPE (** Broken pipe *) + | ERANGE (** Result too large *) + | EROFS (** Read-only file system *) + | ESPIPE (** Invalid seek e.g. on a pipe *) + | ESRCH (** No such process *) + | EXDEV (** Invalid link *) + | EWOULDBLOCK (** Operation would block *) + | EINPROGRESS (** Operation now in progress *) + | EALREADY (** Operation already in progress *) + | ENOTSOCK (** Socket operation on non-socket *) + | EDESTADDRREQ (** Destination address required *) + | EMSGSIZE (** Message too long *) + | EPROTOTYPE (** Protocol wrong type for socket *) + | ENOPROTOOPT (** Protocol not available *) + | EPROTONOSUPPORT (** Protocol not supported *) + | ESOCKTNOSUPPORT (** Socket type not supported *) + | EOPNOTSUPP (** Operation not supported on socket *) + | EPFNOSUPPORT (** Protocol family not supported *) + | EAFNOSUPPORT (** Address family not supported by protocol family *) + | EADDRINUSE (** Address already in use *) + | EADDRNOTAVAIL (** Can't assign requested address *) + | ENETDOWN (** Network is down *) + | ENETUNREACH (** Network is unreachable *) + | ENETRESET (** Network dropped connection on reset *) + | ECONNABORTED (** Software caused connection abort *) + | ECONNRESET (** Connection reset by peer *) + | ENOBUFS (** No buffer space available *) + | EISCONN (** Socket is already connected *) + | ENOTCONN (** Socket is not connected *) + | ESHUTDOWN (** Can't send after socket shutdown *) + | ETOOMANYREFS (** Too many references: can't splice *) + | ETIMEDOUT (** Connection timed out *) + | ECONNREFUSED (** Connection refused *) + | EHOSTDOWN (** Host is down *) + | EHOSTUNREACH (** No route to host *) + | ELOOP (** Too many levels of symbolic links *) + | EOVERFLOW (** File size or position not representable *) + + | EUNKNOWNERR of int (** Unknown error *) +(** The type of error codes. + Errors defined in the POSIX standard + and additional errors from UNIX98 and BSD. + All other errors are mapped to EUNKNOWNERR. +*) + + +exception Unix_error of error * string * string +(** Raised by the system calls below when an error is encountered. + The first component is the error code; the second component + is the function name; the third component is the string parameter + to the function, if it has one, or the empty string otherwise. *) + +val error_message : error -> string +(** Return a string describing the given error code. *) + +val handle_unix_error : ('a -> 'b) -> 'a -> 'b +(** [handle_unix_error f x] applies [f] to [x] and returns the result. + If the exception [Unix_error] is raised, it prints a message + describing the error and exits with code 2. *) + + +(** {6 Access to the process environment} *) + + +val environment : unit -> string array +(** Return the process environment, as an array of strings + with the format ``variable=value''. *) + +val getenv : string -> string +(** Return the value associated to a variable in the process + environment. Raise [Not_found] if the variable is unbound. + (This function is identical to [Sys.getenv].) *) + +val putenv : string -> string -> unit +(** [Unix.putenv name value] sets the value associated to a + variable in the process environment. + [name] is the name of the environment variable, + and [value] its new associated value. *) + + +(** {6 Process handling} *) + + +type process_status = + WEXITED of int + (** The process terminated normally by [exit]; + the argument is the return code. *) + | WSIGNALED of int + (** The process was killed by a signal; + the argument is the signal number. *) + | WSTOPPED of int + (** The process was stopped by a signal; the argument is the + signal number. *) +(** The termination status of a process. See module {!Sys} for the + definitions of the standard signal numbers. Note that they are + not the numbers used by the OS. *) + + +type wait_flag = + WNOHANG (** do not block if no child has + died yet, but immediately return with a pid equal to 0.*) + | WUNTRACED (** report also the children that receive stop signals. *) +(** Flags for {!Unix.waitpid}. *) + +val execv : string -> string array -> 'a +(** [execv prog args] execute the program in file [prog], with + the arguments [args], and the current process environment. + These [execv*] functions never return: on success, the current + program is replaced by the new one; + on failure, a {!Unix.Unix_error} exception is raised. *) + +val execve : string -> string array -> string array -> 'a +(** Same as {!Unix.execv}, except that the third argument provides the + environment to the program executed. *) + +val execvp : string -> string array -> 'a +(** Same as {!Unix.execv}, except that + the program is searched in the path. *) + +val execvpe : string -> string array -> string array -> 'a +(** Same as {!Unix.execve}, except that + the program is searched in the path. *) + +val fork : unit -> int +(** Fork a new process. The returned integer is 0 for the child + process, the pid of the child process for the parent process. *) + +val wait : unit -> int * process_status +(** Wait until one of the children processes die, and return its pid + and termination status. *) + +val waitpid : wait_flag list -> int -> int * process_status +(** Same as {!Unix.wait}, but waits for the child process whose pid is given. + A pid of [-1] means wait for any child. + A pid of [0] means wait for any child in the same process group + as the current process. + Negative pid arguments represent process groups. + The list of options indicates whether [waitpid] should return + immediately without waiting, or also report stopped children. *) + +val system : string -> process_status +(** Execute the given command, wait until it terminates, and return + its termination status. The string is interpreted by the shell + [/bin/sh] and therefore can contain redirections, quotes, variables, + etc. The result [WEXITED 127] indicates that the shell couldn't + be executed. *) + +val getpid : unit -> int +(** Return the pid of the process. *) + +val getppid : unit -> int +(** Return the pid of the parent process. *) + +val nice : int -> int +(** Change the process priority. The integer argument is added to the + ``nice'' value. (Higher values of the ``nice'' value mean + lower priorities.) Return the new nice value. *) + + +(** {6 Basic file input/output} *) + + +type file_descr +(** The abstract type of file descriptors. *) + +val stdin : file_descr +(** File descriptor for standard input.*) + +val stdout : file_descr +(** File descriptor for standard output.*) + +val stderr : file_descr +(** File descriptor for standard error. *) + +type open_flag = + O_RDONLY (** Open for reading *) + | O_WRONLY (** Open for writing *) + | O_RDWR (** Open for reading and writing *) + | O_NONBLOCK (** Open in non-blocking mode *) + | O_APPEND (** Open for append *) + | O_CREAT (** Create if nonexistent *) + | O_TRUNC (** Truncate to 0 length if existing *) + | O_EXCL (** Fail if existing *) + | O_NOCTTY (** Don't make this dev a controlling tty *) + | O_DSYNC (** Writes complete as `Synchronised I/O data integrity completion' *) + | O_SYNC (** Writes complete as `Synchronised I/O file integrity completion' *) + | O_RSYNC (** Reads complete as writes (depending on O_SYNC/O_DSYNC) *) +(** The flags to {!Unix.openfile}. *) + + +type file_perm = int +(** The type of file access rights, e.g. [0o640] is read and write for user, + read for group, none for others *) + +val openfile : string -> open_flag list -> file_perm -> file_descr +(** Open the named file with the given flags. Third argument is + the permissions to give to the file if it is created. Return + a file descriptor on the named file. *) + +val close : file_descr -> unit +(** Close a file descriptor. *) + +val read : file_descr -> string -> int -> int -> int +(** [read fd buff ofs len] reads [len] characters from descriptor + [fd], storing them in string [buff], starting at position [ofs] + in string [buff]. Return the number of characters actually read. *) + +val write : file_descr -> string -> int -> int -> int +(** [write fd buff ofs len] writes [len] characters to descriptor + [fd], taking them from string [buff], starting at position [ofs] + in string [buff]. Return the number of characters actually + written. [write] repeats the writing operation until all characters + have been written or an error occurs. *) + +val single_write : file_descr -> string -> int -> int -> int +(** Same as [write], but attempts to write only once. + Thus, if an error occurs, [single_write] guarantees that no data + has been written. *) + +(** {6 Interfacing with the standard input/output library} *) + + + +val in_channel_of_descr : file_descr -> in_channel +(** Create an input channel reading from the given descriptor. + The channel is initially in binary mode; use + [set_binary_mode_in ic false] if text mode is desired. *) + +val out_channel_of_descr : file_descr -> out_channel +(** Create an output channel writing on the given descriptor. + The channel is initially in binary mode; use + [set_binary_mode_out oc false] if text mode is desired. *) + +val descr_of_in_channel : in_channel -> file_descr +(** Return the descriptor corresponding to an input channel. *) + +val descr_of_out_channel : out_channel -> file_descr +(** Return the descriptor corresponding to an output channel. *) + + +(** {6 Seeking and truncating} *) + + +type seek_command = + SEEK_SET (** indicates positions relative to the beginning of the file *) + | SEEK_CUR (** indicates positions relative to the current position *) + | SEEK_END (** indicates positions relative to the end of the file *) +(** Positioning modes for {!Unix.lseek}. *) + + +val lseek : file_descr -> int -> seek_command -> int +(** Set the current position for a file descriptor *) + +val truncate : string -> int -> unit +(** Truncates the named file to the given size. *) + +val ftruncate : file_descr -> int -> unit +(** Truncates the file corresponding to the given descriptor + to the given size. *) + + +(** {6 File status} *) + + +type file_kind = + S_REG (** Regular file *) + | S_DIR (** Directory *) + | S_CHR (** Character device *) + | S_BLK (** Block device *) + | S_LNK (** Symbolic link *) + | S_FIFO (** Named pipe *) + | S_SOCK (** Socket *) + +type stats = + { st_dev : int; (** Device number *) + st_ino : int; (** Inode number *) + st_kind : file_kind; (** Kind of the file *) + st_perm : file_perm; (** Access rights *) + st_nlink : int; (** Number of links *) + st_uid : int; (** User id of the owner *) + st_gid : int; (** Group ID of the file's group *) + st_rdev : int; (** Device minor number *) + st_size : int; (** Size in bytes *) + st_atime : float; (** Last access time *) + st_mtime : float; (** Last modification time *) + st_ctime : float; (** Last status change time *) + } +(** The information returned by the {!Unix.stat} calls. *) + +val stat : string -> stats +(** Return the information for the named file. *) + +val lstat : string -> stats +(** Same as {!Unix.stat}, but in case the file is a symbolic link, + return the information for the link itself. *) + +val fstat : file_descr -> stats +(** Return the information for the file associated with the given + descriptor. *) + +val isatty : file_descr -> bool +(** Return [true] if the given file descriptor refers to a terminal or + console window, [false] otherwise. *) + +(** {6 File operations on large files} *) + +module LargeFile : + sig + val lseek : file_descr -> int64 -> seek_command -> int64 + val truncate : string -> int64 -> unit + val ftruncate : file_descr -> int64 -> unit + type stats = + { st_dev : int; (** Device number *) + st_ino : int; (** Inode number *) + st_kind : file_kind; (** Kind of the file *) + st_perm : file_perm; (** Access rights *) + st_nlink : int; (** Number of links *) + st_uid : int; (** User id of the owner *) + st_gid : int; (** Group ID of the file's group *) + st_rdev : int; (** Device minor number *) + st_size : int64; (** Size in bytes *) + st_atime : float; (** Last access time *) + st_mtime : float; (** Last modification time *) + st_ctime : float; (** Last status change time *) + } + val stat : string -> stats + val lstat : string -> stats + val fstat : file_descr -> stats + end +(** File operations on large files. + This sub-module provides 64-bit variants of the functions + {!Unix.lseek} (for positioning a file descriptor), + {!Unix.truncate} and {!Unix.ftruncate} (for changing the size of a file), + and {!Unix.stat}, {!Unix.lstat} and {!Unix.fstat} (for obtaining + information on files). 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]. *) + + +(** {6 Operations on file names} *) + + +val unlink : string -> unit +(** Removes the named file *) + +val rename : string -> string -> unit +(** [rename old new] changes the name of a file from [old] to [new]. *) + +val link : string -> string -> unit +(** [link source dest] creates a hard link named [dest] to the file + named [source]. *) + + +(** {6 File permissions and ownership} *) + + +type access_permission = + R_OK (** Read permission *) + | W_OK (** Write permission *) + | X_OK (** Execution permission *) + | F_OK (** File exists *) +(** Flags for the {!Unix.access} call. *) + + +val chmod : string -> file_perm -> unit +(** Change the permissions of the named file. *) + +val fchmod : file_descr -> file_perm -> unit +(** Change the permissions of an opened file. *) + +val chown : string -> int -> int -> unit +(** Change the owner uid and owner gid of the named file. *) + +val fchown : file_descr -> int -> int -> unit +(** Change the owner uid and owner gid of an opened file. *) + +val umask : int -> int +(** Set the process's file mode creation mask, and return the previous + mask. *) + +val access : string -> access_permission list -> unit +(** Check that the process has the given permissions over the named + file. Raise [Unix_error] otherwise. *) + + +(** {6 Operations on file descriptors} *) + + +val dup : file_descr -> file_descr +(** Return a new file descriptor referencing the same file as + the given descriptor. *) + +val dup2 : file_descr -> file_descr -> unit +(** [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already + opened. *) + +val set_nonblock : file_descr -> unit +(** Set the ``non-blocking'' flag on the given descriptor. + When the non-blocking flag is set, reading on a descriptor + on which there is temporarily no data available raises the + [EAGAIN] or [EWOULDBLOCK] error instead of blocking; + writing on a descriptor on which there is temporarily no room + for writing also raises [EAGAIN] or [EWOULDBLOCK]. *) + +val clear_nonblock : file_descr -> unit +(** Clear the ``non-blocking'' flag on the given descriptor. + See {!Unix.set_nonblock}.*) + +val set_close_on_exec : file_descr -> unit +(** Set the ``close-on-exec'' flag on the given descriptor. + A descriptor with the close-on-exec flag is automatically + closed when the current process starts another program with + one of the [exec] functions. *) + +val clear_close_on_exec : file_descr -> unit +(** Clear the ``close-on-exec'' flag on the given descriptor. + See {!Unix.set_close_on_exec}.*) + + +(** {6 Directories} *) + + +val mkdir : string -> file_perm -> unit +(** Create a directory with the given permissions. *) + +val rmdir : string -> unit +(** Remove an empty directory. *) + +val chdir : string -> unit +(** Change the process working directory. *) + +val getcwd : unit -> string +(** Return the name of the current working directory. *) + +val chroot : string -> unit +(** Change the process root directory. *) + +type dir_handle +(** The type of descriptors over opened directories. *) + +val opendir : string -> dir_handle +(** Open a descriptor on a directory *) + +val readdir : dir_handle -> string +(** Return the next entry in a directory. + @raise End_of_file when the end of the directory has been reached. *) + +val rewinddir : dir_handle -> unit +(** Reposition the descriptor to the beginning of the directory *) + +val closedir : dir_handle -> unit +(** Close a directory descriptor. *) + + + +(** {6 Pipes and redirections} *) + + +val pipe : unit -> file_descr * file_descr +(** Create a pipe. The first component of the result is opened + for reading, that's the exit to the pipe. The second component is + opened for writing, that's the entrance to the pipe. *) + +val mkfifo : string -> file_perm -> unit +(** Create a named pipe with the given permissions. *) + + +(** {6 High-level process and redirection management} *) + + +val create_process : + string -> string array -> file_descr -> file_descr -> file_descr -> int +(** [create_process prog args new_stdin new_stdout new_stderr] + forks a new process that executes the program + in file [prog], with arguments [args]. The pid of the new + process is returned immediately; the new process executes + concurrently with the current process. + The standard input and outputs of the new process are connected + to the descriptors [new_stdin], [new_stdout] and [new_stderr]. + Passing e.g. [stdout] for [new_stdout] prevents the redirection + and causes the new process to have the same standard output + as the current process. + The executable file [prog] is searched in the path. + The new process has the same environment as the current process. *) + +val create_process_env : + string -> string array -> string array -> file_descr -> file_descr -> + file_descr -> int +(** [create_process_env prog args env new_stdin new_stdout new_stderr] + works as {!Unix.create_process}, except that the extra argument + [env] specifies the environment passed to the program. *) + + +val open_process_in : string -> in_channel +(** High-level pipe and process management. This function + runs the given command in parallel with the program. + The standard output of the command is redirected to a pipe, + which can be read via the returned input channel. + The command is interpreted by the shell [/bin/sh] (cf. [system]). *) + +val open_process_out : string -> out_channel +(** Same as {!Unix.open_process_in}, but redirect the standard input of + the command to a pipe. Data written to the returned output channel + is sent to the standard input of the command. + Warning: writes on output channels are buffered, hence be careful + to call {!Pervasives.flush} at the right times to ensure + correct synchronization. *) + +val open_process : string -> in_channel * out_channel +(** Same as {!Unix.open_process_out}, but redirects both the standard input + and standard output of the command to pipes connected to the two + returned channels. The input channel is connected to the output + of the command, and the output channel to the input of the command. *) + +val open_process_full : + string -> string array -> in_channel * out_channel * in_channel +(** Similar to {!Unix.open_process}, but the second argument specifies + the environment passed to the command. The result is a triple + of channels connected respectively to the standard output, standard input, + and standard error of the command. *) + +val close_process_in : in_channel -> process_status +(** Close channels opened by {!Unix.open_process_in}, + wait for the associated command to terminate, + and return its termination status. *) + +val close_process_out : out_channel -> process_status +(** Close channels opened by {!Unix.open_process_out}, + wait for the associated command to terminate, + and return its termination status. *) + +val close_process : in_channel * out_channel -> process_status +(** Close channels opened by {!Unix.open_process}, + wait for the associated command to terminate, + and return its termination status. *) + +val close_process_full : + in_channel * out_channel * in_channel -> process_status +(** Close channels opened by {!Unix.open_process_full}, + wait for the associated command to terminate, + and return its termination status. *) + + +(** {6 Symbolic links} *) + + +val symlink : string -> string -> unit +(** [symlink source dest] creates the file [dest] as a symbolic link + to the file [source]. *) + +val readlink : string -> string +(** Read the contents of a link. *) + + +(** {6 Polling} *) + + +val select : + file_descr list -> file_descr list -> file_descr list -> float -> + file_descr list * file_descr list * file_descr list +(** Wait until some input/output operations become possible on + some channels. The three list arguments are, respectively, a set + of descriptors to check for reading (first argument), for writing + (second argument), or for exceptional conditions (third argument). + The fourth argument is the maximal timeout, in seconds; a + negative fourth argument means no timeout (unbounded wait). + The result is composed of three sets of descriptors: those ready + for reading (first component), ready for writing (second component), + and over which an exceptional condition is pending (third + component). *) + +(** {6 Locking} *) + + +type lock_command = + F_ULOCK (** Unlock a region *) + | F_LOCK (** Lock a region for writing, and block if already locked *) + | F_TLOCK (** Lock a region for writing, or fail if already locked *) + | F_TEST (** Test a region for other process locks *) + | F_RLOCK (** Lock a region for reading, and block if already locked *) + | F_TRLOCK (** Lock a region for reading, or fail if already locked *) +(** Commands for {!Unix.lockf}. *) + +val lockf : file_descr -> lock_command -> int -> unit +(** [lockf fd cmd size] puts a lock on a region of the file opened + as [fd]. The region starts at the current read/write position for + [fd] (as set by {!Unix.lseek}), and extends [size] bytes forward if + [size] is positive, [size] bytes backwards if [size] is negative, + or to the end of the file if [size] is zero. + A write lock prevents any other + process from acquiring a read or write lock on the region. + A read lock prevents any other + process from acquiring a write lock on the region, but lets + other processes acquire read locks on it. + + The [F_LOCK] and [F_TLOCK] commands attempts to put a write lock + on the specified region. + The [F_RLOCK] and [F_TRLOCK] commands attempts to put a read lock + on the specified region. + If one or several locks put by another process prevent the current process + from acquiring the lock, [F_LOCK] and [F_RLOCK] block until these locks + are removed, while [F_TLOCK] and [F_TRLOCK] fail immediately with an + exception. + The [F_ULOCK] removes whatever locks the current process has on + the specified region. + Finally, the [F_TEST] command tests whether a write lock can be + acquired on the specified region, without actually putting a lock. + It returns immediately if successful, or fails otherwise. *) + + +(** {6 Signals} + Note: installation of signal handlers is performed via + the functions {!Sys.signal} and {!Sys.set_signal}. +*) + +val kill : int -> int -> unit +(** [kill pid sig] sends signal number [sig] to the process + with id [pid]. *) + +type sigprocmask_command = + SIG_SETMASK + | SIG_BLOCK + | SIG_UNBLOCK + +val sigprocmask : sigprocmask_command -> int list -> int list +(** [sigprocmask cmd sigs] changes the set of blocked signals. + If [cmd] is [SIG_SETMASK], blocked signals are set to those in + the list [sigs]. + If [cmd] is [SIG_BLOCK], the signals in [sigs] are added to + the set of blocked signals. + If [cmd] is [SIG_UNBLOCK], the signals in [sigs] are removed + from the set of blocked signals. + [sigprocmask] returns the set of previously blocked signals. *) + +val sigpending : unit -> int list +(** Return the set of blocked signals that are currently pending. *) + +val sigsuspend : int list -> unit +(** [sigsuspend sigs] atomically sets the blocked signals to [sigs] + and waits for a non-ignored, non-blocked signal to be delivered. + On return, the blocked signals are reset to their initial value. *) + +val pause : unit -> unit +(** Wait until a non-ignored, non-blocked signal is delivered. *) + + +(** {6 Time functions} *) + + +type process_times = + { tms_utime : float; (** User time for the process *) + tms_stime : float; (** System time for the process *) + tms_cutime : float; (** User time for the children processes *) + tms_cstime : float; (** System time for the children processes *) + } +(** The execution times (CPU times) of a process. *) + +type tm = + { tm_sec : int; (** Seconds 0..60 *) + tm_min : int; (** Minutes 0..59 *) + tm_hour : int; (** Hours 0..23 *) + tm_mday : int; (** Day of month 1..31 *) + tm_mon : int; (** Month of year 0..11 *) + tm_year : int; (** Year - 1900 *) + tm_wday : int; (** Day of week (Sunday is 0) *) + tm_yday : int; (** Day of year 0..365 *) + tm_isdst : bool; (** Daylight time savings in effect *) + } +(** The type representing wallclock time and calendar date. *) + + +val time : unit -> float +(** Return the current time since 00:00:00 GMT, Jan. 1, 1970, + in seconds. *) + +val gettimeofday : unit -> float +(** Same as {!Unix.time}, but with resolution better than 1 second. *) + +val gmtime : float -> tm +(** Convert a time in seconds, as returned by {!Unix.time}, into a date and + a time. Assumes UTC (Coordinated Universal Time), also known as GMT. *) + +val localtime : float -> tm +(** Convert a time in seconds, as returned by {!Unix.time}, into a date and + a time. Assumes the local time zone. *) + +val mktime : tm -> float * tm +(** Convert a date and time, specified by the [tm] argument, into + a time in seconds, as returned by {!Unix.time}. The [tm_isdst], + [tm_wday] and [tm_yday] fields of [tm] are ignored. Also return a + normalized copy of the given [tm] record, with the [tm_wday], + [tm_yday], and [tm_isdst] fields recomputed from the other fields, + and the other fields normalized (so that, e.g., 40 October is + changed into 9 November). The [tm] argument is interpreted in the + local time zone. *) + +val alarm : int -> int +(** Schedule a [SIGALRM] signal after the given number of seconds. *) + +val sleep : int -> unit +(** Stop execution for the given number of seconds. *) + +val times : unit -> process_times +(** Return the execution times of the process. *) + +val utimes : string -> float -> float -> unit +(** Set the last access time (second arg) and last modification time + (third arg) for a file. Times are expressed in seconds from + 00:00:00 GMT, Jan. 1, 1970. A time of [0.0] is interpreted as the + current time. *) + +type interval_timer = + ITIMER_REAL + (** decrements in real time, and sends the signal [SIGALRM] when expired.*) + | ITIMER_VIRTUAL + (** decrements in process virtual time, and sends [SIGVTALRM] when expired. *) + | ITIMER_PROF + (** (for profiling) decrements both when the process + is running and when the system is running on behalf of the + process; it sends [SIGPROF] when expired. *) +(** The three kinds of interval timers. *) + +type interval_timer_status = + { it_interval : float; (** Period *) + it_value : float; (** Current value of the timer *) + } +(** The type describing the status of an interval timer *) + +val getitimer : interval_timer -> interval_timer_status +(** Return the current status of the given interval timer. *) + +val setitimer : + interval_timer -> interval_timer_status -> interval_timer_status +(** [setitimer t s] sets the interval timer [t] and returns + its previous status. The [s] argument is interpreted as follows: + [s.it_value], if nonzero, is the time to the next timer expiration; + [s.it_interval], if nonzero, specifies a value to + be used in reloading it_value when the timer expires. + Setting [s.it_value] to zero disable the timer. + Setting [s.it_interval] to zero causes the timer to be disabled + after its next expiration. *) + + +(** {6 User id, group id} *) + + +val getuid : unit -> int +(** Return the user id of the user executing the process. *) + +val geteuid : unit -> int +(** Return the effective user id under which the process runs. *) + +val setuid : int -> unit +(** Set the real user id and effective user id for the process. *) + +val getgid : unit -> int +(** Return the group id of the user executing the process. *) + +val getegid : unit -> int +(** Return the effective group id under which the process runs. *) + +val setgid : int -> unit +(** Set the real group id and effective group id for the process. *) + +val getgroups : unit -> int array +(** Return the list of groups to which the user executing the process + belongs. *) + +val setgroups : int array -> unit + (** [setgroups groups] sets the supplementary group IDs for the + calling process. Appropriate privileges are required. *) + +val initgroups : string -> int -> unit + (** [initgroups user group] initializes the group access list by + reading the group database /etc/group and using all groups of + which [user] is a member. The additional group [group] is also + added to the list. *) + +type passwd_entry = + { pw_name : string; + pw_passwd : string; + pw_uid : int; + pw_gid : int; + pw_gecos : string; + pw_dir : string; + pw_shell : string + } +(** Structure of entries in the [passwd] database. *) + +type group_entry = + { gr_name : string; + gr_passwd : string; + gr_gid : int; + gr_mem : string array + } +(** Structure of entries in the [groups] database. *) + +val getlogin : unit -> string +(** Return the login name of the user executing the process. *) + +val getpwnam : string -> passwd_entry +(** Find an entry in [passwd] with the given name, or raise + [Not_found]. *) + +val getgrnam : string -> group_entry +(** Find an entry in [group] with the given name, or raise + [Not_found]. *) + +val getpwuid : int -> passwd_entry +(** Find an entry in [passwd] with the given user id, or raise + [Not_found]. *) + +val getgrgid : int -> group_entry +(** Find an entry in [group] with the given group id, or raise + [Not_found]. *) + + +(** {6 Internet addresses} *) + + +type inet_addr +(** The abstract type of Internet addresses. *) + +val inet_addr_of_string : string -> inet_addr +(** Conversion from the printable representation of an Internet + address to its internal representation. The argument string + consists of 4 numbers separated by periods ([XXX.YYY.ZZZ.TTT]) + for IPv4 addresses, and up to 8 numbers separated by colons + for IPv6 addresses. Raise [Failure] when given a string that + does not match these formats. *) + +val string_of_inet_addr : inet_addr -> string +(** Return the printable representation of the given Internet address. + See {!Unix.inet_addr_of_string} for a description of the + printable representation. *) + +val inet_addr_any : inet_addr +(** A special IPv4 address, for use only with [bind], representing + all the Internet addresses that the host machine possesses. *) + +val inet_addr_loopback : inet_addr +(** A special IPv4 address representing the host machine ([127.0.0.1]). *) + +val inet6_addr_any : inet_addr +(** A special IPv6 address, for use only with [bind], representing + all the Internet addresses that the host machine possesses. *) + +val inet6_addr_loopback : inet_addr +(** A special IPv6 address representing the host machine ([::1]). *) + + +(** {6 Sockets} *) + + +type socket_domain = + PF_UNIX (** Unix domain *) + | PF_INET (** Internet domain (IPv4) *) + | PF_INET6 (** Internet domain (IPv6) *) +(** The type of socket domains. Not all platforms support + IPv6 sockets (type [PF_INET6]). *) + +type socket_type = + SOCK_STREAM (** Stream socket *) + | SOCK_DGRAM (** Datagram socket *) + | SOCK_RAW (** Raw socket *) + | SOCK_SEQPACKET (** Sequenced packets socket *) +(** The type of socket kinds, specifying the semantics of + communications. *) + +type sockaddr = ADDR_UNIX of string | ADDR_INET of inet_addr * int +(** The type of socket addresses. [ADDR_UNIX name] is a socket + address in the Unix domain; [name] is a file name in the file + system. [ADDR_INET(addr,port)] is a socket address in the Internet + domain; [addr] is the Internet address of the machine, and + [port] is the port number. *) + +val socket : socket_domain -> socket_type -> int -> file_descr +(** Create a new socket in the given domain, and with the + given kind. The third argument is the protocol type; 0 selects + the default protocol for that kind of sockets. *) + +val domain_of_sockaddr: sockaddr -> socket_domain +(** Return the socket domain adequate for the given socket address. *) + +val socketpair : + socket_domain -> socket_type -> int -> file_descr * file_descr +(** Create a pair of unnamed sockets, connected together. *) + +val accept : file_descr -> file_descr * sockaddr +(** Accept connections on the given socket. The returned descriptor + is a socket connected to the client; the returned address is + the address of the connecting client. *) + +val bind : file_descr -> sockaddr -> unit +(** Bind a socket to an address. *) + +val connect : file_descr -> sockaddr -> unit +(** Connect a socket to an address. *) + +val listen : file_descr -> int -> unit +(** Set up a socket for receiving connection requests. The integer + argument is the maximal number of pending requests. *) + +type shutdown_command = + SHUTDOWN_RECEIVE (** Close for receiving *) + | SHUTDOWN_SEND (** Close for sending *) + | SHUTDOWN_ALL (** Close both *) +(** The type of commands for [shutdown]. *) + + +val shutdown : file_descr -> shutdown_command -> unit +(** Shutdown a socket connection. [SHUTDOWN_SEND] as second argument + causes reads on the other end of the connection to return + an end-of-file condition. + [SHUTDOWN_RECEIVE] causes writes on the other end of the connection + to return a closed pipe condition ([SIGPIPE] signal). *) + +val getsockname : file_descr -> sockaddr +(** Return the address of the given socket. *) + +val getpeername : file_descr -> sockaddr +(** Return the address of the host connected to the given socket. *) + +type msg_flag = + MSG_OOB + | MSG_DONTROUTE + | MSG_PEEK +(** The flags for {!Unix.recv}, {!Unix.recvfrom}, + {!Unix.send} and {!Unix.sendto}. *) + +val recv : file_descr -> string -> int -> int -> msg_flag list -> int +(** Receive data from a connected socket. *) + +val recvfrom : + file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr +(** Receive data from an unconnected socket. *) + +val send : file_descr -> string -> int -> int -> msg_flag list -> int +(** Send data over a connected socket. *) + +val sendto : + file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int +(** Send data over an unconnected socket. *) + + + +(** {6 Socket options} *) + + +type socket_bool_option = + SO_DEBUG (** Record debugging information *) + | SO_BROADCAST (** Permit sending of broadcast messages *) + | SO_REUSEADDR (** Allow reuse of local addresses for bind *) + | SO_KEEPALIVE (** Keep connection active *) + | SO_DONTROUTE (** Bypass the standard routing algorithms *) + | SO_OOBINLINE (** Leave out-of-band data in line *) + | SO_ACCEPTCONN (** Report whether socket listening is enabled *) + | TCP_NODELAY (** Control the Nagle algorithm for TCP sockets *) + | IPV6_ONLY (** Forbid binding an IPv6 socket to an IPv4 address *) +(** The socket options that can be consulted with {!Unix.getsockopt} + and modified with {!Unix.setsockopt}. These options have a boolean + ([true]/[false]) value. *) + +type socket_int_option = + SO_SNDBUF (** Size of send buffer *) + | SO_RCVBUF (** Size of received buffer *) + | SO_ERROR (** Deprecated. Use {!Unix.getsockopt_error} instead. *) + | SO_TYPE (** Report the socket type *) + | SO_RCVLOWAT (** Minimum number of bytes to process for input operations *) + | SO_SNDLOWAT (** Minimum number of bytes to process for output operations *) +(** The socket options that can be consulted with {!Unix.getsockopt_int} + and modified with {!Unix.setsockopt_int}. These options have an + integer value. *) + +type socket_optint_option = + SO_LINGER (** Whether to linger on closed connections + that have data present, and for how long + (in seconds) *) +(** The socket options that can be consulted with {!Unix.getsockopt_optint} + and modified with {!Unix.setsockopt_optint}. These options have a + value of type [int option], with [None] meaning ``disabled''. *) + +type socket_float_option = + SO_RCVTIMEO (** Timeout for input operations *) + | SO_SNDTIMEO (** Timeout for output operations *) +(** The socket options that can be consulted with {!Unix.getsockopt_float} + and modified with {!Unix.setsockopt_float}. These options have a + floating-point value representing a time in seconds. + The value 0 means infinite timeout. *) + +val getsockopt : file_descr -> socket_bool_option -> bool +(** Return the current status of a boolean-valued option + in the given socket. *) + +val setsockopt : file_descr -> socket_bool_option -> bool -> unit +(** Set or clear a boolean-valued option in the given socket. *) + +val getsockopt_int : file_descr -> socket_int_option -> int +(** Same as {!Unix.getsockopt} for an integer-valued socket option. *) + +val setsockopt_int : file_descr -> socket_int_option -> int -> unit +(** Same as {!Unix.setsockopt} for an integer-valued socket option. *) + +val getsockopt_optint : file_descr -> socket_optint_option -> int option +(** Same as {!Unix.getsockopt} for a socket option whose value is an [int option]. *) + +val setsockopt_optint : + file_descr -> socket_optint_option -> int option -> unit +(** Same as {!Unix.setsockopt} for a socket option whose value is an [int option]. *) + +val getsockopt_float : file_descr -> socket_float_option -> float +(** Same as {!Unix.getsockopt} for a socket option whose value is a floating-point number. *) + +val setsockopt_float : file_descr -> socket_float_option -> float -> unit +(** Same as {!Unix.setsockopt} for a socket option whose value is a floating-point number. *) + +val getsockopt_error : file_descr -> error option +(** Return the error condition associated with the given socket, + and clear it. *) + +(** {6 High-level network connection functions} *) + + +val open_connection : sockaddr -> in_channel * out_channel +(** Connect to a server at the given address. + Return a pair of buffered channels connected to the server. + Remember to call {!Pervasives.flush} on the output channel at the right + times to ensure correct synchronization. *) + +val shutdown_connection : in_channel -> unit +(** ``Shut down'' a connection established with {!Unix.open_connection}; + that is, transmit an end-of-file condition to the server reading + on the other side of the connection. *) + +val establish_server : (in_channel -> out_channel -> unit) -> sockaddr -> unit +(** Establish a server on the given address. + The function given as first argument is called for each connection + with two buffered channels connected to the client. A new process + is created for each connection. The function {!Unix.establish_server} + never returns normally. *) + + +(** {6 Host and protocol databases} *) + + +type host_entry = + { h_name : string; + h_aliases : string array; + h_addrtype : socket_domain; + h_addr_list : inet_addr array + } +(** Structure of entries in the [hosts] database. *) + +type protocol_entry = + { p_name : string; + p_aliases : string array; + p_proto : int + } +(** Structure of entries in the [protocols] database. *) + +type service_entry = + { s_name : string; + s_aliases : string array; + s_port : int; + s_proto : string + } +(** Structure of entries in the [services] database. *) + +val gethostname : unit -> string +(** Return the name of the local host. *) + +val gethostbyname : string -> host_entry +(** Find an entry in [hosts] with the given name, or raise + [Not_found]. *) + +val gethostbyaddr : inet_addr -> host_entry +(** Find an entry in [hosts] with the given address, or raise + [Not_found]. *) + +val getprotobyname : string -> protocol_entry +(** Find an entry in [protocols] with the given name, or raise + [Not_found]. *) + +val getprotobynumber : int -> protocol_entry +(** Find an entry in [protocols] with the given protocol number, + or raise [Not_found]. *) + +val getservbyname : string -> string -> service_entry +(** Find an entry in [services] with the given name, or raise + [Not_found]. *) + +val getservbyport : int -> string -> service_entry +(** Find an entry in [services] with the given service number, + or raise [Not_found]. *) + +type addr_info = + { ai_family : socket_domain; (** Socket domain *) + ai_socktype : socket_type; (** Socket type *) + ai_protocol : int; (** Socket protocol number *) + ai_addr : sockaddr; (** Address *) + ai_canonname : string (** Canonical host name *) + } +(** Address information returned by {!Unix.getaddrinfo}. *) + +type getaddrinfo_option = + AI_FAMILY of socket_domain (** Impose the given socket domain *) + | AI_SOCKTYPE of socket_type (** Impose the given socket type *) + | AI_PROTOCOL of int (** Impose the given protocol *) + | AI_NUMERICHOST (** Do not call name resolver, + expect numeric IP address *) + | AI_CANONNAME (** Fill the [ai_canonname] field + of the result *) + | AI_PASSIVE (** Set address to ``any'' address + for use with {!Unix.bind} *) +(** Options to {!Unix.getaddrinfo}. *) + +val getaddrinfo: + string -> string -> getaddrinfo_option list -> addr_info list +(** [getaddrinfo host service opts] returns a list of {!Unix.addr_info} + records describing socket parameters and addresses suitable for + communicating with the given host and service. The empty list is + returned if the host or service names are unknown, or the constraints + expressed in [opts] cannot be satisfied. + + [host] is either a host name or the string representation of an IP + address. [host] can be given as the empty string; in this case, + the ``any'' address or the ``loopback'' address are used, + depending whether [opts] contains [AI_PASSIVE]. + [service] is either a service name or the string representation of + a port number. [service] can be given as the empty string; + in this case, the port field of the returned addresses is set to 0. + [opts] is a possibly empty list of options that allows the caller + to force a particular socket domain (e.g. IPv6 only or IPv4 only) + or a particular socket type (e.g. TCP only or UDP only). *) + +type name_info = + { ni_hostname : string; (** Name or IP address of host *) + ni_service : string } (** Name of service or port number *) +(** Host and service information returned by {!Unix.getnameinfo}. *) + +type getnameinfo_option = + NI_NOFQDN (** Do not qualify local host names *) + | NI_NUMERICHOST (** Always return host as IP address *) + | NI_NAMEREQD (** Fail if host name cannot be determined *) + | NI_NUMERICSERV (** Always return service as port number *) + | NI_DGRAM (** Consider the service as UDP-based + instead of the default TCP *) +(** Options to {!Unix.getnameinfo}. *) + +val getnameinfo : sockaddr -> getnameinfo_option list -> name_info +(** [getnameinfo addr opts] returns the host name and service name + corresponding to the socket address [addr]. [opts] is a possibly + empty list of options that governs how these names are obtained. + Raise [Not_found] if an error occurs. *) + + +(** {6 Terminal interface} *) + + +(** The following functions implement the POSIX standard terminal + interface. They provide control over asynchronous communication ports + and pseudo-terminals. Refer to the [termios] man page for a + complete description. *) + +type terminal_io = + { + (* input modes *) + mutable c_ignbrk : bool; (** Ignore the break condition. *) + mutable c_brkint : bool; (** Signal interrupt on break condition. *) + mutable c_ignpar : bool; (** Ignore characters with parity errors. *) + mutable c_parmrk : bool; (** Mark parity errors. *) + mutable c_inpck : bool; (** Enable parity check on input. *) + mutable c_istrip : bool; (** Strip 8th bit on input characters. *) + mutable c_inlcr : bool; (** Map NL to CR on input. *) + mutable c_igncr : bool; (** Ignore CR on input. *) + mutable c_icrnl : bool; (** Map CR to NL on input. *) + mutable c_ixon : bool; (** Recognize XON/XOFF characters on input. *) + mutable c_ixoff : bool; (** Emit XON/XOFF chars to control input flow. *) + (* Output modes: *) + mutable c_opost : bool; (** Enable output processing. *) + (* Control modes: *) + mutable c_obaud : int; (** Output baud rate (0 means close connection).*) + mutable c_ibaud : int; (** Input baud rate. *) + mutable c_csize : int; (** Number of bits per character (5-8). *) + mutable c_cstopb : int; (** Number of stop bits (1-2). *) + mutable c_cread : bool; (** Reception is enabled. *) + mutable c_parenb : bool; (** Enable parity generation and detection. *) + mutable c_parodd : bool; (** Specify odd parity instead of even. *) + mutable c_hupcl : bool; (** Hang up on last close. *) + mutable c_clocal : bool; (** Ignore modem status lines. *) + (* Local modes: *) + mutable c_isig : bool; (** Generate signal on INTR, QUIT, SUSP. *) + mutable c_icanon : bool; (** Enable canonical processing + (line buffering and editing) *) + mutable c_noflsh : bool; (** Disable flush after INTR, QUIT, SUSP. *) + mutable c_echo : bool; (** Echo input characters. *) + mutable c_echoe : bool; (** Echo ERASE (to erase previous character). *) + mutable c_echok : bool; (** Echo KILL (to erase the current line). *) + mutable c_echonl : bool; (** Echo NL even if c_echo is not set. *) + (* Control characters: *) + mutable c_vintr : char; (** Interrupt character (usually ctrl-C). *) + mutable c_vquit : char; (** Quit character (usually ctrl-\). *) + mutable c_verase : char; (** Erase character (usually DEL or ctrl-H). *) + mutable c_vkill : char; (** Kill line character (usually ctrl-U). *) + mutable c_veof : char; (** End-of-file character (usually ctrl-D). *) + mutable c_veol : char; (** Alternate end-of-line char. (usually none). *) + mutable c_vmin : int; (** Minimum number of characters to read + before the read request is satisfied. *) + mutable c_vtime : int; (** Maximum read wait (in 0.1s units). *) + mutable c_vstart : char; (** Start character (usually ctrl-Q). *) + mutable c_vstop : char; (** Stop character (usually ctrl-S). *) + } + +val tcgetattr : file_descr -> terminal_io +(** Return the status of the terminal referred to by the given + file descriptor. *) + +type setattr_when = + TCSANOW + | TCSADRAIN + | TCSAFLUSH + +val tcsetattr : file_descr -> setattr_when -> terminal_io -> unit +(** Set the status of the terminal referred to by the given + file descriptor. The second argument indicates when the + status change takes place: immediately ([TCSANOW]), + when all pending output has been transmitted ([TCSADRAIN]), + or after flushing all input that has been received but not + read ([TCSAFLUSH]). [TCSADRAIN] is recommended when changing + the output parameters; [TCSAFLUSH], when changing the input + parameters. *) + +val tcsendbreak : file_descr -> int -> unit +(** Send a break condition on the given file descriptor. + The second argument is the duration of the break, in 0.1s units; + 0 means standard duration (0.25s). *) + +val tcdrain : file_descr -> unit +(** Waits until all output written on the given file descriptor + has been transmitted. *) + +type flush_queue = + TCIFLUSH + | TCOFLUSH + | TCIOFLUSH + +val tcflush : file_descr -> flush_queue -> unit +(** Discard data written on the given file descriptor but not yet + transmitted, or data received but not yet read, depending on the + second argument: [TCIFLUSH] flushes data received but not read, + [TCOFLUSH] flushes data written but not transmitted, and + [TCIOFLUSH] flushes both. *) + +type flow_action = + TCOOFF + | TCOON + | TCIOFF + | TCION + +val tcflow : file_descr -> flow_action -> unit +(** Suspend or restart reception or transmission of data on + the given file descriptor, depending on the second argument: + [TCOOFF] suspends output, [TCOON] restarts output, + [TCIOFF] transmits a STOP character to suspend input, + and [TCION] transmits a START character to restart input. *) + +val setsid : unit -> int +(** Put the calling process in a new session and detach it from + its controlling terminal. *) diff --git a/ocaml-binary-annot/otherlibs/unix/unix.mllib b/ocaml-binary-annot/otherlibs/unix/unix.mllib new file mode 100644 index 0000000000..8d569c56d0 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/unix.mllib @@ -0,0 +1 @@ +Unix UnixLabels diff --git a/ocaml-binary-annot/otherlibs/unix/unixLabels.ml b/ocaml-binary-annot/otherlibs/unix/unixLabels.ml new file mode 100644 index 0000000000..683f15ec67 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/unixLabels.ml @@ -0,0 +1,18 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Jacques Garrigue, Kyoto University RIMS *) +(* *) +(* Copyright 2001 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../../LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [UnixLabels]: labelled Unix module *) + +include Unix diff --git a/ocaml-binary-annot/otherlibs/unix/unixLabels.mli b/ocaml-binary-annot/otherlibs/unix/unixLabels.mli new file mode 100644 index 0000000000..92921252ca --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/unixLabels.mli @@ -0,0 +1,1324 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU Library General Public License, with *) +(* the special exception on linking described in file ../../LICENSE. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(** Interface to the Unix system. + To use as replacement to default {!Unix} module, + add [module Unix = UnixLabels] in your implementation. +*) + +(** {6 Error report} *) + + +type error = Unix.error = + E2BIG (** Argument list too long *) + | EACCES (** Permission denied *) + | EAGAIN (** Resource temporarily unavailable; try again *) + | EBADF (** Bad file descriptor *) + | EBUSY (** Resource unavailable *) + | ECHILD (** No child process *) + | EDEADLK (** Resource deadlock would occur *) + | EDOM (** Domain error for math functions, etc. *) + | EEXIST (** File exists *) + | EFAULT (** Bad address *) + | EFBIG (** File too large *) + | EINTR (** Function interrupted by signal *) + | EINVAL (** Invalid argument *) + | EIO (** Hardware I/O error *) + | EISDIR (** Is a directory *) + | EMFILE (** Too many open files by the process *) + | EMLINK (** Too many links *) + | ENAMETOOLONG (** Filename too long *) + | ENFILE (** Too many open files in the system *) + | ENODEV (** No such device *) + | ENOENT (** No such file or directory *) + | ENOEXEC (** Not an executable file *) + | ENOLCK (** No locks available *) + | ENOMEM (** Not enough memory *) + | ENOSPC (** No space left on device *) + | ENOSYS (** Function not supported *) + | ENOTDIR (** Not a directory *) + | ENOTEMPTY (** Directory not empty *) + | ENOTTY (** Inappropriate I/O control operation *) + | ENXIO (** No such device or address *) + | EPERM (** Operation not permitted *) + | EPIPE (** Broken pipe *) + | ERANGE (** Result too large *) + | EROFS (** Read-only file system *) + | ESPIPE (** Invalid seek e.g. on a pipe *) + | ESRCH (** No such process *) + | EXDEV (** Invalid link *) + | EWOULDBLOCK (** Operation would block *) + | EINPROGRESS (** Operation now in progress *) + | EALREADY (** Operation already in progress *) + | ENOTSOCK (** Socket operation on non-socket *) + | EDESTADDRREQ (** Destination address required *) + | EMSGSIZE (** Message too long *) + | EPROTOTYPE (** Protocol wrong type for socket *) + | ENOPROTOOPT (** Protocol not available *) + | EPROTONOSUPPORT (** Protocol not supported *) + | ESOCKTNOSUPPORT (** Socket type not supported *) + | EOPNOTSUPP (** Operation not supported on socket *) + | EPFNOSUPPORT (** Protocol family not supported *) + | EAFNOSUPPORT (** Address family not supported by protocol family *) + | EADDRINUSE (** Address already in use *) + | EADDRNOTAVAIL (** Can't assign requested address *) + | ENETDOWN (** Network is down *) + | ENETUNREACH (** Network is unreachable *) + | ENETRESET (** Network dropped connection on reset *) + | ECONNABORTED (** Software caused connection abort *) + | ECONNRESET (** Connection reset by peer *) + | ENOBUFS (** No buffer space available *) + | EISCONN (** Socket is already connected *) + | ENOTCONN (** Socket is not connected *) + | ESHUTDOWN (** Can't send after socket shutdown *) + | ETOOMANYREFS (** Too many references: can't splice *) + | ETIMEDOUT (** Connection timed out *) + | ECONNREFUSED (** Connection refused *) + | EHOSTDOWN (** Host is down *) + | EHOSTUNREACH (** No route to host *) + | ELOOP (** Too many levels of symbolic links *) + | EOVERFLOW (** File size or position not representable *) + + | EUNKNOWNERR of int (** Unknown error *) +(** The type of error codes. + Errors defined in the POSIX standard + and additional errors from UNIX98 and BSD. + All other errors are mapped to EUNKNOWNERR. +*) + + +exception Unix_error of error * string * string +(** Raised by the system calls below when an error is encountered. + The first component is the error code; the second component + is the function name; the third component is the string parameter + to the function, if it has one, or the empty string otherwise. *) + +val error_message : error -> string +(** Return a string describing the given error code. *) + +val handle_unix_error : ('a -> 'b) -> 'a -> 'b +(** [handle_unix_error f x] applies [f] to [x] and returns the result. + If the exception [Unix_error] is raised, it prints a message + describing the error and exits with code 2. *) + + +(** {6 Access to the process environment} *) + + +val environment : unit -> string array +(** Return the process environment, as an array of strings + with the format ``variable=value''. *) + +val getenv : string -> string +(** Return the value associated to a variable in the process + environment. Raise [Not_found] if the variable is unbound. + (This function is identical to [Sys.getenv].) *) + +val putenv : string -> string -> unit +(** [Unix.putenv name value] sets the value associated to a + variable in the process environment. + [name] is the name of the environment variable, + and [value] its new associated value. *) + + +(** {6 Process handling} *) + + +type process_status = Unix.process_status = + WEXITED of int + (** The process terminated normally by [exit]; + the argument is the return code. *) + | WSIGNALED of int + (** The process was killed by a signal; + the argument is the signal number. *) + | WSTOPPED of int + (** The process was stopped by a signal; the argument is the + signal number. *) +(** The termination status of a process. *) + + +type wait_flag = Unix.wait_flag = + WNOHANG (** do not block if no child has + died yet, but immediately return with a pid equal to 0.*) + | WUNTRACED (** report also the children that receive stop signals. *) +(** Flags for {!UnixLabels.waitpid}. *) + +val execv : prog:string -> args:string array -> 'a +(** [execv prog args] execute the program in file [prog], with + the arguments [args], and the current process environment. + These [execv*] functions never return: on success, the current + program is replaced by the new one; + on failure, a {!UnixLabels.Unix_error} exception is raised. *) + +val execve : prog:string -> args:string array -> env:string array -> 'a +(** Same as {!UnixLabels.execv}, except that the third argument provides the + environment to the program executed. *) + +val execvp : prog:string -> args:string array -> 'a +(** Same as {!UnixLabels.execv} respectively, except that + the program is searched in the path. *) + +val execvpe : prog:string -> args:string array -> env:string array -> 'a +(** Same as {!UnixLabels.execvp} respectively, except that + the program is searched in the path. *) + +val fork : unit -> int +(** Fork a new process. The returned integer is 0 for the child + process, the pid of the child process for the parent process. *) + +val wait : unit -> int * process_status +(** Wait until one of the children processes die, and return its pid + and termination status. *) + +val waitpid : mode:wait_flag list -> int -> int * process_status +(** Same as {!UnixLabels.wait}, but waits for the process whose pid is given. + A pid of [-1] means wait for any child. + A pid of [0] means wait for any child in the same process group + as the current process. + Negative pid arguments represent process groups. + The list of options indicates whether [waitpid] should return + immediately without waiting, or also report stopped children. *) + +val system : string -> process_status +(** Execute the given command, wait until it terminates, and return + its termination status. The string is interpreted by the shell + [/bin/sh] and therefore can contain redirections, quotes, variables, + etc. The result [WEXITED 127] indicates that the shell couldn't + be executed. *) + +val getpid : unit -> int +(** Return the pid of the process. *) + +val getppid : unit -> int +(** Return the pid of the parent process. *) + +val nice : int -> int +(** Change the process priority. The integer argument is added to the + ``nice'' value. (Higher values of the ``nice'' value mean + lower priorities.) Return the new nice value. *) + + +(** {6 Basic file input/output} *) + + +type file_descr = Unix.file_descr +(** The abstract type of file descriptors. *) + +val stdin : file_descr +(** File descriptor for standard input.*) + +val stdout : file_descr +(** File descriptor for standard output.*) + +val stderr : file_descr +(** File descriptor for standard error. *) + +type open_flag = Unix.open_flag = + O_RDONLY (** Open for reading *) + | O_WRONLY (** Open for writing *) + | O_RDWR (** Open for reading and writing *) + | O_NONBLOCK (** Open in non-blocking mode *) + | O_APPEND (** Open for append *) + | O_CREAT (** Create if nonexistent *) + | O_TRUNC (** Truncate to 0 length if existing *) + | O_EXCL (** Fail if existing *) + | O_NOCTTY (** Don't make this dev a controlling tty *) + | O_DSYNC (** Writes complete as `Synchronised I/O data integrity completion' *) + | O_SYNC (** Writes complete as `Synchronised I/O file integrity completion' *) + | O_RSYNC (** Reads complete as writes (depending on O_SYNC/O_DSYNC) *) +(** The flags to {!UnixLabels.openfile}. *) + + +type file_perm = int +(** The type of file access rights, e.g. [0o640] is read and write for user, + read for group, none for others *) + +val openfile : string -> mode:open_flag list -> perm:file_perm -> file_descr +(** Open the named file with the given flags. Third argument is + the permissions to give to the file if it is created. Return + a file descriptor on the named file. *) + +val close : file_descr -> unit +(** Close a file descriptor. *) + +val read : file_descr -> buf:string -> pos:int -> len:int -> int +(** [read fd buff ofs len] reads [len] characters from descriptor + [fd], storing them in string [buff], starting at position [ofs] + in string [buff]. Return the number of characters actually read. *) + +val write : file_descr -> buf:string -> pos:int -> len:int -> int +(** [write fd buff ofs len] writes [len] characters to descriptor + [fd], taking them from string [buff], starting at position [ofs] + in string [buff]. Return the number of characters actually + written. [write] repeats the writing operation until all characters + have been written or an error occurs. *) + +val single_write : file_descr -> buf:string -> pos:int -> len:int -> int +(** Same as [write], but attempts to write only once. + Thus, if an error occurs, [single_write] guarantees that no data + has been written. *) + +(** {6 Interfacing with the standard input/output library} *) + + + +val in_channel_of_descr : file_descr -> in_channel +(** Create an input channel reading from the given descriptor. + The channel is initially in binary mode; use + [set_binary_mode_in ic false] if text mode is desired. *) + +val out_channel_of_descr : file_descr -> out_channel +(** Create an output channel writing on the given descriptor. + The channel is initially in binary mode; use + [set_binary_mode_out oc false] if text mode is desired. *) + +val descr_of_in_channel : in_channel -> file_descr +(** Return the descriptor corresponding to an input channel. *) + +val descr_of_out_channel : out_channel -> file_descr +(** Return the descriptor corresponding to an output channel. *) + + +(** {6 Seeking and truncating} *) + + +type seek_command = Unix.seek_command = + SEEK_SET (** indicates positions relative to the beginning of the file *) + | SEEK_CUR (** indicates positions relative to the current position *) + | SEEK_END (** indicates positions relative to the end of the file *) +(** Positioning modes for {!UnixLabels.lseek}. *) + + +val lseek : file_descr -> int -> mode:seek_command -> int +(** Set the current position for a file descriptor *) + +val truncate : string -> len:int -> unit +(** Truncates the named file to the given size. *) + +val ftruncate : file_descr -> len:int -> unit +(** Truncates the file corresponding to the given descriptor + to the given size. *) + + +(** {6 File status} *) + + +type file_kind = Unix.file_kind = + S_REG (** Regular file *) + | S_DIR (** Directory *) + | S_CHR (** Character device *) + | S_BLK (** Block device *) + | S_LNK (** Symbolic link *) + | S_FIFO (** Named pipe *) + | S_SOCK (** Socket *) + +type stats = Unix.stats = + { st_dev : int; (** Device number *) + st_ino : int; (** Inode number *) + st_kind : file_kind; (** Kind of the file *) + st_perm : file_perm; (** Access rights *) + st_nlink : int; (** Number of links *) + st_uid : int; (** User id of the owner *) + st_gid : int; (** Group ID of the file's group *) + st_rdev : int; (** Device minor number *) + st_size : int; (** Size in bytes *) + st_atime : float; (** Last access time *) + st_mtime : float; (** Last modification time *) + st_ctime : float; (** Last status change time *) + } +(** The information returned by the {!UnixLabels.stat} calls. *) + +val stat : string -> stats +(** Return the information for the named file. *) + +val lstat : string -> stats +(** Same as {!UnixLabels.stat}, but in case the file is a symbolic link, + return the information for the link itself. *) + +val fstat : file_descr -> stats +(** Return the information for the file associated with the given + descriptor. *) + +val isatty : file_descr -> bool +(** Return [true] if the given file descriptor refers to a terminal or + console window, [false] otherwise. *) + +(** {6 File operations on large files} *) + +module LargeFile : + sig + val lseek : file_descr -> int64 -> mode:seek_command -> int64 + val truncate : string -> len:int64 -> unit + val ftruncate : file_descr -> len:int64 -> unit + type stats = Unix.LargeFile.stats = + { st_dev : int; (** Device number *) + st_ino : int; (** Inode number *) + st_kind : file_kind; (** Kind of the file *) + st_perm : file_perm; (** Access rights *) + st_nlink : int; (** Number of links *) + st_uid : int; (** User id of the owner *) + st_gid : int; (** Group ID of the file's group *) + st_rdev : int; (** Device minor number *) + st_size : int64; (** Size in bytes *) + st_atime : float; (** Last access time *) + st_mtime : float; (** Last modification time *) + st_ctime : float; (** Last status change time *) + } + val stat : string -> stats + val lstat : string -> stats + val fstat : file_descr -> stats + end +(** File operations on large files. + This sub-module provides 64-bit variants of the functions + {!UnixLabels.lseek} (for positioning a file descriptor), + {!UnixLabels.truncate} and {!UnixLabels.ftruncate} + (for changing the size of a file), + and {!UnixLabels.stat}, {!UnixLabels.lstat} and {!UnixLabels.fstat} + (for obtaining information on files). 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]. *) + + +(** {6 Operations on file names} *) + + +val unlink : string -> unit +(** Removes the named file *) + +val rename : src:string -> dst:string -> unit +(** [rename old new] changes the name of a file from [old] to [new]. *) + +val link : src:string -> dst:string -> unit +(** [link source dest] creates a hard link named [dest] to the file + named [source]. *) + + +(** {6 File permissions and ownership} *) + + +type access_permission = Unix.access_permission = + R_OK (** Read permission *) + | W_OK (** Write permission *) + | X_OK (** Execution permission *) + | F_OK (** File exists *) +(** Flags for the {!UnixLabels.access} call. *) + + +val chmod : string -> perm:file_perm -> unit +(** Change the permissions of the named file. *) + +val fchmod : file_descr -> perm:file_perm -> unit +(** Change the permissions of an opened file. *) + +val chown : string -> uid:int -> gid:int -> unit +(** Change the owner uid and owner gid of the named file. *) + +val fchown : file_descr -> uid:int -> gid:int -> unit +(** Change the owner uid and owner gid of an opened file. *) + +val umask : int -> int +(** Set the process's file mode creation mask, and return the previous + mask. *) + +val access : string -> perm:access_permission list -> unit +(** Check that the process has the given permissions over the named + file. Raise [Unix_error] otherwise. *) + + +(** {6 Operations on file descriptors} *) + + +val dup : file_descr -> file_descr +(** Return a new file descriptor referencing the same file as + the given descriptor. *) + +val dup2 : src:file_descr -> dst:file_descr -> unit +(** [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already + opened. *) + +val set_nonblock : file_descr -> unit +(** Set the ``non-blocking'' flag on the given descriptor. + When the non-blocking flag is set, reading on a descriptor + on which there is temporarily no data available raises the + [EAGAIN] or [EWOULDBLOCK] error instead of blocking; + writing on a descriptor on which there is temporarily no room + for writing also raises [EAGAIN] or [EWOULDBLOCK]. *) + +val clear_nonblock : file_descr -> unit +(** Clear the ``non-blocking'' flag on the given descriptor. + See {!UnixLabels.set_nonblock}.*) + +val set_close_on_exec : file_descr -> unit +(** Set the ``close-on-exec'' flag on the given descriptor. + A descriptor with the close-on-exec flag is automatically + closed when the current process starts another program with + one of the [exec] functions. *) + +val clear_close_on_exec : file_descr -> unit +(** Clear the ``close-on-exec'' flag on the given descriptor. + See {!UnixLabels.set_close_on_exec}.*) + + + +(** {6 Directories} *) + + +val mkdir : string -> perm:file_perm -> unit +(** Create a directory with the given permissions. *) + +val rmdir : string -> unit +(** Remove an empty directory. *) + +val chdir : string -> unit +(** Change the process working directory. *) + +val getcwd : unit -> string +(** Return the name of the current working directory. *) + +val chroot : string -> unit +(** Change the process root directory. *) + +type dir_handle = Unix.dir_handle +(** The type of descriptors over opened directories. *) + +val opendir : string -> dir_handle +(** Open a descriptor on a directory *) + +val readdir : dir_handle -> string +(** Return the next entry in a directory. + @raise End_of_file when the end of the directory has been reached. *) + +val rewinddir : dir_handle -> unit +(** Reposition the descriptor to the beginning of the directory *) + +val closedir : dir_handle -> unit +(** Close a directory descriptor. *) + + + +(** {6 Pipes and redirections} *) + + +val pipe : unit -> file_descr * file_descr +(** Create a pipe. The first component of the result is opened + for reading, that's the exit to the pipe. The second component is + opened for writing, that's the entrance to the pipe. *) + +val mkfifo : string -> perm:file_perm -> unit +(** Create a named pipe with the given permissions. *) + + +(** {6 High-level process and redirection management} *) + + +val create_process : + prog:string -> args:string array -> stdin:file_descr -> stdout:file_descr -> + stderr:file_descr -> int +(** [create_process prog args new_stdin new_stdout new_stderr] + forks a new process that executes the program + in file [prog], with arguments [args]. The pid of the new + process is returned immediately; the new process executes + concurrently with the current process. + The standard input and outputs of the new process are connected + to the descriptors [new_stdin], [new_stdout] and [new_stderr]. + Passing e.g. [stdout] for [new_stdout] prevents the redirection + and causes the new process to have the same standard output + as the current process. + The executable file [prog] is searched in the path. + The new process has the same environment as the current process. *) + +val create_process_env : + prog:string -> args:string array -> env:string array -> stdin:file_descr -> + stdout:file_descr -> stderr:file_descr -> int +(** [create_process_env prog args env new_stdin new_stdout new_stderr] + works as {!UnixLabels.create_process}, except that the extra argument + [env] specifies the environment passed to the program. *) + + +val open_process_in : string -> in_channel +(** High-level pipe and process management. This function + runs the given command in parallel with the program. + The standard output of the command is redirected to a pipe, + which can be read via the returned input channel. + The command is interpreted by the shell [/bin/sh] (cf. [system]). *) + +val open_process_out : string -> out_channel +(** Same as {!UnixLabels.open_process_in}, but redirect the standard input of + the command to a pipe. Data written to the returned output channel + is sent to the standard input of the command. + Warning: writes on output channels are buffered, hence be careful + to call {!Pervasives.flush} at the right times to ensure + correct synchronization. *) + +val open_process : string -> in_channel * out_channel +(** Same as {!UnixLabels.open_process_out}, but redirects both the standard + input and standard output of the command to pipes connected to the two + returned channels. The input channel is connected to the output + of the command, and the output channel to the input of the command. *) + +val open_process_full : + string -> env:string array -> in_channel * out_channel * in_channel +(** Similar to {!UnixLabels.open_process}, but the second argument specifies + the environment passed to the command. The result is a triple + of channels connected respectively to the standard output, standard input, + and standard error of the command. *) + +val close_process_in : in_channel -> process_status +(** Close channels opened by {!UnixLabels.open_process_in}, + wait for the associated command to terminate, + and return its termination status. *) + +val close_process_out : out_channel -> process_status +(** Close channels opened by {!UnixLabels.open_process_out}, + wait for the associated command to terminate, + and return its termination status. *) + +val close_process : in_channel * out_channel -> process_status +(** Close channels opened by {!UnixLabels.open_process}, + wait for the associated command to terminate, + and return its termination status. *) + +val close_process_full : + in_channel * out_channel * in_channel -> process_status +(** Close channels opened by {!UnixLabels.open_process_full}, + wait for the associated command to terminate, + and return its termination status. *) + + +(** {6 Symbolic links} *) + + +val symlink : src:string -> dst:string -> unit +(** [symlink source dest] creates the file [dest] as a symbolic link + to the file [source]. *) + +val readlink : string -> string +(** Read the contents of a link. *) + + +(** {6 Polling} *) + + +val select : + read:file_descr list -> write:file_descr list -> except:file_descr list -> + timeout:float -> file_descr list * file_descr list * file_descr list +(** Wait until some input/output operations become possible on + some channels. The three list arguments are, respectively, a set + of descriptors to check for reading (first argument), for writing + (second argument), or for exceptional conditions (third argument). + The fourth argument is the maximal timeout, in seconds; a + negative fourth argument means no timeout (unbounded wait). + The result is composed of three sets of descriptors: those ready + for reading (first component), ready for writing (second component), + and over which an exceptional condition is pending (third + component). *) + +(** {6 Locking} *) + + +type lock_command = Unix.lock_command = + F_ULOCK (** Unlock a region *) + | F_LOCK (** Lock a region for writing, and block if already locked *) + | F_TLOCK (** Lock a region for writing, or fail if already locked *) + | F_TEST (** Test a region for other process locks *) + | F_RLOCK (** Lock a region for reading, and block if already locked *) + | F_TRLOCK (** Lock a region for reading, or fail if already locked *) +(** Commands for {!UnixLabels.lockf}. *) + +val lockf : file_descr -> mode:lock_command -> len:int -> unit +(** [lockf fd cmd size] puts a lock on a region of the file opened + as [fd]. The region starts at the current read/write position for + [fd] (as set by {!UnixLabels.lseek}), and extends [size] bytes forward if + [size] is positive, [size] bytes backwards if [size] is negative, + or to the end of the file if [size] is zero. + A write lock prevents any other + process from acquiring a read or write lock on the region. + A read lock prevents any other + process from acquiring a write lock on the region, but lets + other processes acquire read locks on it. + + The [F_LOCK] and [F_TLOCK] commands attempts to put a write lock + on the specified region. + The [F_RLOCK] and [F_TRLOCK] commands attempts to put a read lock + on the specified region. + If one or several locks put by another process prevent the current process + from acquiring the lock, [F_LOCK] and [F_RLOCK] block until these locks + are removed, while [F_TLOCK] and [F_TRLOCK] fail immediately with an + exception. + The [F_ULOCK] removes whatever locks the current process has on + the specified region. + Finally, the [F_TEST] command tests whether a write lock can be + acquired on the specified region, without actually putting a lock. + It returns immediately if successful, or fails otherwise. *) + + +(** {6 Signals} + Note: installation of signal handlers is performed via + the functions {!Sys.signal} and {!Sys.set_signal}. +*) + + +val kill : pid:int -> signal:int -> unit +(** [kill pid sig] sends signal number [sig] to the process + with id [pid]. *) + +type sigprocmask_command = Unix.sigprocmask_command = + SIG_SETMASK + | SIG_BLOCK + | SIG_UNBLOCK + +val sigprocmask : mode:sigprocmask_command -> int list -> int list +(** [sigprocmask cmd sigs] changes the set of blocked signals. + If [cmd] is [SIG_SETMASK], blocked signals are set to those in + the list [sigs]. + If [cmd] is [SIG_BLOCK], the signals in [sigs] are added to + the set of blocked signals. + If [cmd] is [SIG_UNBLOCK], the signals in [sigs] are removed + from the set of blocked signals. + [sigprocmask] returns the set of previously blocked signals. *) + +val sigpending : unit -> int list +(** Return the set of blocked signals that are currently pending. *) + +val sigsuspend : int list -> unit +(** [sigsuspend sigs] atomically sets the blocked signals to [sigs] + and waits for a non-ignored, non-blocked signal to be delivered. + On return, the blocked signals are reset to their initial value. *) + +val pause : unit -> unit +(** Wait until a non-ignored, non-blocked signal is delivered. *) + + +(** {6 Time functions} *) + + +type process_times = Unix.process_times = + { tms_utime : float; (** User time for the process *) + tms_stime : float; (** System time for the process *) + tms_cutime : float; (** User time for the children processes *) + tms_cstime : float; (** System time for the children processes *) + } +(** The execution times (CPU times) of a process. *) + +type tm = Unix.tm = + { tm_sec : int; (** Seconds 0..60 *) + tm_min : int; (** Minutes 0..59 *) + tm_hour : int; (** Hours 0..23 *) + tm_mday : int; (** Day of month 1..31 *) + tm_mon : int; (** Month of year 0..11 *) + tm_year : int; (** Year - 1900 *) + tm_wday : int; (** Day of week (Sunday is 0) *) + tm_yday : int; (** Day of year 0..365 *) + tm_isdst : bool; (** Daylight time savings in effect *) + } +(** The type representing wallclock time and calendar date. *) + + +val time : unit -> float +(** Return the current time since 00:00:00 GMT, Jan. 1, 1970, + in seconds. *) + +val gettimeofday : unit -> float +(** Same as {!UnixLabels.time}, but with resolution better than 1 second. *) + +val gmtime : float -> tm +(** Convert a time in seconds, as returned by {!UnixLabels.time}, into a date + and a time. Assumes UTC (Coordinated Universal Time), also known as GMT. *) + +val localtime : float -> tm +(** Convert a time in seconds, as returned by {!UnixLabels.time}, into a date + and a time. Assumes the local time zone. *) + +val mktime : tm -> float * tm +(** Convert a date and time, specified by the [tm] argument, into + a time in seconds, as returned by {!UnixLabels.time}. The [tm_isdst], + [tm_wday] and [tm_yday] fields of [tm] are ignored. Also return a + normalized copy of the given [tm] record, with the [tm_wday], + [tm_yday], and [tm_isdst] fields recomputed from the other fields, + and the other fields normalized (so that, e.g., 40 October is + changed into 9 November). The [tm] argument is interpreted in the + local time zone. *) + +val alarm : int -> int +(** Schedule a [SIGALRM] signal after the given number of seconds. *) + +val sleep : int -> unit +(** Stop execution for the given number of seconds. *) + +val times : unit -> process_times +(** Return the execution times of the process. *) + +val utimes : string -> access:float -> modif:float -> unit +(** Set the last access time (second arg) and last modification time + (third arg) for a file. Times are expressed in seconds from + 00:00:00 GMT, Jan. 1, 1970. *) + +type interval_timer = Unix.interval_timer = + ITIMER_REAL + (** decrements in real time, and sends the signal [SIGALRM] when expired.*) + | ITIMER_VIRTUAL + (** decrements in process virtual time, and sends [SIGVTALRM] when expired. *) + | ITIMER_PROF + (** (for profiling) decrements both when the process + is running and when the system is running on behalf of the + process; it sends [SIGPROF] when expired. *) +(** The three kinds of interval timers. *) + +type interval_timer_status = Unix.interval_timer_status = + { it_interval : float; (** Period *) + it_value : float; (** Current value of the timer *) + } +(** The type describing the status of an interval timer *) + +val getitimer : interval_timer -> interval_timer_status +(** Return the current status of the given interval timer. *) + +val setitimer : + interval_timer -> interval_timer_status -> interval_timer_status +(** [setitimer t s] sets the interval timer [t] and returns + its previous status. The [s] argument is interpreted as follows: + [s.it_value], if nonzero, is the time to the next timer expiration; + [s.it_interval], if nonzero, specifies a value to + be used in reloading it_value when the timer expires. + Setting [s.it_value] to zero disable the timer. + Setting [s.it_interval] to zero causes the timer to be disabled + after its next expiration. *) + + +(** {6 User id, group id} *) + + +val getuid : unit -> int +(** Return the user id of the user executing the process. *) + +val geteuid : unit -> int +(** Return the effective user id under which the process runs. *) + +val setuid : int -> unit +(** Set the real user id and effective user id for the process. *) + +val getgid : unit -> int +(** Return the group id of the user executing the process. *) + +val getegid : unit -> int +(** Return the effective group id under which the process runs. *) + +val setgid : int -> unit +(** Set the real group id and effective group id for the process. *) + +val getgroups : unit -> int array +(** Return the list of groups to which the user executing the process + belongs. *) + +type passwd_entry = Unix.passwd_entry = + { pw_name : string; + pw_passwd : string; + pw_uid : int; + pw_gid : int; + pw_gecos : string; + pw_dir : string; + pw_shell : string + } +(** Structure of entries in the [passwd] database. *) + +type group_entry = Unix.group_entry = + { gr_name : string; + gr_passwd : string; + gr_gid : int; + gr_mem : string array + } +(** Structure of entries in the [groups] database. *) + +val getlogin : unit -> string +(** Return the login name of the user executing the process. *) + +val getpwnam : string -> passwd_entry +(** Find an entry in [passwd] with the given name, or raise + [Not_found]. *) + +val getgrnam : string -> group_entry +(** Find an entry in [group] with the given name, or raise + [Not_found]. *) + +val getpwuid : int -> passwd_entry +(** Find an entry in [passwd] with the given user id, or raise + [Not_found]. *) + +val getgrgid : int -> group_entry +(** Find an entry in [group] with the given group id, or raise + [Not_found]. *) + + +(** {6 Internet addresses} *) + + +type inet_addr = Unix.inet_addr +(** The abstract type of Internet addresses. *) + +val inet_addr_of_string : string -> inet_addr +(** Conversion from the printable representation of an Internet + address to its internal representation. The argument string + consists of 4 numbers separated by periods ([XXX.YYY.ZZZ.TTT]) + for IPv4 addresses, and up to 8 numbers separated by colons + for IPv6 addresses. Raise [Failure] when given a string that + does not match these formats. *) + +val string_of_inet_addr : inet_addr -> string +(** Return the printable representation of the given Internet address. + See {!Unix.inet_addr_of_string} for a description of the + printable representation. *) + +val inet_addr_any : inet_addr +(** A special IPv4 address, for use only with [bind], representing + all the Internet addresses that the host machine possesses. *) + +val inet_addr_loopback : inet_addr +(** A special IPv4 address representing the host machine ([127.0.0.1]). *) + +val inet6_addr_any : inet_addr +(** A special IPv6 address, for use only with [bind], representing + all the Internet addresses that the host machine possesses. *) + +val inet6_addr_loopback : inet_addr +(** A special IPv6 address representing the host machine ([::1]). *) + + +(** {6 Sockets} *) + + +type socket_domain = Unix.socket_domain = + PF_UNIX (** Unix domain *) + | PF_INET (** Internet domain (IPv4) *) + | PF_INET6 (** Internet domain (IPv6) *) +(** The type of socket domains. *) + +type socket_type = Unix.socket_type = + SOCK_STREAM (** Stream socket *) + | SOCK_DGRAM (** Datagram socket *) + | SOCK_RAW (** Raw socket *) + | SOCK_SEQPACKET (** Sequenced packets socket *) +(** The type of socket kinds, specifying the semantics of + communications. *) + +type sockaddr = Unix.sockaddr = + ADDR_UNIX of string + | ADDR_INET of inet_addr * int +(** The type of socket addresses. [ADDR_UNIX name] is a socket + address in the Unix domain; [name] is a file name in the file + system. [ADDR_INET(addr,port)] is a socket address in the Internet + domain; [addr] is the Internet address of the machine, and + [port] is the port number. *) + +val socket : + domain:socket_domain -> kind:socket_type -> protocol:int -> file_descr +(** Create a new socket in the given domain, and with the + given kind. The third argument is the protocol type; 0 selects + the default protocol for that kind of sockets. *) + +val domain_of_sockaddr: sockaddr -> socket_domain +(** Return the socket domain adequate for the given socket address. *) + +val socketpair : + domain:socket_domain -> kind:socket_type -> protocol:int -> + file_descr * file_descr +(** Create a pair of unnamed sockets, connected together. *) + +val accept : file_descr -> file_descr * sockaddr +(** Accept connections on the given socket. The returned descriptor + is a socket connected to the client; the returned address is + the address of the connecting client. *) + +val bind : file_descr -> addr:sockaddr -> unit +(** Bind a socket to an address. *) + +val connect : file_descr -> addr:sockaddr -> unit +(** Connect a socket to an address. *) + +val listen : file_descr -> max:int -> unit +(** Set up a socket for receiving connection requests. The integer + argument is the maximal number of pending requests. *) + +type shutdown_command = Unix.shutdown_command = + SHUTDOWN_RECEIVE (** Close for receiving *) + | SHUTDOWN_SEND (** Close for sending *) + | SHUTDOWN_ALL (** Close both *) +(** The type of commands for [shutdown]. *) + + +val shutdown : file_descr -> mode:shutdown_command -> unit +(** Shutdown a socket connection. [SHUTDOWN_SEND] as second argument + causes reads on the other end of the connection to return + an end-of-file condition. + [SHUTDOWN_RECEIVE] causes writes on the other end of the connection + to return a closed pipe condition ([SIGPIPE] signal). *) + +val getsockname : file_descr -> sockaddr +(** Return the address of the given socket. *) + +val getpeername : file_descr -> sockaddr +(** Return the address of the host connected to the given socket. *) + +type msg_flag = Unix.msg_flag = + MSG_OOB + | MSG_DONTROUTE + | MSG_PEEK +(** The flags for {!UnixLabels.recv}, {!UnixLabels.recvfrom}, + {!UnixLabels.send} and {!UnixLabels.sendto}. *) + +val recv : + file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list -> int +(** Receive data from a connected socket. *) + +val recvfrom : + file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list -> + int * sockaddr +(** Receive data from an unconnected socket. *) + +val send : + file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list -> int +(** Send data over a connected socket. *) + +val sendto : + file_descr -> buf:string -> pos:int -> len:int -> mode:msg_flag list -> + addr:sockaddr -> int +(** Send data over an unconnected socket. *) + + + +(** {6 Socket options} *) + + +type socket_bool_option = + SO_DEBUG (** Record debugging information *) + | SO_BROADCAST (** Permit sending of broadcast messages *) + | SO_REUSEADDR (** Allow reuse of local addresses for bind *) + | SO_KEEPALIVE (** Keep connection active *) + | SO_DONTROUTE (** Bypass the standard routing algorithms *) + | SO_OOBINLINE (** Leave out-of-band data in line *) + | SO_ACCEPTCONN (** Report whether socket listening is enabled *) + | TCP_NODELAY (** Control the Nagle algorithm for TCP sockets *) + | IPV6_ONLY (** Forbid binding an IPv6 socket to an IPv4 address *) +(** The socket options that can be consulted with {!UnixLabels.getsockopt} + and modified with {!UnixLabels.setsockopt}. These options have a boolean + ([true]/[false]) value. *) + +type socket_int_option = + SO_SNDBUF (** Size of send buffer *) + | SO_RCVBUF (** Size of received buffer *) + | SO_ERROR (** Deprecated. Use {!Unix.getsockopt_error} instead. *) + | SO_TYPE (** Report the socket type *) + | SO_RCVLOWAT (** Minimum number of bytes to process for input operations *) + | SO_SNDLOWAT (** Minimum number of bytes to process for output operations *) +(** The socket options that can be consulted with {!UnixLabels.getsockopt_int} + and modified with {!UnixLabels.setsockopt_int}. These options have an + integer value. *) + +type socket_optint_option = + SO_LINGER (** Whether to linger on closed connections + that have data present, and for how long + (in seconds) *) +(** The socket options that can be consulted with {!Unix.getsockopt_optint} + and modified with {!Unix.setsockopt_optint}. These options have a + value of type [int option], with [None] meaning ``disabled''. *) + +type socket_float_option = + SO_RCVTIMEO (** Timeout for input operations *) + | SO_SNDTIMEO (** Timeout for output operations *) +(** The socket options that can be consulted with {!UnixLabels.getsockopt_float} + and modified with {!UnixLabels.setsockopt_float}. These options have a + floating-point value representing a time in seconds. + The value 0 means infinite timeout. *) + +val getsockopt : file_descr -> socket_bool_option -> bool +(** Return the current status of a boolean-valued option + in the given socket. *) + +val setsockopt : file_descr -> socket_bool_option -> bool -> unit +(** Set or clear a boolean-valued option in the given socket. *) + +val getsockopt_int : file_descr -> socket_int_option -> int +(** Same as {!Unix.getsockopt} for an integer-valued socket option. *) + +val setsockopt_int : file_descr -> socket_int_option -> int -> unit +(** Same as {!Unix.setsockopt} for an integer-valued socket option. *) + +val getsockopt_optint : file_descr -> socket_optint_option -> int option +(** Same as {!Unix.getsockopt} for a socket option whose value is an [int option]. *) + +val setsockopt_optint : + file_descr -> socket_optint_option -> int option -> unit +(** Same as {!Unix.setsockopt} for a socket option whose value is an [int option]. *) + +val getsockopt_float : file_descr -> socket_float_option -> float +(** Same as {!Unix.getsockopt} for a socket option whose value is a floating-point number. *) + +val setsockopt_float : file_descr -> socket_float_option -> float -> unit +(** Same as {!Unix.setsockopt} for a socket option whose value is a floating-point number. *) + +val getsockopt_error : file_descr -> error option +(** Return the error condition associated with the given socket, + and clear it. *) + +(** {6 High-level network connection functions} *) + + +val open_connection : sockaddr -> in_channel * out_channel +(** Connect to a server at the given address. + Return a pair of buffered channels connected to the server. + Remember to call {!Pervasives.flush} on the output channel at the right + times to ensure correct synchronization. *) + +val shutdown_connection : in_channel -> unit +(** ``Shut down'' a connection established with {!UnixLabels.open_connection}; + that is, transmit an end-of-file condition to the server reading + on the other side of the connection. *) + +val establish_server : + (in_channel -> out_channel -> unit) -> addr:sockaddr -> unit +(** Establish a server on the given address. + The function given as first argument is called for each connection + with two buffered channels connected to the client. A new process + is created for each connection. The function {!UnixLabels.establish_server} + never returns normally. *) + + +(** {6 Host and protocol databases} *) + + +type host_entry = Unix.host_entry = + { h_name : string; + h_aliases : string array; + h_addrtype : socket_domain; + h_addr_list : inet_addr array + } +(** Structure of entries in the [hosts] database. *) + +type protocol_entry = Unix.protocol_entry = + { p_name : string; + p_aliases : string array; + p_proto : int + } +(** Structure of entries in the [protocols] database. *) + +type service_entry = Unix.service_entry = + { s_name : string; + s_aliases : string array; + s_port : int; + s_proto : string + } +(** Structure of entries in the [services] database. *) + +val gethostname : unit -> string +(** Return the name of the local host. *) + +val gethostbyname : string -> host_entry +(** Find an entry in [hosts] with the given name, or raise + [Not_found]. *) + +val gethostbyaddr : inet_addr -> host_entry +(** Find an entry in [hosts] with the given address, or raise + [Not_found]. *) + +val getprotobyname : string -> protocol_entry +(** Find an entry in [protocols] with the given name, or raise + [Not_found]. *) + +val getprotobynumber : int -> protocol_entry +(** Find an entry in [protocols] with the given protocol number, + or raise [Not_found]. *) + +val getservbyname : string -> protocol:string -> service_entry +(** Find an entry in [services] with the given name, or raise + [Not_found]. *) + +val getservbyport : int -> protocol:string -> service_entry +(** Find an entry in [services] with the given service number, + or raise [Not_found]. *) + +type addr_info = + { ai_family : socket_domain; (** Socket domain *) + ai_socktype : socket_type; (** Socket type *) + ai_protocol : int; (** Socket protocol number *) + ai_addr : sockaddr; (** Address *) + ai_canonname : string (** Canonical host name *) + } +(** Address information returned by {!Unix.getaddrinfo}. *) + +type getaddrinfo_option = + AI_FAMILY of socket_domain (** Impose the given socket domain *) + | AI_SOCKTYPE of socket_type (** Impose the given socket type *) + | AI_PROTOCOL of int (** Impose the given protocol *) + | AI_NUMERICHOST (** Do not call name resolver, + expect numeric IP address *) + | AI_CANONNAME (** Fill the [ai_canonname] field + of the result *) + | AI_PASSIVE (** Set address to ``any'' address + for use with {!Unix.bind} *) +(** Options to {!Unix.getaddrinfo}. *) + +val getaddrinfo: + string -> string -> getaddrinfo_option list -> addr_info list +(** [getaddrinfo host service opts] returns a list of {!Unix.addr_info} + records describing socket parameters and addresses suitable for + communicating with the given host and service. The empty list is + returned if the host or service names are unknown, or the constraints + expressed in [opts] cannot be satisfied. + + [host] is either a host name or the string representation of an IP + address. [host] can be given as the empty string; in this case, + the ``any'' address or the ``loopback'' address are used, + depending whether [opts] contains [AI_PASSIVE]. + [service] is either a service name or the string representation of + a port number. [service] can be given as the empty string; + in this case, the port field of the returned addresses is set to 0. + [opts] is a possibly empty list of options that allows the caller + to force a particular socket domain (e.g. IPv6 only or IPv4 only) + or a particular socket type (e.g. TCP only or UDP only). *) + +type name_info = + { ni_hostname : string; (** Name or IP address of host *) + ni_service : string } (** Name of service or port number *) +(** Host and service information returned by {!Unix.getnameinfo}. *) + +type getnameinfo_option = + NI_NOFQDN (** Do not qualify local host names *) + | NI_NUMERICHOST (** Always return host as IP address *) + | NI_NAMEREQD (** Fail if host name cannot be determined *) + | NI_NUMERICSERV (** Always return service as port number *) + | NI_DGRAM (** Consider the service as UDP-based + instead of the default TCP *) +(** Options to {!Unix.getnameinfo}. *) + +val getnameinfo : sockaddr -> getnameinfo_option list -> name_info +(** [getnameinfo addr opts] returns the host name and service name + corresponding to the socket address [addr]. [opts] is a possibly + empty list of options that governs how these names are obtained. + Raise [Not_found] if an error occurs. *) + + +(** {6 Terminal interface} *) + + +(** The following functions implement the POSIX standard terminal + interface. They provide control over asynchronous communication ports + and pseudo-terminals. Refer to the [termios] man page for a + complete description. *) + +type terminal_io = Unix.terminal_io = + { + (* input modes *) + mutable c_ignbrk : bool; (** Ignore the break condition. *) + mutable c_brkint : bool; (** Signal interrupt on break condition. *) + mutable c_ignpar : bool; (** Ignore characters with parity errors. *) + mutable c_parmrk : bool; (** Mark parity errors. *) + mutable c_inpck : bool; (** Enable parity check on input. *) + mutable c_istrip : bool; (** Strip 8th bit on input characters. *) + mutable c_inlcr : bool; (** Map NL to CR on input. *) + mutable c_igncr : bool; (** Ignore CR on input. *) + mutable c_icrnl : bool; (** Map CR to NL on input. *) + mutable c_ixon : bool; (** Recognize XON/XOFF characters on input. *) + mutable c_ixoff : bool; (** Emit XON/XOFF chars to control input flow. *) + (* Output modes: *) + mutable c_opost : bool; (** Enable output processing. *) + (* Control modes: *) + mutable c_obaud : int; (** Output baud rate (0 means close connection).*) + mutable c_ibaud : int; (** Input baud rate. *) + mutable c_csize : int; (** Number of bits per character (5-8). *) + mutable c_cstopb : int; (** Number of stop bits (1-2). *) + mutable c_cread : bool; (** Reception is enabled. *) + mutable c_parenb : bool; (** Enable parity generation and detection. *) + mutable c_parodd : bool; (** Specify odd parity instead of even. *) + mutable c_hupcl : bool; (** Hang up on last close. *) + mutable c_clocal : bool; (** Ignore modem status lines. *) + (* Local modes: *) + mutable c_isig : bool; (** Generate signal on INTR, QUIT, SUSP. *) + mutable c_icanon : bool; (** Enable canonical processing + (line buffering and editing) *) + mutable c_noflsh : bool; (** Disable flush after INTR, QUIT, SUSP. *) + mutable c_echo : bool; (** Echo input characters. *) + mutable c_echoe : bool; (** Echo ERASE (to erase previous character). *) + mutable c_echok : bool; (** Echo KILL (to erase the current line). *) + mutable c_echonl : bool; (** Echo NL even if c_echo is not set. *) + (* Control characters: *) + mutable c_vintr : char; (** Interrupt character (usually ctrl-C). *) + mutable c_vquit : char; (** Quit character (usually ctrl-\). *) + mutable c_verase : char; (** Erase character (usually DEL or ctrl-H). *) + mutable c_vkill : char; (** Kill line character (usually ctrl-U). *) + mutable c_veof : char; (** End-of-file character (usually ctrl-D). *) + mutable c_veol : char; (** Alternate end-of-line char. (usually none). *) + mutable c_vmin : int; (** Minimum number of characters to read + before the read request is satisfied. *) + mutable c_vtime : int; (** Maximum read wait (in 0.1s units). *) + mutable c_vstart : char; (** Start character (usually ctrl-Q). *) + mutable c_vstop : char; (** Stop character (usually ctrl-S). *) + } + +val tcgetattr : file_descr -> terminal_io +(** Return the status of the terminal referred to by the given + file descriptor. *) + +type setattr_when = Unix.setattr_when = + TCSANOW + | TCSADRAIN + | TCSAFLUSH + +val tcsetattr : file_descr -> mode:setattr_when -> terminal_io -> unit +(** Set the status of the terminal referred to by the given + file descriptor. The second argument indicates when the + status change takes place: immediately ([TCSANOW]), + when all pending output has been transmitted ([TCSADRAIN]), + or after flushing all input that has been received but not + read ([TCSAFLUSH]). [TCSADRAIN] is recommended when changing + the output parameters; [TCSAFLUSH], when changing the input + parameters. *) + +val tcsendbreak : file_descr -> duration:int -> unit +(** Send a break condition on the given file descriptor. + The second argument is the duration of the break, in 0.1s units; + 0 means standard duration (0.25s). *) + +val tcdrain : file_descr -> unit +(** Waits until all output written on the given file descriptor + has been transmitted. *) + +type flush_queue = Unix.flush_queue = + TCIFLUSH + | TCOFLUSH + | TCIOFLUSH + +val tcflush : file_descr -> mode:flush_queue -> unit +(** Discard data written on the given file descriptor but not yet + transmitted, or data received but not yet read, depending on the + second argument: [TCIFLUSH] flushes data received but not read, + [TCOFLUSH] flushes data written but not transmitted, and + [TCIOFLUSH] flushes both. *) + +type flow_action = Unix.flow_action = + TCOOFF + | TCOON + | TCIOFF + | TCION + +val tcflow : file_descr -> mode:flow_action -> unit +(** Suspend or restart reception or transmission of data on + the given file descriptor, depending on the second argument: + [TCOOFF] suspends output, [TCOON] restarts output, + [TCIOFF] transmits a STOP character to suspend input, + and [TCION] transmits a START character to restart input. *) + +val setsid : unit -> int +(** Put the calling process in a new session and detach it from + its controlling terminal. *) diff --git a/ocaml-binary-annot/otherlibs/unix/unixsupport.c b/ocaml-binary-annot/otherlibs/unix/unixsupport.c new file mode 100644 index 0000000000..c6eaf706c5 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/unixsupport.c @@ -0,0 +1,292 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <callback.h> +#include <memory.h> +#include <fail.h> +#include "unixsupport.h" +#include "cst2constr.h" +#include <errno.h> + +#ifndef E2BIG +#define E2BIG (-1) +#endif +#ifndef EACCES +#define EACCES (-1) +#endif +#ifndef EAGAIN +#define EAGAIN (-1) +#endif +#ifndef EBADF +#define EBADF (-1) +#endif +#ifndef EBUSY +#define EBUSY (-1) +#endif +#ifndef ECHILD +#define ECHILD (-1) +#endif +#ifndef EDEADLK +#define EDEADLK (-1) +#endif +#ifndef EDOM +#define EDOM (-1) +#endif +#ifndef EEXIST +#define EEXIST (-1) +#endif + +#ifndef EFAULT +#define EFAULT (-1) +#endif +#ifndef EFBIG +#define EFBIG (-1) +#endif +#ifndef EINTR +#define EINTR (-1) +#endif +#ifndef EINVAL +#define EINVAL (-1) +#endif +#ifndef EIO +#define EIO (-1) +#endif +#ifndef EISDIR +#define EISDIR (-1) +#endif +#ifndef EMFILE +#define EMFILE (-1) +#endif +#ifndef EMLINK +#define EMLINK (-1) +#endif +#ifndef ENAMETOOLONG +#define ENAMETOOLONG (-1) +#endif +#ifndef ENFILE +#define ENFILE (-1) +#endif +#ifndef ENODEV +#define ENODEV (-1) +#endif +#ifndef ENOENT +#define ENOENT (-1) +#endif +#ifndef ENOEXEC +#define ENOEXEC (-1) +#endif +#ifndef ENOLCK +#define ENOLCK (-1) +#endif +#ifndef ENOMEM +#define ENOMEM (-1) +#endif +#ifndef ENOSPC +#define ENOSPC (-1) +#endif +#ifndef ENOSYS +#define ENOSYS (-1) +#endif +#ifndef ENOTDIR +#define ENOTDIR (-1) +#endif +#ifndef ENOTEMPTY +#define ENOTEMPTY (-1) +#endif +#ifndef ENOTTY +#define ENOTTY (-1) +#endif +#ifndef ENXIO +#define ENXIO (-1) +#endif +#ifndef EPERM +#define EPERM (-1) +#endif +#ifndef EPIPE +#define EPIPE (-1) +#endif +#ifndef ERANGE +#define ERANGE (-1) +#endif +#ifndef EROFS +#define EROFS (-1) +#endif +#ifndef ESPIPE +#define ESPIPE (-1) +#endif +#ifndef ESRCH +#define ESRCH (-1) +#endif +#ifndef EXDEV +#define EXDEV (-1) +#endif +#ifndef EWOULDBLOCK +#define EWOULDBLOCK (-1) +#endif +#ifndef EINPROGRESS +#define EINPROGRESS (-1) +#endif +#ifndef EALREADY +#define EALREADY (-1) +#endif +#ifndef ENOTSOCK +#define ENOTSOCK (-1) +#endif +#ifndef EDESTADDRREQ +#define EDESTADDRREQ (-1) +#endif +#ifndef EMSGSIZE +#define EMSGSIZE (-1) +#endif +#ifndef EPROTOTYPE +#define EPROTOTYPE (-1) +#endif +#ifndef ENOPROTOOPT +#define ENOPROTOOPT (-1) +#endif +#ifndef EPROTONOSUPPORT +#define EPROTONOSUPPORT (-1) +#endif +#ifndef ESOCKTNOSUPPORT +#define ESOCKTNOSUPPORT (-1) +#endif +#ifndef EOPNOTSUPP +#define EOPNOTSUPP (-1) +#endif +#ifndef EPFNOSUPPORT +#define EPFNOSUPPORT (-1) +#endif +#ifndef EAFNOSUPPORT +#define EAFNOSUPPORT (-1) +#endif +#ifndef EADDRINUSE +#define EADDRINUSE (-1) +#endif +#ifndef EADDRNOTAVAIL +#define EADDRNOTAVAIL (-1) +#endif +#ifndef ENETDOWN +#define ENETDOWN (-1) +#endif +#ifndef ENETUNREACH +#define ENETUNREACH (-1) +#endif +#ifndef ENETRESET +#define ENETRESET (-1) +#endif +#ifndef ECONNABORTED +#define ECONNABORTED (-1) +#endif +#ifndef ECONNRESET +#define ECONNRESET (-1) +#endif +#ifndef ENOBUFS +#define ENOBUFS (-1) +#endif +#ifndef EISCONN +#define EISCONN (-1) +#endif +#ifndef ENOTCONN +#define ENOTCONN (-1) +#endif +#ifndef ESHUTDOWN +#define ESHUTDOWN (-1) +#endif +#ifndef ETOOMANYREFS +#define ETOOMANYREFS (-1) +#endif +#ifndef ETIMEDOUT +#define ETIMEDOUT (-1) +#endif +#ifndef ECONNREFUSED +#define ECONNREFUSED (-1) +#endif +#ifndef EHOSTDOWN +#define EHOSTDOWN (-1) +#endif +#ifndef EHOSTUNREACH +#define EHOSTUNREACH (-1) +#endif +#ifndef ENOTEMPTY +#define ENOTEMPTY (-1) +#endif +#ifndef ELOOP +#define ELOOP (-1) +#endif +#ifndef EOVERFLOW +#define EOVERFLOW (-1) +#endif + +int error_table[] = { + E2BIG, EACCES, EAGAIN, EBADF, EBUSY, ECHILD, EDEADLK, EDOM, + EEXIST, EFAULT, EFBIG, EINTR, EINVAL, EIO, EISDIR, EMFILE, EMLINK, + ENAMETOOLONG, ENFILE, ENODEV, ENOENT, ENOEXEC, ENOLCK, ENOMEM, ENOSPC, + ENOSYS, ENOTDIR, ENOTEMPTY, ENOTTY, ENXIO, EPERM, EPIPE, ERANGE, + EROFS, ESPIPE, ESRCH, EXDEV, EWOULDBLOCK, EINPROGRESS, EALREADY, + ENOTSOCK, EDESTADDRREQ, EMSGSIZE, EPROTOTYPE, ENOPROTOOPT, + EPROTONOSUPPORT, ESOCKTNOSUPPORT, EOPNOTSUPP, EPFNOSUPPORT, + EAFNOSUPPORT, EADDRINUSE, EADDRNOTAVAIL, ENETDOWN, ENETUNREACH, + ENETRESET, ECONNABORTED, ECONNRESET, ENOBUFS, EISCONN, ENOTCONN, + ESHUTDOWN, ETOOMANYREFS, ETIMEDOUT, ECONNREFUSED, EHOSTDOWN, + EHOSTUNREACH, ELOOP, EOVERFLOW /*, EUNKNOWNERR */ +}; + +static value * unix_error_exn = NULL; + +value unix_error_of_code (int errcode) +{ + int errconstr; + value err; + + errconstr = + cst_to_constr(errcode, error_table, sizeof(error_table)/sizeof(int), -1); + if (errconstr == Val_int(-1)) { + err = alloc_small(1, 0); + Field(err, 0) = Val_int(errcode); + } else { + err = errconstr; + } + return err; +} + +void unix_error(int errcode, char *cmdname, value cmdarg) +{ + value res; + value name = Val_unit, err = Val_unit, arg = Val_unit; + + Begin_roots3 (name, err, arg); + arg = cmdarg == Nothing ? copy_string("") : cmdarg; + name = copy_string(cmdname); + err = unix_error_of_code (errcode); + if (unix_error_exn == NULL) { + unix_error_exn = caml_named_value("Unix.Unix_error"); + if (unix_error_exn == NULL) + invalid_argument("Exception Unix.Unix_error not initialized, please link unix.cma"); + } + res = alloc_small(4, 0); + Field(res, 0) = *unix_error_exn; + Field(res, 1) = err; + Field(res, 2) = name; + Field(res, 3) = arg; + End_roots(); + mlraise(res); +} + +void uerror(char *cmdname, value cmdarg) +{ + unix_error(errno, cmdname, cmdarg); +} diff --git a/ocaml-binary-annot/otherlibs/unix/unixsupport.h b/ocaml-binary-annot/otherlibs/unix/unixsupport.h new file mode 100644 index 0000000000..84179f43f3 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/unixsupport.h @@ -0,0 +1,28 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#ifdef HAS_UNISTD +#include <unistd.h> +#endif + +#define Nothing ((value) 0) + +extern value unix_error_of_code (int errcode); +extern void unix_error (int errcode, char * cmdname, value arg) Noreturn; +extern void uerror (char * cmdname, value arg) Noreturn; + +#define UNIX_BUFFER_SIZE 16384 + +#define DIR_Val(v) *((DIR **) &Field(v, 0)) diff --git a/ocaml-binary-annot/otherlibs/unix/unlink.c b/ocaml-binary-annot/otherlibs/unix/unlink.c new file mode 100644 index 0000000000..1d956758b3 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/unlink.c @@ -0,0 +1,23 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unixsupport.h" + +CAMLprim value unix_unlink(value path) +{ + if (unlink(String_val(path)) == -1) uerror("unlink", path); + return Val_unit; +} diff --git a/ocaml-binary-annot/otherlibs/unix/utimes.c b/ocaml-binary-annot/otherlibs/unix/utimes.c new file mode 100644 index 0000000000..da2913570a --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/utimes.c @@ -0,0 +1,72 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fail.h> +#include <mlvalues.h> +#include "unixsupport.h" + +#ifdef HAS_UTIME + +#include <sys/types.h> +#ifndef _WIN32 +#include <utime.h> +#else +#include <sys/utime.h> +#endif + +CAMLprim value unix_utimes(value path, value atime, value mtime) +{ + struct utimbuf times, * t; + times.actime = Double_val(atime); + times.modtime = Double_val(mtime); + if (times.actime || times.modtime) + t = × + else + t = (struct utimbuf *) NULL; + if (utime(String_val(path), t) == -1) uerror("utimes", path); + return Val_unit; +} + +#else + +#ifdef HAS_UTIMES + +#include <sys/types.h> +#include <sys/time.h> + +CAMLprim value unix_utimes(value path, value atime, value mtime) +{ + struct timeval tv[2], * t; + double at = Double_val(atime); + double mt = Double_val(mtime); + tv[0].tv_sec = at; + tv[0].tv_usec = (at - tv[0].tv_sec) * 1000000; + tv[1].tv_sec = mt; + tv[1].tv_usec = (mt - tv[1].tv_sec) * 1000000; + if (tv[0].tv_sec || tv[1].tv_sec) + t = tv; + else + t = (struct timeval *) NULL; + if (utimes(String_val(path), t) == -1) uerror("utimes", path); + return Val_unit; +} + +#else + +CAMLprim value unix_utimes(value path, value atime, value mtime) +{ invalid_argument("utimes not implemented"); } + +#endif +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/wait.c b/ocaml-binary-annot/otherlibs/unix/wait.c new file mode 100644 index 0000000000..486d06af7b --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/wait.c @@ -0,0 +1,102 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <fail.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" + +#include <sys/types.h> +#include <sys/wait.h> + +#if !(defined(WIFEXITED) && defined(WEXITSTATUS) && defined(WIFSTOPPED) && \ + defined(WSTOPSIG) && defined(WTERMSIG)) +/* Assume old-style V7 status word */ +#define WIFEXITED(status) (((status) & 0xFF) == 0) +#define WEXITSTATUS(status) (((status) >> 8) & 0xFF) +#define WIFSTOPPED(status) (((status) & 0xFF) == 0xFF) +#define WSTOPSIG(status) (((status) >> 8) & 0xFF) +#define WTERMSIG(status) ((status) & 0x3F) +#endif + +#define TAG_WEXITED 0 +#define TAG_WSIGNALED 1 +#define TAG_WSTOPPED 2 + +static value alloc_process_status(int pid, int status) +{ + value st, res; + + if (WIFEXITED(status)) { + st = alloc_small(1, TAG_WEXITED); + Field(st, 0) = Val_int(WEXITSTATUS(status)); + } + else if (WIFSTOPPED(status)) { + st = alloc_small(1, TAG_WSTOPPED); + Field(st, 0) = Val_int(caml_rev_convert_signal_number(WSTOPSIG(status))); + } + else { + st = alloc_small(1, TAG_WSIGNALED); + Field(st, 0) = Val_int(caml_rev_convert_signal_number(WTERMSIG(status))); + } + Begin_root (st); + res = alloc_small(2, 0); + Field(res, 0) = Val_int(pid); + Field(res, 1) = st; + End_roots(); + return res; +} + +CAMLprim value unix_wait(value unit) +{ + int pid, status; + + enter_blocking_section(); + pid = wait(&status); + leave_blocking_section(); + if (pid == -1) uerror("wait", Nothing); + return alloc_process_status(pid, status); +} + +#if defined(HAS_WAITPID) || defined(HAS_WAIT4) + +#ifndef HAS_WAITPID +#define waitpid(pid,status,opts) wait4(pid,status,opts,NULL) +#endif + +static int wait_flag_table[] = { + WNOHANG, WUNTRACED +}; + +CAMLprim value unix_waitpid(value flags, value pid_req) +{ + int pid, status, cv_flags; + + cv_flags = convert_flag_list(flags, wait_flag_table); + enter_blocking_section(); + pid = waitpid(Int_val(pid_req), &status, cv_flags); + leave_blocking_section(); + if (pid == -1) uerror("waitpid", Nothing); + return alloc_process_status(pid, status); +} + +#else + +CAMLprim value unix_waitpid(value flags, value pid_req) +{ invalid_argument("waitpid not implemented"); } + +#endif diff --git a/ocaml-binary-annot/otherlibs/unix/write.c b/ocaml-binary-annot/otherlibs/unix/write.c new file mode 100644 index 0000000000..9ddf74e3d5 --- /dev/null +++ b/ocaml-binary-annot/otherlibs/unix/write.c @@ -0,0 +1,86 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <errno.h> +#include <string.h> +#include <mlvalues.h> +#include <memory.h> +#include <signals.h> +#include "unixsupport.h" + +#ifndef EAGAIN +#define EAGAIN (-1) +#endif +#ifndef EWOULDBLOCK +#define EWOULDBLOCK (-1) +#endif + +CAMLprim value unix_write(value fd, value buf, value vofs, value vlen) +{ + long ofs, len, written; + int numbytes, ret; + char iobuf[UNIX_BUFFER_SIZE]; + + Begin_root (buf); + ofs = Long_val(vofs); + len = Long_val(vlen); + written = 0; + while (len > 0) { + numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len; + memmove (iobuf, &Byte(buf, ofs), numbytes); + enter_blocking_section(); + ret = write(Int_val(fd), iobuf, numbytes); + leave_blocking_section(); + if (ret == -1) { + if ((errno == EAGAIN || errno == EWOULDBLOCK) && written > 0) break; + uerror("write", Nothing); + } + written += ret; + ofs += ret; + len -= ret; + } + End_roots(); + return Val_long(written); +} + +/* When an error occurs after the first loop, unix_write reports the + error and discards the number of already written characters. + In this case, it would be better to discard the error and return the + number of bytes written, since most likely, unix_write will be call again, + and the error will be reproduced and this time will be reported. + This problem is avoided in unix_single_write, which is faithful to the + Unix system call. */ + +CAMLprim value unix_single_write(value fd, value buf, value vofs, value vlen) +{ + long ofs, len; + int numbytes, ret; + char iobuf[UNIX_BUFFER_SIZE]; + + Begin_root (buf); + ofs = Long_val(vofs); + len = Long_val(vlen); + ret = 0; + if (len > 0) { + numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len; + memmove (iobuf, &Byte(buf, ofs), numbytes); + enter_blocking_section(); + ret = write(Int_val(fd), iobuf, numbytes); + leave_blocking_section(); + if (ret == -1) uerror("single_write", Nothing); + } + End_roots(); + return Val_int(ret); +} |