LISP lrename(LISP p1,LISP p2)
{long iflag;
iflag = no_interrupt(1);
if (rename(get_c_string(p1),get_c_string(p2)))
return(err("rename",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
LISP lmkdir(LISP p,LISP m)
{long iflag;
iflag = no_interrupt(1);
if (mkdir(get_c_string(p),get_c_long(m)))
return(err("mkdir",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
LISP lrmdir(LISP p)
{long iflag;
iflag = no_interrupt(1);
if (rmdir(get_c_string(p)))
return(err("rmdir",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
LISP lunlink(LISP p)
{long iflag;
iflag = no_interrupt(1);
if (unlink(get_c_string(p)))
return(err("unlink",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
LISP llink(LISP p1,LISP p2)
{long iflag;
iflag = no_interrupt(1);
if (link(get_c_string(p1),get_c_string(p2)))
return(err("link",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(NIL);}
LISP laccess_problem(LISP lfname,LISP lacc)
{char *fname = get_c_string(lfname);
char *acc = get_c_string(lacc),*p;
int amode = 0,iflag = no_interrupt(1),retval;
for(p=acc;*p;++p)
switch(*p)
{case 'r':
amode |= R_OK;
break;
case 'w':
amode |= W_OK;
break;
case 'x':
amode |= X_OK;
break;
case 'f':
amode |= F_OK;
break;
default:
err("bad access mode",lacc);}
retval = access(fname,amode);
no_interrupt(iflag);
if (retval < 0)
return(llast_c_errmsg(-1));
else
return(NIL);}
LISP lkill(LISP pid,LISP sig)
{long iflag;
iflag = no_interrupt(1);
if (kill(get_c_long(pid),
NULLP(sig) ? SIGKILL : get_c_long(sig)))
err("kill",llast_c_errmsg(-1));
else
no_interrupt(iflag);
return(NIL);}
LISP lnice(LISP val)
{int iflag,n;
n = get_c_long(val);
iflag = no_interrupt(1);
n = nice(n);
if (n == -1)
err("nice",llast_c_errmsg(-1));
no_interrupt(iflag);
return(flocons(n));}
LISP lreadlink(LISP p)
{long iflag;
char buff[PATH_MAX+1];
int size;
iflag = no_interrupt(1);
if ((size = readlink(get_c_string(p),buff,sizeof(buff))) < 0)
return(err("readlink",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(strcons(size,buff));}
LISP lsystem(LISP args)
{int retval;
long iflag;
iflag = no_interrupt(1);
retval = system(get_c_string(string_append(args)));
no_interrupt(iflag);
if (retval < 0)
return(cons(flocons(retval),llast_c_errmsg(-1)));
else
return(flocons(retval));}
LISP lputenv(LISP lstr)
{char *orig,*cpy;
orig = get_c_string(lstr);
/* unix putenv keeps a pointer to the string we pass,
therefore we must make a fresh copy, which is memory leaky. */
cpy = (char *) must_malloc(strlen(orig)+1);
strcpy(cpy,orig);
if (putenv(cpy))
return(err("putenv",llast_c_errmsg(-1)));
else
return(NIL);}
LISP lfork(void)
{int iflag;
pid_t pid;
iflag = no_interrupt(1);
pid = fork();
if (pid == 0)
{no_interrupt(iflag);
return(NIL);}
if (pid == -1)
return(err("fork",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(flocons(pid));}
LISP lexec(LISP path,LISP args,LISP env)
{int iflag;
char **argv = NULL, **envp = NULL;
LISP gcsafe=NIL;
iflag = no_interrupt(1);
argv = list2char(&gcsafe,args);
if NNULLP(env)
envp = list2char(&gcsafe,env);
if (envp)
execve(get_c_string(path),argv,envp);
else
execv(get_c_string(path),argv);
no_interrupt(iflag);
return(err("exec",llast_c_errmsg(-1)));}
LISP lwait(LISP lpid,LISP loptions)
{pid_t pid,ret;
int iflag,status = 0,options;
pid = NULLP(lpid) ? -1 : get_c_long(lpid);
options = assemble_options(loptions,
#ifdef WCONTINUED
"WCONTINUED",WCONTINUED,
#endif
#ifdef WNOWAIT
"WNOWAIT",WNOWAIT,
#endif
"WNOHANG",WNOHANG,
"WUNTRACED",WUNTRACED,
NULL);
iflag = no_interrupt(1);
ret = waitpid(pid,&status,options);
no_interrupt(iflag);
if (ret == 0)
return(NIL);
else if (ret == -1)
return(err("wait",llast_c_errmsg(-1)));
else
/* should do more decoding on the status */
return(cons(flocons(ret),cons(flocons(status),NIL)));}
LISP lgetcwd(void)
{char path[PATH_MAX+1];
if (getcwd(path,sizeof(path)))
return(strcons(strlen(path),path));
else
return(err("getcwd",llast_c_errmsg(-1)));}
LISP lstatfs(LISP path)
{long iflag;
struct statfs s;
iflag = no_interrupt(1);
if (statfs(get_c_string(path),&s,sizeof(s)))
return(err("statfs",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(symalist("type",(((s.f_type >= 0) && (s.f_type < MNT_NUMTYPES) &&
mnt_names[s.f_type])
? rintern(mnt_names[s.f_type])
: flocons(s.f_type)),
"bsize",flocons(s.f_bsize),
"blocks",flocons(s.f_blocks),
"bfree",flocons(s.f_bfree),
"bavail",flocons(s.f_bavail),
"files",flocons(s.f_files),
"ffree",flocons(s.f_ffree),
"mntonname",strcons(-1,s.f_mntonname),
"mntfromname",strcons(-1,s.f_mntfromname),
NULL));}
