0000480: Feature wish: More Unix

View Issue Details [ Jump to Notes ]

[ Issue History ] [ Print ]

Project

Category

View Status

Date Submitted

Last Update

0000480

OCaml

OCaml general

public

2001-08-10 00:46

2002-11-13 16:15

Reporter

administrator

Assigned To

Priority

normal

Severity

feature

Reproducibility

always

Status

acknowledged

Resolution

open

Platform

OS Version

Product Version

Target Version

Fixed in Version

Summary

0000480: Feature wish: More Unix

Description

Full_Name: Gerd Stolpmann
Version:
OS: Unix
Submission from: drms-3e357804.pool.mediaways.net (62.53.120.4)

I think the following Unix calls should be included into the Unix module.
I missed them when I tried to program an enhanced create_process. I hope
you find them useful, too.

Gerd

--- unix_exts.mli: ---------------------------------------------------

val int_of_file_descr : file_descr -> int;;
val file_descr_of_int : int -> file_descr;;
  (* Convert file_descrs to/from ints, because it is sometimes necessary
     to know the corresponding ints.
   *)

external is_open_descr : file_descr -> bool = "unix_is_open_descr";;
  (* Is a desctiptor open? *)

external _exit : int -> unit = "unix__exit";;

(* Limits & resources *)

external sysconf_open_max : unit -> int = "unix_sysconf_open_max";;
(* max number of open file descriptors per process. This is important to know
   if you want to close all file descriptors of a process. -
   Alternatively, a "close_all" or "iter_file_descr" would be ok, too.
*)

(* Process groups, sessions, terminals *)

(* Important to emulate shell functionality *)

external getpgid : int -> int = "unix_getpgid";;
val getpgrp : unit -> int;;
external setpgid : int -> int -> unit = "unix_setpgid";;
val setpgrp : unit -> unit;;

external tcgetpgrp : file_descr -> int = "unix_tcgetpgrp";;
external tcsetpgrp : file_descr -> int -> unit = "unix_tcsetpgrp";;

external ctermid : unit -> string = "unix_ctermid";;
external ttyname : file_descr -> string = "unix_ttyname";;

external getsid : int -> int = "unix_getsid";;

(* Users and groups *)

(* These are a MUST. It is currently impossible to write daemons that start as
   root, drop privileges, and regain them if needed
*)

external setreuid : int -> int -> unit = "unix_setreuid";;
external setregid : int -> int -> unit = "unix_setregid";;

--- unix_exts.ml: ---------------------------------------------------

open Unix;;
let int_of_file_descr fd = (Obj.magic (fd:file_descr) : int);;
let file_descr_of_int n = (Obj.magic (n:int) : file_descr);;
  (* Works only for real Unixes. These functions should fail for
     OS that do not represent file descriptors as numbers *)

external is_open_descr : file_descr -> bool = "unix_is_open_descr";;

external _exit : int -> unit = "unix__exit";;

(* Limits & resources *)

external sysconf_open_max : unit -> int = "unix_sysconf_open_max";;

(* Process groups, sessions, terminals *)

external getpgid : int -> int = "unix_getpgid";;
let getpgrp() = getpgid 0;;
external setpgid : int -> int -> unit = "unix_setpgid";;
let setpgrp() = setpgid 0 0;;

external tcgetpgrp : file_descr -> int = "unix_tcgetpgrp";;
external tcsetpgrp : file_descr -> int -> unit = "unix_tcsetpgrp";;

external ctermid : unit -> string = "unix_ctermid";;
external ttyname : file_descr -> string = "unix_ttyname";;

external getsid : int -> int = "unix_getsid";;

--- unix_exts_c.c: ---------------------------------------------------

/* Linux: make all system prototypes available */
#define _GNU_SOURCE

#include "caml/mlvalues.h"
#include "caml/alloc.h"
#include <unistd.h>
#include <stdio.h>
#include <fcntl.h>
#include <errno.h>
#include <signal.h>

/**********************************************************************/
/* From unixsupport.h */
/**********************************************************************/

#define Nothing ((value) 0)

extern void unix_error (int errcode, char * cmdname, value arg) Noreturn;
extern void uerror (char * cmdname, value arg) Noreturn;

/**********************************************************************/

value unix_is_open_descr (value fd) {
    int r;
    r = fcntl(Int_val(fd), F_GETFL);
    if (r == -1) {
        if (errno == EBADF) return Val_false;
        uerror("fcntl", Nothing);
    };
    return Val_true;
}

value unix__exit (value n) {
    _exit(Int_val(n));
    return Val_int(0);
}

value unix_sysconf_open_max (value unit) {
    return Val_long(sysconf(_SC_OPEN_MAX));
}

value unix_getpgid (value pid) {
    int pgid;

    pgid = getpgid(Int_val(pid));
    if (pgid == -1) uerror("getpgid", Nothing);
    return Val_int(pgid);
}

value unix_setpgid (value pid, value pgid) {
    int r;

    r = setpgid(Int_val(pid), Int_val(pgid));
    if (r == -1) uerror("setpgid", Nothing);
    return Val_int(0);
}

value unix_tcgetpgrp (value fd) {
    int pgid;

    pgid = tcgetpgrp(Int_val(fd));
    if (pgid == -1) uerror("tcgetpgrp", Nothing);
    return Val_int(pgid);
}

alue unix_tcsetpgrp (value fd, value pgid) {
    int r;

    r = tcsetpgrp(Int_val(fd), Int_val(pgid));
    if (r == -1) uerror("tcsetpgrp", Nothing);
    return Val_int(0);
}

value unix_ctermid (value unit) {
    return copy_string(ctermid(NULL));
    /* ctermid is always successful; however it can return an empty string */
}

value unix_ttyname (value fd) {
    char *s;

    s = ttyname(Int_val(fd));
    if ( s == NULL ) uerror("ttyname", Nothing);
    return copy_string(s);
}

value unix_getsid (value pid) {
    int sid;

    sid = getsid(Int_val(pid));
    if ( sid == -1 ) uerror("getsid", Nothing);
    return Val_int(sid);
}

value unix_setreuid(value ruid, value euid) {
    int r;

    r = setreuid(Int_val(ruid), Int_val(euid));
    if (r == -1) uerror("setreuid", Nothing);
    return Val_int(0);
}

value unix_setregid(value rgid, value egid) {
    int r;

    r = setregid(Int_val(rgid), Int_val(egid));
    if (r == -1) uerror("setregid", Nothing);
    return Val_int(0);
}

Issue History
Date Modified	Username	Field	Change
2005-11-18 10:13	administrator	New Issue

Notes
(0000113) administrator (administrator) 2002-11-13 16:15	OK for setreuid and setregid; others are provided by Cash.

Relationships