diff options
Diffstat (limited to 'otherlibs/unix')
| -rw-r--r-- | otherlibs/unix/.depend | 3 | ||||
| -rw-r--r-- | otherlibs/unix/Makefile | 8 | ||||
| -rw-r--r-- | otherlibs/unix/fcntl.c | 66 | ||||
| -rw-r--r-- | otherlibs/unix/itimer.c | 70 | ||||
| -rw-r--r-- | otherlibs/unix/open.c | 6 | ||||
| -rw-r--r-- | otherlibs/unix/sockopt.c | 52 | ||||
| -rw-r--r-- | otherlibs/unix/unix.ml | 146 | ||||
| -rw-r--r-- | otherlibs/unix/unix.mli | 203 | ||||
| -rw-r--r-- | otherlibs/unix/unixsupport.c | 184 | ||||
| -rw-r--r-- | otherlibs/unix/wait.c | 76 | ||||
| -rw-r--r-- | otherlibs/unix/waitpid.c | 65 |
11 files changed, 541 insertions, 338 deletions
diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend index b00464468..f6696d545 100644 --- a/otherlibs/unix/.depend +++ b/otherlibs/unix/.depend @@ -45,6 +45,7 @@ gettimeofday.o: gettimeofday.c unix.h getuid.o: getuid.c unix.h gmtime.o: gmtime.c unix.h ioctl.o: ioctl.c unix.h +itimer.o: itimer.c unix.h kill.o: kill.c unix.h link.o: link.c unix.h listen.o: listen.c unix.h @@ -72,6 +73,7 @@ sleep.o: sleep.c unix.h socket.o: socket.c unix.h socketaddr.o: socketaddr.c unix.h socketaddr.h socketpair.o: socketpair.c unix.h +sockopt.o: sockopt.c unix.h stat.o: stat.c unix.h cst2constr.h strofaddr.o: strofaddr.c unix.h socketaddr.h symlink.o: symlink.c unix.h @@ -84,7 +86,6 @@ unixsupport.o: unixsupport.c unix.h cst2constr.h unlink.o: unlink.c unix.h utimes.o: utimes.c unix.h wait.o: wait.c unix.h -waitpid.o: waitpid.c unix.h write.o: write.c unix.h unix.cmo: unix.cmi unix.cmx: unix.cmi diff --git a/otherlibs/unix/Makefile b/otherlibs/unix/Makefile index 907d80a68..3cb2b1292 100644 --- a/otherlibs/unix/Makefile +++ b/otherlibs/unix/Makefile @@ -15,13 +15,13 @@ OBJS=accept.o access.o addrofstr.o alarm.o bind.o chdir.o chmod.o \ geteuid.o getgid.o getgr.o getgroups.o gethost.o gethostname.o \ getlogin.o getpeername.o getpid.o getppid.o getproto.o getpw.o \ gettimeofday.o getserv.o getsockname.o getuid.o \ - gmtime.o ioctl.o kill.o link.o listen.o lockf.o lseek.o mkdir.o \ + gmtime.o ioctl.o itimer.o kill.o link.o listen.o lockf.o lseek.o mkdir.o \ mkfifo.o nice.o open.o opendir.o pause.o pipe.o read.o \ readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \ setgid.o setuid.o shutdown.o sleep.o socket.o socketaddr.o \ - socketpair.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 waitpid.o \ - write.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 all: libunix.a unix.cmi unix.cma diff --git a/otherlibs/unix/fcntl.c b/otherlibs/unix/fcntl.c index 2f2c87111..680729d1c 100644 --- a/otherlibs/unix/fcntl.c +++ b/otherlibs/unix/fcntl.c @@ -13,21 +13,67 @@ #include <mlvalues.h> #include "unix.h" +#ifdef HAS_UNISTD +#include <unistd.h> +#endif +#include <fcntl.h> -value unix_fcntl_int(fd, request, arg) - value fd, request, arg; +#ifndef O_NONBLOCK +#define O_NONBLOCK O_NDELAY +#endif + +value unix_set_nonblock(fd) + 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; +} + +value unix_clear_nonblock(fd) + 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 + +value unix_set_close_on_exec(fd) + value fd; { int retcode; - retcode = fcntl(Int_val(fd), Int_val(request), (char *) Long_val(arg)); - if (retcode == -1) uerror("fcntl_int", Nothing); - return Val_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; } -value unix_fcntl_ptr(fd, request, arg) - value fd, request, arg; +value unix_clear_close_on_exec(fd) + value fd; { int retcode; - retcode = fcntl(Int_val(fd), Int_val(request), String_val(arg)); - if (retcode == -1) uerror("fcntl_ptr", Nothing); - return Val_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 + +value unix_set_close_on_exec() +{ invalid_argument("set_close_on_exec not implemented"); } + +value unix_clear_close_on_exec() +{ invalid_argument("clear_close_on_exec not implemented"); } + +#endif diff --git a/otherlibs/unix/itimer.c b/otherlibs/unix/itimer.c new file mode 100644 index 000000000..28a188e73 --- /dev/null +++ b/otherlibs/unix/itimer.c @@ -0,0 +1,70 @@ +/***********************************************************************/ +/* */ +/* Caml Special Light */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1995 Institut National de Recherche en Informatique et */ +/* Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include <alloc.h> +#include <memory.h> +#include "unix.h" + +#ifdef HAS_SETITIMER + +#include <sys/time.h> + +#define Get_timeval(tv) \ + (double) tv.tv_sec + (double) tv.tv_usec / 1e6 +#define Set_timeval(tv, d) \ + tv.tv_sec = (int)(d), \ + tv.tv_usec = (int) (1e6 * ((d) - tv.tv_sec)) + +static value unix_convert_itimer(tp) + struct itimerval * tp; +{ + value res; + Push_roots(r, 2); + r[0] = copy_double(Get_timeval(tp->it_interval)); + r[1] = copy_double(Get_timeval(tp->it_value)); + res = alloc_tuple(2); + Field(res, 0) = r[0]; + Field(res, 1) = r[1]; + Pop_roots(); + return res; +} + +static int itimers[3] = { ITIMER_REAL, ITIMER_VIRTUAL, ITIMER_PROF }; + +value unix_setitimer(which, newval) + value which, newval; +{ + struct itimerval new, old; + Set_timeval(new.it_interval, Double_val(Field(newval, 0))); + Set_timeval(new.it_value, Double_val(Field(newval, 1))); + if (setitimer(itimers[Int_val(which)], &new, &old) == -1) + uerror("setitimer", Nothing); + return unix_convert_itimer(&old); +} + +value unix_getitimer(which) + value which; +{ + struct itimerval val; + if (getitimer(itimers[Int_val(which)], &val) == -1) + uerror("getitimer", Nothing); + return unix_convert_itimer(&val); +} + +#else + +value unix_setitimer() { invalid_argument("setitimer not implemented"); } +value unix_getitimer() { invalid_argument("getitimer not implemented"); } + +#endif diff --git a/otherlibs/unix/open.c b/otherlibs/unix/open.c index 795a787fa..9c12eedc8 100644 --- a/otherlibs/unix/open.c +++ b/otherlibs/unix/open.c @@ -16,8 +16,12 @@ #include "unix.h" #include <fcntl.h> +#ifndef O_NONBLOCK +#define O_NONBLOCK O_NDELAY +#endif + static int open_flag_table[] = { - O_RDONLY, O_WRONLY, O_RDWR, O_NDELAY, O_APPEND, O_CREAT, O_TRUNC, O_EXCL + O_RDONLY, O_WRONLY, O_RDWR, O_NONBLOCK, O_APPEND, O_CREAT, O_TRUNC, O_EXCL }; value unix_open(path, flags, perm) /* ML */ diff --git a/otherlibs/unix/sockopt.c b/otherlibs/unix/sockopt.c new file mode 100644 index 000000000..50dd84875 --- /dev/null +++ b/otherlibs/unix/sockopt.c @@ -0,0 +1,52 @@ +/***********************************************************************/ +/* */ +/* Caml Special Light */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1995 Institut National de Recherche en Informatique et */ +/* Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <mlvalues.h> +#include "unix.h" + +#ifdef HAS_SOCKETS + +#include <sys/types.h> +#include <sys/socket.h> + +static int sockopt[] = { + SO_DEBUG, SO_BROADCAST, SO_REUSEADDR, SO_KEEPALIVE, + SO_DONTROUTE, SO_OOBINLINE }; + +value unix_getsockopt(socket, option) + value socket, option; +{ + int optval, optsize; + optsize = sizeof(optval); + if (getsockopt(Int_val(socket), SOL_SOCKET, sockopt[Int_val(option)], + &optval, &optval) == -1) + uerror("getsockopt", Nothing); + return Val_int(optval); +} + +value unix_setsockopt(socket, option, status) + value socket, option, status; +{ + int optval = Int_val(status); + if (setsockopt(Int_val(socket), SOL_SOCKET, sockopt[Int_val(option)], + &optval, sizeof(optval)) == -1) + uerror("setsockopt", Nothing); + return Val_unit; +} + +#else + +value unix_getsockopt() { invalid_argument("getsockopt not implemented"); } +value unix_setsockopt() { invalid_argument("setsockopt not implemented"); } + +#endif diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml index 298d985ff..c0f52da8f 100644 --- a/otherlibs/unix/unix.ml +++ b/otherlibs/unix/unix.ml @@ -12,41 +12,43 @@ (* $Id$ *) type error = - ENOERR - | EPERM - | ENOENT - | ESRCH - | EINTR - | EIO - | ENXIO - | E2BIG - | ENOEXEC - | EBADF - | ECHILD + E2BIG + | EACCESS | EAGAIN - | ENOMEM - | EACCES - | EFAULT - | ENOTBLK + | EBADF | EBUSY + | ECHILD + | EDEADLK + | EDOM | EEXIST - | EXDEV - | ENODEV - | ENOTDIR - | EISDIR + | EFAULT + | EFBIG + | EINTR | EINVAL - | ENFILE + | EIO + | EISDIR | EMFILE - | ENOTTY - | ETXTBSY - | EFBIG - | ENOSPC - | ESPIPE - | EROFS | EMLINK + | ENAMETOOLONG + | ENFILE + | ENODEV + | ENOENT + | ENOEXEC + | ENOLCK + | ENOMEM + | ENOSPC + | ENOSYS + | ENOTDIR + | ENOTEMPTY + | ENOTTY + | ENXIO + | EPERM | EPIPE - | EDOM | ERANGE + | EROFS + | ESPIPE + | ESRCH + | EXDEV | EWOULDBLOCK | EINPROGRESS | EALREADY @@ -74,20 +76,9 @@ type error = | ETOOMANYREFS | ETIMEDOUT | ECONNREFUSED - | ELOOP - | ENAMETOOLONG | EHOSTDOWN | EHOSTUNREACH - | ENOTEMPTY - | EPROCLIM - | EUSERS - | EDQUOT - | ESTALE - | EREMOTE - | EIDRM - | EDEADLK - | ENOLCK - | ENOSYS + | ELOOP | EUNKNOWNERR exception Unix_error of error * string * string @@ -119,7 +110,7 @@ external environment : unit -> string array = "unix_environment" type process_status = WEXITED of int - | WSIGNALED of int * bool + | WSIGNALED of int | WSTOPPED of int type wait_flag = @@ -146,7 +137,7 @@ type open_flag = O_RDONLY | O_WRONLY | O_RDWR - | O_NDELAY + | O_NONBLOCK | O_APPEND | O_CREAT | O_TRUNC @@ -226,8 +217,14 @@ 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 fcntl_int : file_descr -> int -> int -> int = "unix_fcntl_int" -external fcntl_ptr : file_descr -> int -> string -> int = "unix_fcntl_ptr" + +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" + external mkdir : string -> file_perm -> unit = "unix_mkdir" external rmdir : string -> unit = "unix_rmdir" external chdir : string -> unit = "unix_chdir" @@ -240,8 +237,6 @@ 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 dup : file_descr -> file_descr = "unix_dup" -external dup2 : file_descr -> file_descr -> unit = "unix_dup2" external symlink : string -> string -> unit = "unix_symlink" external readlink : string -> string = "unix_readlink" external mkfifo : string -> file_perm -> unit = "unix_mkfifo" @@ -287,6 +282,21 @@ external sleep : int -> unit = "unix_sleep" external times : unit -> process_times = "unix_times_bytecode" "unix_times_native" external utimes : string -> int -> int -> 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" @@ -323,6 +333,9 @@ 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" + type socket_domain = PF_UNIX | PF_INET @@ -347,6 +360,14 @@ type msg_flag = | MSG_DONTROUTE | MSG_PEEK +type socket_option = + SO_DEBUG + | SO_BROADCAST + | SO_REUSEADDR + | SO_KEEPALIVE + | SO_DONTROUTE + | SO_OOBINLINE + external socket : socket_domain -> socket_type -> int -> file_descr = "unix_socket" external socketpair : @@ -390,6 +411,9 @@ let sendto fd buf ofs len flags addr = then invalid_arg "Unix.sendto" else unsafe_sendto fd buf ofs len flags addr +external getsockopt : file_descr -> socket_option -> bool = "unix_getsockopt" +external setsockopt : file_descr -> socket_option -> bool -> unit + = "unix_setsockopt" type host_entry = { h_name : string; h_aliases : string array; @@ -490,10 +514,11 @@ type popen_process = let popen_processes = (Hashtbl.new 7 : (popen_process, int) Hashtbl.t) -let open_proc cmd proc input output = +let open_proc cmd proc input output toclose = 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; + List.iter close toclose; execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; exit 127 | id -> Hashtbl.add popen_processes proc id @@ -501,14 +526,14 @@ let open_proc cmd proc input output = 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; + 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; + open_proc cmd (Process_out outchan) out_read stdout [out_write]; close out_read; outchan @@ -517,27 +542,32 @@ let open_process cmd = 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; (inchan, outchan) + open_proc cmd (Process(inchan, outchan)) + out_read in_write [in_read; out_write]; + (inchan, outchan) -let close_proc fun_name proc = +let find_proc_id fun_name proc = try - let (_, status) = waitpid [] (Hashtbl.find popen_processes proc) in + let pid = Hashtbl.find popen_processes proc in Hashtbl.remove popen_processes proc; - status + pid with Not_found -> raise(Unix_error(EBADF, fun_name, "")) let close_process_in inchan = - close_in inchan; - close_proc "close_process_in" (Process_in inchan) + let pid = find_proc_id "close_process_in" (Process_in inchan) in + close_in inchan; + snd(waitpid [] pid) let close_process_out outchan = + let pid = find_proc_id "close_process_out" (Process_out outchan) in close_out outchan; - close_proc "close_process_out" (Process_out outchan) + snd(waitpid [] pid) let close_process (inchan, outchan) = - close_in inchan; close_out outchan; - close_proc "close_process" (Process(inchan, outchan)) + let pid = find_proc_id "close_process" (Process(inchan, outchan)) in + close_in inchan; close_out outchan; + snd(waitpid [] pid) (* High-level network functions *) @@ -564,7 +594,7 @@ let establish_server server_fun sockaddr = (* 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 *) + 0 -> if fork() <> 0 then exit 0; (* The son exits, the grandson works *) let inchan = in_channel_of_descr s in let outchan = out_channel_of_descr s in server_fun inchan outchan; diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index b54a93706..ce92951d4 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -16,41 +16,45 @@ (*** Error report *) type error = - ENOERR - | EPERM (* Not owner *) - | ENOENT (* No such file or directory *) - | ESRCH (* No such process *) - | EINTR (* Interrupted system call *) - | EIO (* I/O error *) - | ENXIO (* No such device or address *) - | E2BIG (* Arg list too long *) - | ENOEXEC (* Exec format error *) - | EBADF (* Bad file number *) - | ECHILD (* No children *) - | EAGAIN (* No more processes *) - | ENOMEM (* Not enough core *) - | EACCES (* Permission denied *) - | EFAULT (* Bad address *) - | ENOTBLK (* Block device required *) - | EBUSY (* Mount device busy *) + (* Errors defined in the POSIX standard *) + E2BIG (* Argument list too long *) + | EACCESS (* 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 *) - | EXDEV (* Cross-device link *) - | ENODEV (* No such device *) - | ENOTDIR (* Not a directory*) - | EISDIR (* Is a directory *) - | EINVAL (* Invalid argument *) - | ENFILE (* File table overflow *) - | EMFILE (* Too many open files *) - | ENOTTY (* Not a typewriter *) - | ETXTBSY (* Text file busy *) + | EFAULT (* Bad address *) | EFBIG (* File too large *) - | ENOSPC (* No space left on device *) - | ESPIPE (* Illegal seek *) - | EROFS (* Read-only file system *) + | 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 *) - | EDOM (* Argument too large *) | ERANGE (* Result too large *) + | EROFS (* Read-only file system *) + | ESPIPE (* Invalid seek e.g. on a pipe *) + | ESRCH (* No such process *) + | EXDEV (* Invalid link *) + (* Additional errors, mostly BSD *) | EWOULDBLOCK (* Operation would block *) | EINPROGRESS (* Operation now in progress *) | EALREADY (* Operation already in progress *) @@ -78,21 +82,11 @@ type error = | ETOOMANYREFS (* Too many references: can't splice *) | ETIMEDOUT (* Connection timed out *) | ECONNREFUSED (* Connection refused *) - | ELOOP (* Too many levels of symbolic links *) - | ENAMETOOLONG (* File name too long *) | EHOSTDOWN (* Host is down *) | EHOSTUNREACH (* No route to host *) - | ENOTEMPTY (* Directory not empty *) - | EPROCLIM (* Too many processes *) - | EUSERS (* Too many users *) - | EDQUOT (* Disc quota exceeded *) - | ESTALE (* Stale NFS file handle *) - | EREMOTE (* Too many levels of remote in path *) - | EIDRM (* Identifier removed *) - | EDEADLK (* Deadlock condition. *) - | ENOLCK (* No record locks available. *) - | ENOSYS (* Function not implemented *) - | EUNKNOWNERR + | ELOOP (* Too many levels of symbolic links *) + (* All other errors are mapped to EUNKNOWNERR *) + | EUNKNOWNERR (* Unknown error *) (* The type of error codes. *) @@ -121,14 +115,13 @@ external environment : unit -> string array = "unix_environment" type process_status = WEXITED of int - | WSIGNALED of int * bool + | WSIGNALED of int | WSTOPPED of int (* The termination status of a process. [WEXITED] means that the process terminated normally by [exit]; the argument is the return code. [WSIGNALED] means that the process was killed by a signal; - the first argument is the signal number, the second argument - indicates whether a ``core dump'' was performed. [WSTOPPED] means + the argument is the signal number. [WSTOPPED] means that the process was stopped by a signal; the argument is the signal number. *) @@ -159,7 +152,9 @@ external wait : unit -> int * process_status = "unix_wait" external waitpid : wait_flag list -> int -> int * process_status = "unix_waitpid" (* Same as [wait], but waits for the process whose pid is given. - A pid of [0] means wait for any child. + 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. *) @@ -195,7 +190,7 @@ type open_flag = O_RDONLY (* Open for reading *) | O_WRONLY (* Open for writing *) | O_RDWR (* Open for reading and writing *) - | O_NDELAY (* Open in non-blocking mode *) + | 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 *) @@ -330,16 +325,27 @@ external access : string -> access_permission list -> unit = "unix_access" file. Raise [Unix_error] otherwise. *) -(*** File descriptor hacking *) +(*** Operations on file descriptors *) -external fcntl_int : file_descr -> int -> int -> int = "unix_fcntl_int" - (* Interface to [fcntl] in the case where the argument is an - integer. The first integer argument is the command code; - the second is the integer parameter. *) -external fcntl_ptr : file_descr -> int -> string -> int = "unix_fcntl_ptr" - (* Interface to [fcntl] in the case where the argument is a pointer. - The integer argument is the command code. A pointer to the string - argument is passed as argument to the command. *) +external dup : file_descr -> file_descr = "unix_dup" + (* Duplicate a descriptor. *) +external dup2 : file_descr -> file_descr -> unit = "unix_dup2" + (* [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already + opened. *) +external set_nonblock : file_descr -> unit = "unix_set_nonblock" +external clear_nonblock : file_descr -> unit = "unix_clear_nonblock" + (* Set or clear 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]. *) +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" + (* Set or clear 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. *) (*** Directories *) @@ -376,12 +382,6 @@ external pipe : unit -> file_descr * file_descr = "unix_pipe" (* 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 entrace to the pipe. *) -external dup : file_descr -> file_descr = "unix_dup" - (* Duplicate a descriptor. *) -external dup2 : file_descr -> file_descr -> unit = "unix_dup2" - (* [dup2 fd1 fd2] duplicates [fd1] to [fd2], closing [fd2] if already - opened. *) - val open_process_in: string -> in_channel val open_process_out: string -> out_channel @@ -518,6 +518,37 @@ external utimes : string -> int -> int -> unit = "unix_utimes" (third arg) for a file. Times are expressed in seconds from 00:00:00 GMT, Jan. 1, 1970. *) +type interval_timer = + ITIMER_REAL + | ITIMER_VIRTUAL + | ITIMER_PROF + (* The three kinds of interval timers. + [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. *) + +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 *) + +external getitimer: interval_timer -> interval_timer_status = "unix_getitimer" + (* Return the current status of the given interval timer. *) +external setitimer: + interval_timer -> interval_timer_status -> interval_timer_status + = "unix_setitimer" + (* [setitimer t s] set the interval timer [t] and return 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. *) (*** User id, group id *) @@ -584,6 +615,9 @@ external string_of_inet_addr : inet_addr -> string and Internet addresses. [inet_addr_of_string] raises [Failure] when given a string that does not match this format. *) +val inet_addr_any : inet_addr + (* A special Internet address, for use only with [bind], representing + all the Internet addresses that the host machine possesses. *) (*** Sockets *) @@ -612,20 +646,6 @@ type sockaddr = domain; [addr] is the Internet address of the machine, and [port] is the port number. *) -type shutdown_command = - SHUTDOWN_RECEIVE (* Close for receiving *) - | SHUTDOWN_SEND (* Close for sending *) - | SHUTDOWN_ALL (* Close both *) - - (* The type of commands for [shutdown]. *) - -type msg_flag = - MSG_OOB - | MSG_DONTROUTE - | MSG_PEEK - - (* The flags for [recv], [recvfrom], [send] and [sendto]. *) - external socket : socket_domain -> socket_type -> int -> file_descr = "unix_socket" (* Create a new socket in the given domain, and with the @@ -646,16 +666,31 @@ external connect : file_descr -> sockaddr -> unit = "unix_connect" external listen : file_descr -> int -> unit = "unix_listen" (* 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]. *) + external shutdown : file_descr -> shutdown_command -> unit = "unix_shutdown" (* 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). *) + external getsockname : file_descr -> sockaddr = "unix_getsockname" (* Return the address of the given socket. *) external getpeername : file_descr -> sockaddr = "unix_getpeername" (* Return the address of the host connected to the given socket. *) + +type msg_flag = + MSG_OOB + | MSG_DONTROUTE + | MSG_PEEK + (* The flags for [recv], [recvfrom], [send] and [sendto]. *) + val recv : file_descr -> string -> int -> int -> msg_flag list -> int val recvfrom : file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr @@ -665,6 +700,20 @@ val sendto : file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int (* Send data over an unconnected socket. *) +type socket_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 *) + (* The socket options settable with [setsockopt]. *) + +external getsockopt : file_descr -> socket_option -> bool = "unix_getsockopt" + (* Return the current status of an option in the given socket. *) +external setsockopt : file_descr -> socket_option -> bool -> unit + = "unix_setsockopt" + (* Set or clear an option in the given socket. *) (*** High-level network connection functions *) diff --git a/otherlibs/unix/unixsupport.c b/otherlibs/unix/unixsupport.c index 08942454b..50c0b07f4 100644 --- a/otherlibs/unix/unixsupport.c +++ b/otherlibs/unix/unixsupport.c @@ -19,108 +19,117 @@ #include "cst2constr.h" #include <errno.h> -#ifndef EPERM -#define EPERM (-1) -#endif -#ifndef ENOENT -#define ENOENT (-1) -#endif -#ifndef ESRCH -#define ESRCH (-1) -#endif -#ifndef EINTR -#define EINTR (-1) -#endif -#ifndef EIO -#define EIO (-1) -#endif -#ifndef ENXIO -#define ENXIO (-1) -#endif #ifndef E2BIG #define E2BIG (-1) #endif -#ifndef ENOEXEC -#define ENOEXEC (-1) +#ifndef EACCESS +#define EACCESS (-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 EAGAIN -#define EAGAIN (-1) +#ifndef EDEADLK +#define EDEADLK (-1) #endif -#ifndef ENOMEM -#define ENOMEM (-1) +#ifndef EDOM +#define EDOM (-1) #endif -#ifndef EACCES -#define EACCES (-1) +#ifndef EEXIST +#define EEXIST (-1) #endif #ifndef EFAULT #define EFAULT (-1) #endif -#ifndef ENOTBLK -#define ENOTBLK (-1) -#endif -#ifndef EBUSY -#define EBUSY (-1) -#endif -#ifndef EEXIST -#define EEXIST (-1) +#ifndef EFBIG +#define EFBIG (-1) #endif -#ifndef EXDEV -#define EXDEV (-1) +#ifndef EINTR +#define EINTR (-1) #endif -#ifndef ENODEV -#define ENODEV (-1) +#ifndef EINVAL +#define EINVAL (-1) #endif -#ifndef ENOTDIR -#define ENOTDIR (-1) +#ifndef EIO +#define EIO (-1) #endif #ifndef EISDIR #define EISDIR (-1) #endif -#ifndef EINVAL -#define EINVAL (-1) +#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 EMFILE -#define EMFILE (-1) +#ifndef ENODEV +#define ENODEV (-1) #endif -#ifndef ENOTTY -#define ENOTTY (-1) +#ifndef ENOENT +#define ENOENT (-1) #endif -#ifndef ETXTBSY -#define ETXTBSY (-1) +#ifndef ENOEXEC +#define ENOEXEC (-1) #endif -#ifndef EFBIG -#define EFBIG (-1) +#ifndef ENOLCK +#define ENOLCK (-1) +#endif +#ifndef ENOMEM +#define ENOMEM (-1) #endif #ifndef ENOSPC #define ENOSPC (-1) #endif -#ifndef ESPIPE -#define ESPIPE (-1) +#ifndef ENOSYS +#define ENOSYS (-1) #endif -#ifndef EROFS -#define EROFS (-1) +#ifndef ENOTDIR +#define ENOTDIR (-1) #endif -#ifndef EMLINK -#define EMLINK (-1) +#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 EDOM -#define EDOM (-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 @@ -202,12 +211,6 @@ #ifndef ECONNREFUSED #define ECONNREFUSED (-1) #endif -#ifndef ELOOP -#define ELOOP (-1) -#endif -#ifndef ENAMETOOLONG -#define ENAMETOOLONG (-1) -#endif #ifndef EHOSTDOWN #define EHOSTDOWN (-1) #endif @@ -217,47 +220,22 @@ #ifndef ENOTEMPTY #define ENOTEMPTY (-1) #endif -#ifndef EPROCLIM -#define EPROCLIM (-1) -#endif -#ifndef EUSERS -#define EUSERS (-1) -#endif -#ifndef EDQUOT -#define EDQUOT (-1) -#endif -#ifndef ESTALE -#define ESTALE (-1) -#endif -#ifndef EREMOTE -#define EREMOTE (-1) -#endif -#ifndef EIDRM -#define EIDRM (-1) -#endif -#ifndef EDEADLK -#define EDEADLK (-1) -#endif -#ifndef ENOLCK -#define ENOLCK (-1) -#endif -#ifndef ENOSYS -#define ENOSYS (-1) +#ifndef ELOOP +#define ELOOP (-1) #endif int error_table[] = { - 0, EPERM, ENOENT, ESRCH, EINTR, EIO, ENXIO, E2BIG, ENOEXEC, EBADF, - ECHILD, EAGAIN, ENOMEM, EACCES, EFAULT, ENOTBLK, EBUSY, EEXIST, EXDEV, - ENODEV, ENOTDIR, EISDIR, EINVAL, ENFILE, EMFILE, ENOTTY, ETXTBSY, - EFBIG, ENOSPC, ESPIPE, EROFS, EMLINK, EPIPE, EDOM, ERANGE, - 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, ELOOP, - ENAMETOOLONG, EHOSTDOWN, EHOSTUNREACH, ENOTEMPTY, EPROCLIM, EUSERS, - EDQUOT, ESTALE, EREMOTE, EIDRM, EDEADLK, ENOLCK, ENOSYS - /*, EUNKNOWNERROR */ + E2BIG, EACCESS, 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 /*, EUNKNOWNERR */ }; static value unix_error_exn; diff --git a/otherlibs/unix/wait.c b/otherlibs/unix/wait.c index 12579ddac..fa7f77404 100644 --- a/otherlibs/unix/wait.c +++ b/otherlibs/unix/wait.c @@ -16,33 +16,71 @@ #include <memory.h> #include "unix.h" -value unix_wait() /* ML */ +#include <sys/types.h> +#include <sys/wait.h> + +#ifndef WIFEXITED +#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 + +static value alloc_process_status(pid, status) + int pid, status; { - value res; - int pid, status; + value st, res; Push_roots(r, 1); -#define st r[0] - pid = wait(&status); - if (pid == -1) uerror("wait", Nothing); - switch (status & 0xFF) { - case 0: + + if (WIFEXITED(status)) { st = alloc(1, 0); - Field(st, 0) = Val_int((status >> 8) & 0xFF); - break; - case 0177: + Field(st, 0) = Val_int(WEXITSTATUS(status)); + } + else if (WIFSTOPPED(status)) { st = alloc(1, 2); - Field(st, 0) = Val_int((status >> 8) & 0xFF); - break; - default: - st = alloc(2, 1); - Field(st, 0) = Val_int(status & 0x3F); - Field(st, 1) = status & 0200 ? Val_true : Val_false; - break; + Field(st, 0) = Val_int(WSTOPSIG(status)); + } + else { + st = alloc(1, 1); + Field(st, 0) = Val_int(WTERMSIG(status)); } + r[0] = st; res = alloc_tuple(2); Field(res, 0) = Val_int(pid); - Field(res, 1) = st; + Field(res, 1) = r[0]; Pop_roots(); return res; } +value unix_wait() /* ML */ +{ + int pid, status; + Push_roots(r, 1); + pid = wait(&status); + if (pid == -1) uerror("wait", Nothing); + return alloc_process_status(pid, status); +} + +#ifdef HAS_WAITPID + +static int wait_flag_table[] = { + WNOHANG, WUNTRACED +}; + +value unix_waitpid(flags, pid_req) + value flags, pid_req; +{ + int pid, status; + + pid = waitpid(Int_val(pid_req), &status, + convert_flag_list(flags, wait_flag_table)); + if (pid == -1) uerror("waitpid", Nothing); + return alloc_process_status(pid, status); +} + +#else + +value unix_waitpid() { invalid_argument("waitpid not implemented"); } + +#endif diff --git a/otherlibs/unix/waitpid.c b/otherlibs/unix/waitpid.c deleted file mode 100644 index 934bfc7c2..000000000 --- a/otherlibs/unix/waitpid.c +++ /dev/null @@ -1,65 +0,0 @@ -/***********************************************************************/ -/* */ -/* Caml Special Light */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1995 Institut National de Recherche en Informatique et */ -/* Automatique. Distributed only by permission. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include <mlvalues.h> -#include <alloc.h> -#include <memory.h> -#include "unix.h" - -#ifdef HAS_WAITPID - -#include <sys/types.h> -#include <sys/wait.h> - -static int wait_flag_table[] = { - WNOHANG, WUNTRACED -}; - -value unix_waitpid(flags, pid_req) - value flags, pid_req; -{ - int pid, status; - value res; - Push_roots(r, 1); -#define st r[0] - - pid = waitpid(Int_val(pid_req), &status, - convert_flag_list(flags, wait_flag_table)); - if (pid == -1) uerror("waitpid", Nothing); - switch (status & 0xFF) { - case 0: - st = alloc(1, 0); - Field(st, 0) = Val_int((status >> 8) & 0xFF); - break; - case 0177: - st = alloc(1, 2); - Field(st, 0) = Val_int((status >> 8) & 0xFF); - break; - default: - st = alloc(2, 1); - Field(st, 0) = Val_int(status & 0x3F); - Field(st, 1) = status & 0200 ? Val_true : Val_false; - break; - } - res = alloc_tuple(2); - Field(res, 0) = Val_int(pid); - Field(res, 1) = st; - Pop_roots(); - return res; -} - -#else - -value unix_waitpid() { invalid_argument("waitpid not implemented"); } - -#endif |