Val _lib7_P_SysDB_getgrnam (Task* task, Val arg) {
//======================
//
// Mythryl type: String -> (String, Unt, List(String))
//
// Get group file entry by name.
//
// This fn gets bound as getgrname' in:
//
// src/lib/std/src/posix-1003.1b/posix-etc.pkg
struct group* info = getgrnam( HEAP_STRING_AS_C_STRING( arg ));
if (info == NULL) return RAISE_SYSERR(task, -1);
Val gr_name = make_ascii_string_from_c_string( task, info->gr_name );
Val gr_gid;
WORD_ALLOC (task, gr_gid, (Val_Sized_Unt)(info->gr_gid));
Val gr_mem = make_ascii_strings_from_vector_of_c_strings( task, info->gr_mem );
Val result;
REC_ALLOC3(task, result, gr_name, gr_gid, gr_mem);
return result;
}
/* _lib7_win32_PS_system : String -> word32
* command
*
*/
lib7_val_t _lib7_win32_PS_system(lib7_state_t *lib7_state, lib7_val_t arg)
{
int ret = system(STR_LIB7toC(arg));
lib7_val_t res;
WORD_ALLOC(lib7_state, res, (Word_t)ret);
return res;
}
/* _lib7_P_ProcEnv_getgid: Void -> word
*
* Return group id
*/
lib7_val_t _lib7_P_ProcEnv_getgid (lib7_state_t *lib7_state, lib7_val_t arg)
{
lib7_val_t p;
WORD_ALLOC (lib7_state, p, (Word_t)(getgid()));
return p;
} /* end of _lib7_P_ProcEnv_getgid */
/* _lib7_win32_PS_system : String -> one_word_unt
* command
*
*/
Val _lib7_win32_PS_system(Task *task, Val arg)
{
int ret = system(HEAP_STRING_AS_C_STRING(arg));
Val res;
WORD_ALLOC(task, res, (Val_Sized_Unt)ret);
return res;
}
/* _lib7_win32_PS_create_process : String -> word32
*
* Note: This function returns the handle to the created process
* This handle will need to be freed before the system releases
* the memory associated to the process.
* We will take care of this in the wait_for_single_chunk
* call. This is for the time being only used by threadkit.
* It could also cause problems later on.
*/
lib7_val_t _lib7_win32_PS_create_process(lib7_state_t *lib7_state, lib7_val_t arg)
{
char *str = STR_LIB7toC(arg);
PROCESS_INFORMATION pi;
STARTUPINFO si;
lib7_val_t res;
BOOL fSuccess;
ZeroMemory (&si,sizeof(si));
si.cb = sizeof(si);
fSuccess = CreateProcess (NULL,str,NULL,NULL,FALSE,0,NULL,NULL,&si,&pi);
if (fSuccess) {
HANDLE hProcess = pi.hProcess;
CloseHandle (pi.hThread);
WORD_ALLOC (lib7_state,res,(Word_t)hProcess);
return res;
}
WORD_ALLOC (lib7_state,res,(Word_t)0);
return res;
}
/* _lib7_win32_PS_create_process : String -> one_word_unt
*
* Note: This function returns the handle to the created process
* This handle will need to be freed before the system releases
* the memory associated to the process.
* We will take care of this in the wait_for_single_chunk
* call. This is for the time being only used by threadkit.
* It could also cause problems later on.
*/
Val _lib7_win32_PS_create_process(Task *task, Val arg)
{
char *str = HEAP_STRING_AS_C_STRING(arg);
PROCESS_INFORMATION pi;
STARTUPINFO si;
Val res;
BOOL fSuccess;
ZeroMemory (&si,sizeof(si));
si.cb = sizeof(si);
fSuccess = CreateProcess (NULL,str,NULL,NULL,FALSE,0,NULL,NULL,&si,&pi);
if (fSuccess) {
HANDLE hProcess = pi.hProcess;
CloseHandle (pi.hThread);
WORD_ALLOC (task,res,(Val_Sized_Unt)hProcess);
return res;
}
WORD_ALLOC (task,res,(Val_Sized_Unt)0);
return res;
}
/* _lib7_win32_IO_set_file_pointer: (one_word_unt * one_word_unt * one_word_unt) -> one_word_unt
* handle dist how
*/
Val _lib7_win32_IO_set_file_pointer(Task *task, Val arg)
{
HANDLE h = (HANDLE) WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg,0));
LONG dist = (LONG) WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg,1));
DWORD how = (DWORD) WORD_LIB7toC(GET_TUPLE_SLOT_AS_VAL(arg,2));
Val_Sized_Unt w;
Val res;
w = SetFilePointer(h,dist,NULL,how);
WORD_ALLOC(task, res, w);
return res;
}
/* _lib7_win32_IO_get_std_handle: one_word_unt -> one_word_unt
* interface to win32 GetStdHandle
*/
Val _lib7_win32_IO_get_std_handle(Task *task, Val arg)
{
Val_Sized_Unt w = WORD_LIB7toC(arg);
HANDLE h = GetStdHandle(w);
Val res;
#ifdef WIN32_DEBUG
debug_say("getting std handle for %x as %x\n", w, (unsigned int) h);
#endif
WORD_ALLOC(task, res, (Val_Sized_Unt)h);
return res;
}
/* mkStatRep:
*
* This makes a representation of the struct stat to be returned
* to the SML side. It is a tuple with the following fields:
*
* file_type : int
* mode : word
* ino : word
* dev : word
* nlink : word
* uid : word
* gid : word
* sizehi : word
* sizelo : word
* atime : Int32.int
* mtime : Int32.int
* ctime : Int32.int
*/
PVT ml_val_t mkStatRep (ml_state_t *msp, struct stat *buf)
{
int ftype;
ml_val_t mode, ino, dev, uid, gid, nlink, sr, atime, mtime, ctime,
szhi, szlo;
#if ((S_IFDIR != 0x4000) || (S_IFCHR != 0x2000) || (S_IFBLK != 0x6000) || (S_IFREG != 0x8000) || (S_IFIFO != 0x1000) || (S_IFLNK != 0xA000) || (S_IFSOCK != 0xC000))
if (S_ISDIR(buf->st_mode)) ftype = 0x4000;
else if (S_ISCHR(buf->st_mode)) ftype = 0x2000;
else if (S_ISBLK(buf->st_mode)) ftype = 0x6000;
else if (S_ISREG(buf->st_mode)) ftype = 0x8000;
else if (S_ISFIFO(buf->st_mode)) ftype = 0x1000;
#ifdef S_ISLNK
else if (S_ISLNK(buf->st_mode)) ftype = 0xA000;
#endif
#ifdef S_ISSOCK
else if (S_ISSOCK(buf->st_mode)) ftype = 0xC000;
#endif
else ftype = 0;
#else
ftype = buf->st_mode & 0xF000;
#endif
WORD_ALLOC (msp, mode, (Word_t)((buf->st_mode) & MODE_BITS));
WORD_ALLOC (msp, ino, (Word_t)(buf->st_ino));
WORD_ALLOC (msp, dev, (Word_t)(buf->st_dev));
WORD_ALLOC (msp, nlink, (Word_t)(buf->st_nlink));
WORD_ALLOC (msp, uid, (Word_t)(buf->st_uid));
WORD_ALLOC (msp, gid, (Word_t)(buf->st_gid));
if (sizeof(buf->st_size)>4) {
WORD_ALLOC (msp, szhi, (Word_t)(buf->st_size >> 32));
} else {
Val _lib7_P_ProcEnv_getuid (Task* task, Val arg) {
//======================
//
// Mythryl type: Void -> Unt
//
// Return user id.
//
// This fn gets bound as get_user_id in:
//
// src/lib/std/src/posix-1003.1b/posix-id.pkg
Val result;
WORD_ALLOC (task, result, (Val_Sized_Unt) (getuid()));
return result;
}
/* _ml_P_Dynload_dlsym : Word32.word * string -> Word32.word
*
* Extract symbol from dynamically loaded library.
*/
ml_val_t _ml_U_Dynload_dlsym (ml_state_t *msp, ml_val_t arg)
{
ml_val_t ml_handle = REC_SEL (arg, 0);
char *symname = STR_MLtoC (REC_SEL (arg, 1));
void *handle = (void *) (WORD_MLtoC (ml_handle));
void *addr;
ml_val_t res;
#ifdef OPSYS_WIN32
addr = GetProcAddress (handle, symname);
if (addr == NULL && symname != NULL)
dlerror_set ("Symbol `%s' not found", symname);
#else
addr = dlsym (handle, symname);
#endif
WORD_ALLOC (msp, res, (Word_t) addr);
return res;
}
static Val mkList (Task* task, int ngrps, gid gidset[]) {
// ======
//
// Convert array of gid_t into a list of gid_t
Val w;
// NOTE: We should do something about possible cleaning!!! XXX BUGGO FIXME
Val p = LIST_NIL;
while (ngrps-- > 0) {
//
WORD_ALLOC (task, w, (Val_Sized_Unt)(gidset[ngrps]));
LIST_CONS(task, p, w, p);
}
return p;
}
lib7_val_t _lib7_win32_PS_wait_for_single_chunk(lib7_state_t *lib7_state, lib7_val_t arg)
{
HANDLE hProcess = (HANDLE) WORD_LIB7toC (arg);
DWORD exit_code;
int res;
lib7_val_t p,chunk;
res = WaitForSingleChunkect (hProcess,0);
if (res==WAIT_TIMEOUT || res==WAIT_FAILED) {
/* information is not ready, or error */
chunk = OPTION_NONE;
}
else {
/* WAIT_CHUNKECT_0 ... done, finished */
/* get info and return THE(exit_status) */
GetExitCodeProcess (hProcess,&exit_code);
CloseHandle (hProcess); /* decrease ref count */
WORD_ALLOC (lib7_state,p,(Word_t)exit_code);
OPTION_SOME(lib7_state,chunk,p);
}
return chunk;
}
Val _lib7_win32_PS_wait_for_single_chunk(Task *task, Val arg)
{
HANDLE hProcess = (HANDLE) WORD_LIB7toC (arg);
DWORD exit_code;
int res;
Val p,chunk;
res = WaitForSingleChunkect (hProcess,0);
if (res==WAIT_TIMEOUT || res==WAIT_FAILED) {
/* information is not ready, or error */
chunk = OPTION_NULL;
}
else {
/* WAIT_CHUNKECT_0 ... done, finished */
/* get info and return THE(exit_status) */
GetExitCodeProcess (hProcess,&exit_code);
CloseHandle (hProcess); /* decrease ref count */
WORD_ALLOC (task,p,(Val_Sized_Unt)exit_code);
OPTION_THE(task,chunk,p);
}
return chunk;
}
Val _lib7_P_ProcEnv_sysconf (Task* task, Val arg) {
//=======================
//
// Mythryl type: String -> Unt
//
// Get configurable system variables
//
// This fn gets bound as sysconf in:
//
// src/lib/std/src/posix-1003.1b/posix-process.pkg
name_val_t* attribute = _lib7_posix_nv_lookup(HEAP_STRING_AS_C_STRING(arg), values, NUMELMS);
//
if (!attribute) {
//
errno = EINVAL;
return RAISE_SYSERR(task, -1);
}
long val;
errno = 0;
//
while (((val = sysconf(attribute->val)) == -1) && (errno == EINTR)) {
errno = 0;
continue;
}
if (val >= 0) {
//
Val result;
WORD_ALLOC (task, result, val);
return result;
}
if (errno == 0) return RAISE_ERROR(task, "unsupported POSIX feature");
else return RAISE_SYSERR(task, -1);
}