view release on metacpan or  search on metacpan

slibu.c  view on Meta::CPAN

 if (getcwd(path,sizeof(path)))
   return(strcons(strlen(path),path));
 else
   return(err("getcwd",llast_c_errmsg(-1)));}

#endif

#ifdef unix


LISP ldecode_pwent(struct passwd *p)
{return(symalist(
		 "name",strcons(strlen(p->pw_name),p->pw_name),
		 "passwd",strcons(strlen(p->pw_passwd),p->pw_passwd),
		 "uid",flocons(p->pw_uid),
		 "gid",flocons(p->pw_gid),
		 "dir",strcons(strlen(p->pw_dir),p->pw_dir),
		 "gecos",strcons(strlen(p->pw_gecos),p->pw_gecos),
#if defined(__osf__) || defined(hpux) || defined(sun)
		 "comment",strcons(strlen(p->pw_comment),p->pw_comment),
#endif
#if defined(hpux) || defined(sun)
		 "age",strcons(strlen(p->pw_age),p->pw_age),
#endif
#if defined(__osf__)
		 "quota",flocons(p->pw_quota),
#endif
		 "shell",strcons(strlen(p->pw_shell),p->pw_shell),
		 NULL));}

static char *strfield(char *name,LISP alist)
{LISP value,key = rintern(name);
 if NULLP(value = assq(key,alist))
   return("");
 return(get_c_string(cdr(value)));}

static long longfield(char *name,LISP alist)
{LISP value,key = rintern(name);
 if NULLP(value = assq(key,alist))
   return(0);
 return(get_c_long(cdr(value)));}
 
void lencode_pwent(LISP alist,struct passwd *p)
{p->pw_name = strfield("name",alist);
 p->pw_passwd = strfield("passwd",alist);
 p->pw_uid = longfield("uid",alist);
 p->pw_gid = longfield("gid",alist);
 p->pw_dir = strfield("dir",alist);
 p->pw_gecos = strfield("gecos",alist);
#if defined(__osf__) || defined(hpux) || defined(sun)
 p->pw_comment = strfield("comment",alist);
#endif
#if defined(hpux) || defined(sun)
 p->pw_age = strfield("age",alist);
#endif
#if defined(__osf__)
 p->pw_quota = longfield("quota",alist);
#endif
 p->pw_shell = strfield("shell",alist);}

LISP lgetpwuid(LISP luid)
{int iflag;
 uid_t uid;
 struct passwd *p;
 LISP result = NIL;
 uid = get_c_long(luid);
 iflag = no_interrupt(1);
 if ((p = getpwuid(uid)))
   result = ldecode_pwent(p);
 no_interrupt(iflag);
 return(result);}

LISP lgetpwnam(LISP nam)
{int iflag;
 struct passwd *p;
 LISP result = NIL;
 iflag = no_interrupt(1);
 if ((p = getpwnam(get_c_string(nam))))
   result = ldecode_pwent(p);
 no_interrupt(iflag);
 return(result);}

LISP lgetpwent(void)
{int iflag;
 LISP result = NIL;
 struct passwd *p;
 iflag = no_interrupt(1);
 if ((p = getpwent()))
   result = ldecode_pwent(p);
 no_interrupt(iflag);
 return(result);}

LISP lsetpwent(void)
{int iflag = no_interrupt(1);
 setpwent();
 no_interrupt(iflag);
 return(NIL);}

LISP lendpwent(void)
{int iflag = no_interrupt(1);
 endpwent();
 no_interrupt(iflag);
 return(NIL);}

LISP lsetuid(LISP n)
{uid_t uid;
 uid = (uid_t) get_c_long(n);
 if (setuid(uid))
   return(err("setuid",llast_c_errmsg(-1)));
 else
   return(NIL);}

LISP lseteuid(LISP n)
{uid_t uid;
 uid = (uid_t) get_c_long(n);
 if (seteuid(uid))
   return(err("seteuid",llast_c_errmsg(-1)));
 else
   return(NIL);}

LISP lgeteuid(void)
{return(flocons(geteuid()));}

#if defined(__osf__)
LISP lsetpwfile(LISP fname)
{int iflag = no_interrupt(1);
 setpwfile(get_c_string(fname));
 no_interrupt(iflag);

slibu.c  view on Meta::CPAN

 for(k=1;k<argc;++k) nargv[j++] = argv[k];
 *pargc = nargc;
 *pargv = nargv;
 }

LISP lposition_script(LISP lfile)
{FILE *f;
 long iflag,pos;
 char flbuff[100];
 f = get_c_file(lfile,stdin);
 iflag = no_interrupt(1);
 pos = position_script(f,flbuff,sizeof(flbuff));
 no_interrupt(iflag);
 if (pos < 0) return(NIL);
 return(cons(flocons(pos),strcons(-1,flbuff)));}

void __stdcall siod_init(int argc,char **argv)
{process_cla(argc,argv,0);
 init_storage();
 init_subrs();
 init_trace();
 init_slibu();}
 
void __stdcall init_slibu(void)
{long j;
#if defined(unix)
 char *tmp1,*tmp2;
#endif
#if defined(unix) || defined(WIN32)
 tc_opendir = allocate_user_tc();
 set_gc_hooks(tc_opendir,
	      NULL,
	      NULL,
	      NULL,
	      opendir_gc_free,
	      &j);
 set_print_hooks(tc_opendir,opendir_prin1);
 init_subr_2("chmod",lisp_chmod);
#endif

 gc_protect_sym(&sym_channels,"*channels*");
 setvar(sym_channels,NIL,NIL);
#ifdef WIN32
 init_subr_0("win32-debug",win32_debug);
#endif
#ifdef VMS
 init_subr_1("vms-debug",vms_debug);
 init_lsubr("sys$crembx",lcrembx);
 init_subr_4("lib$set_logical",lset_logical);
#endif
 init_lsubr("system",lsystem);
#ifndef WIN32
 init_subr_0("getgid",lgetgid);
 init_subr_0("getuid",lgetuid);
#endif
#if defined(unix) || defined(WIN32)
 init_subr_0("getcwd",lgetcwd);
#endif
#ifdef unix
 init_subr_2("crypt",lcrypt);
 init_subr_1("getpwuid",lgetpwuid);
 init_subr_1("getpwnam",lgetpwnam);
 init_subr_0("getpwent",lgetpwent);
 init_subr_0("setpwent",lsetpwent);
 init_subr_0("endpwent",lendpwent);
 init_subr_1("setuid",lsetuid);
 init_subr_1("seteuid",lseteuid);
 init_subr_0("geteuid",lgeteuid);
#if defined(__osf__)
 init_subr_1("setpwfile",lsetpwfile);
#endif
 init_subr_2("putpwent",lputpwent);
 init_subr_2("access-problem?",laccess_problem);
 init_subr_3("utime",lutime);
 init_subr_2("fchmod",lfchmod);
#endif
 init_subr_1("random",lrandom);
 init_subr_1("srandom",lsrandom);
 init_subr_1("first",car);
 init_subr_1("rest",cdr);
#ifdef unix
 init_subr_0("fork",lfork);
 init_subr_3("exec",lexec);
 init_subr_1("nice",lnice);
 init_subr_2("wait",lwait);
 init_subr_0("getpgrp",lgetpgrp);
 init_subr_1("getgrgid",lgetgrgid);
 init_subr_2("kill",lkill);
#endif
 init_subr_1("%%%memref",lmemref_byte);
 init_subr_0("getpid",lgetpid);
#ifndef WIN32
 init_subr_0("getppid",lgetppid);
#endif
 init_subr_1("exit",lexit);
 init_subr_1("trunc",ltrunc);
#ifdef unix
 init_subr_1("putenv",lputenv);
#endif
 init_subr_0("md5-init",md5_init);
 init_subr_3("md5-update",md5_update);
 init_subr_1("md5-final",md5_final);
#if defined(__osf__) || defined(sun)
 init_subr_2("cpu-usage-limits",cpu_usage_limits);
#endif
#if defined(__osf__) || defined(SUN5)
 init_subr_1("current-resource-usage",current_resource_usage);
#endif
#if  defined(unix) || defined(WIN32)
 init_subr_1("opendir",l_opendir);
 init_subr_1("closedir",l_closedir);
 init_subr_1("readdir",l_readdir);
#endif
 init_subr_1("delete-file",delete_file);
 init_subr_1("file-times",file_times);
 init_subr_1("unix-time->strtime",utime2str);
 init_subr_0("unix-time",unix_time);
 init_subr_1("unix-ctime",unix_ctime);
 init_subr_1("getenv",lgetenv);
 init_subr_1("sleep",lsleep);
 init_subr_1("url-encode",url_encode);