diff options
Diffstat (limited to 'otherlibs/unix/unix.ml')
| -rw-r--r-- | otherlibs/unix/unix.ml | 536 |
1 files changed, 0 insertions, 536 deletions
diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml deleted file mode 100644 index 729105ca18..0000000000 --- a/otherlibs/unix/unix.ml +++ /dev/null @@ -1,536 +0,0 @@ -type error = - ENOERR - | 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 - | EUNKNOWNERR - -exception Unix_error of error * string * string - -external register_unix_error: exn -> unit = "unix_register_error" - -let _ = register_unix_error(Unix_error(EUNKNOWNERR, "", "")) - -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" - -type process_status = - WEXITED of int - | WSIGNALED of int * bool - | WSTOPPED of int - -type wait_flag = - WNOHANG - | WUNTRACED - -external execv : string -> string array -> unit = "unix_execv" -external execve : string -> string array -> string array -> unit = "unix_execve" -external execvp : string -> string array -> unit = "unix_execvp" -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_NDELAY - | O_APPEND - | O_CREAT - | O_TRUNC - | O_EXCL - -type file_perm = int - - -external openfile : string -> open_flag list -> file_perm -> file_descr - = "unix_open" -external close : file_descr -> unit = "unix_close" -external read : file_descr -> string -> int -> int -> int = "unix_read" -external write : file_descr -> string -> int -> int -> int = "unix_write" -external in_channel_of_descr : file_descr -> in_channel = "open_descriptor" -external out_channel_of_descr : file_descr -> out_channel = "open_descriptor" -external descr_of_in_channel : in_channel -> file_descr = "channel_descriptor" -external descr_of_out_channel : out_channel -> file_descr = "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 : int; - st_mtime : int; - st_ctime : int } - -external stat : string -> stats = "unix_stat" -external lstat : string -> stats = "unix_lstat" -external fstat : file_descr -> stats = "unix_fstat" -external unlink : string -> unit = "unix_unlink" -external rename : string -> string -> unit = "unix_rename" -external link : string -> string -> unit = "unix_link" - -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 fcntl_int : file_descr -> int -> int -> int = "unix_fcntl_int" -external fcntl_ptr : file_descr -> int -> string -> int = "unix_fcntl_ptr" -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" - -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 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" -external ioctl_int : file_descr -> int -> int -> int = "unix_ioctl_int" -external ioctl_ptr : file_descr -> int -> string -> int = "unix_ioctl_ptr" -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 - -external lockf : file_descr -> lock_command -> int -> unit = "unix_lockf" -external kill : int -> int -> unit = "unix_kill" -external pause : unit -> unit = "unix_pause" - -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 -> int = "unix_time" -external gmtime : int -> tm = "unix_gmtime" -external localtime : int -> tm = "unix_localtime" -external alarm : int -> int = "unix_alarm" -external sleep : int -> unit = "unix_sleep" -external times : unit -> process_times = "unix_times" -external utimes : string -> int -> int -> unit = "unix_utimes" -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" - -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 - -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" -type socket_domain = - PF_UNIX - | PF_INET - -type socket_type = - SOCK_STREAM - | SOCK_DGRAM - | SOCK_RAW - | SOCK_SEQPACKET - -type sockaddr = - ADDR_UNIX of string - | ADDR_INET of inet_addr * int - -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 recv : file_descr -> string -> int -> int -> msg_flag list -> int - = "unix_recv" -external recvfrom : - file_descr -> string -> int -> int -> msg_flag list -> int * sockaddr - = "unix_recvfrom" -external send : file_descr -> string -> int -> int -> msg_flag list -> int - = "unix_send" -external sendto : - file_descr -> string -> int -> int -> msg_flag list -> sockaddr -> int - = "unix_sendto" - -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 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_olcuc: bool; - mutable c_onlcr: bool; - mutable c_ocrnl: bool; - mutable c_onocr: bool; - mutable c_onlret: bool; - mutable c_ofill: bool; - mutable c_ofdel: bool; - mutable c_nldly: int; - mutable c_crdly: int; - mutable c_tabdly: int; - mutable c_bsdly: int; - mutable c_vtdly: int; - mutable c_ffdly: int; - 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" - -(* High-level process management (system, popen) *) - -let system cmd = - match fork() with - 0 -> execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; exit 127 - | id -> snd(waitpid [] id) - -type popen_process = - Process of in_channel * out_channel - | Process_in of in_channel - | Process_out of out_channel - -let popen_processes = (Hashtbl.new 7 : (popen_process, int) Hashtbl.t) - -let open_proc cmd proc input output = - 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; - execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]; - exit 127 - | 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; 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; 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; (inchan, outchan) - -let close_proc fun_name proc = - try - let (_, status) = waitpid [] (Hashtbl.find popen_processes proc) in - Hashtbl.remove popen_processes proc; - status - 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 close_process_out outchan = - close_out outchan; - close_proc "close_process_out" (Process_out outchan) - -let close_process (inchan, outchan) = - close_in inchan; close_out outchan; - close_proc "close_process" (Process(inchan, outchan)) - -(* High-level network functions *) - -let open_connection sockaddr = - let domain = - match sockaddr with ADDR_UNIX _ -> PF_UNIX | ADDR_INET(_,_) -> PF_INET in - let sock = - socket domain SOCK_STREAM 0 in - connect sock sockaddr; - (in_channel_of_descr sock, out_channel_of_descr sock) - -let shutdown_connection inchan = - shutdown (descr_of_in_channel inchan) SHUTDOWN_SEND - -let establish_server server_fun sockaddr = - let domain = - match sockaddr with ADDR_UNIX _ -> PF_UNIX | ADDR_INET(_,_) -> PF_INET in - let sock = - socket domain SOCK_STREAM 0 in - bind sock sockaddr; - listen sock 3; - while true do - let (s, caller) = accept 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 *) - let inchan = in_channel_of_descr s in - let outchan = out_channel_of_descr s in - server_fun inchan outchan; - close_in inchan; - close_out outchan - | id -> close s; waitpid [] id (* Reclaim the son *); () - done |