=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Kan/ext.c,v retrieving revision 1.1 retrieving revision 1.36 diff -u -p -r1.1 -r1.36 --- OpenXM/src/kan96xx/Kan/ext.c 1999/10/08 02:12:02 1.1 +++ OpenXM/src/kan96xx/Kan/ext.c 2005/06/16 05:07:23 1.36 @@ -1,3 +1,4 @@ +/* $OpenXM: OpenXM/src/kan96xx/Kan/ext.c,v 1.35 2005/06/09 05:46:57 takayama Exp $ */ #include #include #include @@ -11,21 +12,30 @@ #include "extern2.h" #include #include "plugin.h" +#include "kclass.h" +#include +#include +#include +#include "ox_pathfinder.h" +extern int Quiet; +extern char **environ; + #define MYCP_SIZE 100 static int Mychildren[MYCP_SIZE]; static int Mycp = 0; +static int Verbose_mywait = 0; static void mywait() { int status; int pid; int i,j; - signal(SIGCHLD,SIG_IGN); + /* signal(SIGCHLD,SIG_IGN); */ pid = wait(&status); - fprintf(stderr,"Child process %d is exiting.\n",pid); + if ((!Quiet) && (Verbose_mywait)) fprintf(stderr,"Child process %d is exiting.\n",pid); for (i=0; i 0) Mycp--; } @@ -34,9 +44,14 @@ static void mywait() { } #define SIZE_OF_ENVSTACK 5 -static jmp_buf EnvStack[SIZE_OF_ENVSTACK]; +#if defined(__CYGWIN__) +#define JMP_BUF sigjmp_buf +#else +#define JMP_BUF jmp_buf +#endif +static JMP_BUF EnvStack[SIZE_OF_ENVSTACK]; static int Envp = 0; -static void pushEnv(jmp_buf jb) { +static void pushEnv(JMP_BUF jb) { if (Envp < SIZE_OF_ENVSTACK) { *(EnvStack[Envp]) = *jb; Envp++; @@ -45,7 +60,7 @@ static void pushEnv(jmp_buf jb) { exit(2); } } -static void popEnv(jmp_buf jbp) { +static void popEnv(JMP_BUF jbp) { if (Envp <= 0) { fprintf(stderr,"Underflow of EnvStack.\n"); exit(3); @@ -73,28 +88,39 @@ static char *ext_generateUniqueFileName(char *s) return(NULL); } +static struct object oregexec(struct object oregex,struct object ostrArray,struct object oflag); + struct object Kextension(struct object obj) { char *key; int size; - struct object keyo; + struct object keyo = OINIT; struct object rob = NullObject; - struct object obj1,obj2,obj3,obj4; - int m,i; + struct object obj1 = OINIT; + struct object obj2 = OINIT; + struct object obj3 = OINIT; + struct object obj4 = OINIT; + int m,i,pid, uid; int argListc, fdListc; char *abc; char *abc2; extern struct context *CurrentContextp; +#if (__CYGWIN__) + extern sigjmp_buf EnvOfStackMachine; +#else extern jmp_buf EnvOfStackMachine; +#endif extern void ctrlC(); extern int SigIgn; - extern errno; extern int DebugCMO; extern int OXprintMessage; struct stat buf; char **argv; FILE *fp; - void (*oldsig)(); + void (*oldsig)(); + extern SecureMode; + extern char *UD_str; + extern int UD_attr; if (obj.tag != Sarray) errorKan1("%s\n","Kextension(): The argument must be an array."); size = getoaSize(obj); @@ -128,150 +154,462 @@ struct object Kextension(struct object obj) obj1 = getoa(obj,1); if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattrs) num] extension."); m = KopInteger(obj1); - if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT)) - errorKan1("%s\n","The number must be 0, 1 or 2."); + /* if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT || m == ATTR_INFIX)) + errorKan1("%s\n","The number must be 0, 1 or 2.");*/ putUserDictionary2((char *)NULL,0,0,m | SET_ATTR_FOR_ALL_WORDS, - CurrentContextp->userDictionary); + CurrentContextp->userDictionary); + }else if (strcmp(key,"or_attrs")==0) { + if (size != 2) errorKan1("%s\n","[(or_attrs) num] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sinteger) errorKan1("%s\n","[(or_attrs) num] extension."); + m = KopInteger(obj1); + putUserDictionary2((char *)NULL,0,0,m | OR_ATTR_FOR_ALL_WORDS, + CurrentContextp->userDictionary); }else if (strcmp(key,"keywords")==0) { if (size != 1) errorKan1("%s\n","[(keywords)] extension."); rob = showSystemDictionary(1); /* }else if (strcmp(key,"fork0")==0) { - if (size != 2) errorKan1("%s\n","[(fork0) sss] extension."); - m = fork(); - if (m>0) { rob = KpoInteger(m); } - else { - system(KopString(getoa(obj,1))); exit(0); - } */ - }else if (strcmp(key,"defaultPolyRing")==0) { - if (size != 2) errorKan1("%s\n","[(defaultPolyRing) n] extension."); - rob = KdefaultPolyRing(getoa(obj,1)); - }else if (strcmp(key,"getenv")==0) { - if (size != 2) errorKan1("%s\n","[(getenv) envstr] extension."); - obj1 = getoa(obj,1); - if (obj1.tag != Sdollar) errorKan1("%s\n","[(getenv) envstr] extension"); - abc = getenv(KopString(obj1)); - if (abc == NULL) { - rob = NullObject; + if (size != 2) errorKan1("%s\n","[(fork0) sss] extension."); + m = fork(); + if (m>0) { rob = KpoInteger(m); } + else { + system(KopString(getoa(obj,1))); exit(0); + } */ + }else if (strcmp(key,"defaultPolyRing")==0) { + if (size != 2) errorKan1("%s\n","[(defaultPolyRing) n] extension."); + rob = KdefaultPolyRing(getoa(obj,1)); + }else if (strcmp(key,"getenv")==0) { + if (size != 2) errorKan1("%s\n","[(getenv) envstr] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sdollar) errorKan1("%s\n","[(getenv) envstr] extension"); + abc = getenv(KopString(obj1)); +#if defined(__CYGWIN__) + if (abc == NULL) { + abc2 = (char *)sGC_malloc(sizeof(char)*(strlen(KopString(obj1))+2)); + strcpy(abc2,KopString(obj1)); + for (i=0; i 0) { + /* parent */ + if (m&2) { + /* Do not call singal to turn around a trouble on cygwin. BUG. */ }else{ - abc2 = (char *)sGC_malloc(sizeof(char)*(strlen(abc)+2)); - strcpy(abc2,abc); - rob = KpoString(abc2); + signal(SIGCHLD,mywait); /* to kill Zombie */ } - }else if (strcmp(key,"stat")==0) { - if (size != 2) errorKan1("%s\n","[(stat) fname] extension."); - obj1 = getoa(obj,1); - if (obj1.tag != Sdollar) errorKan1("%s\n","[(stat) fname] extension ; string fname."); - m = stat(KopString(obj1),&buf); - rob = newObjectArray(2); - if (m == -1) { - /* fail */ - obj2 = NullObject; - putoa(rob,0,obj2); - obj3 = newObjectArray(2); - putoa(obj3,0,KpoString("error no")); - putoa(obj3,1,KpoInteger(errno)); - putoa(rob,1,obj3); - }else{ - /* success */ - putoa(rob,0,KpoInteger(0)); - putoa(rob,1,newObjectArray(0)); /* We have not yet read buf */ + Mychildren[Mycp++] = pid; + if (Mycp >= MYCP_SIZE-1) { + errorKan1("%s\n","Child process table is full.\n"); + Mycp = 0; } - }else if (strcmp(key,"forkExec")==0) { - if (size != 4) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension."); - obj1 = getoa(obj,1); - if (obj1.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array argList."); - obj2 = getoa(obj,2); - if (obj2.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array fdList."); - obj3 = getoa(obj,3); - if (obj3.tag != Sinteger) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. integer sigblock."); - m = KopInteger(obj3); /* m == 1 : block ctrl-C. */ - argListc = getoaSize(obj1); - fdListc = getoaSize(obj2); - if ((m = fork()) > 0) { - /* parent */ - signal(SIGCHLD,mywait); /* to kill Zombie */ - Mychildren[Mycp++] = m; - if (Mycp >= MYCP_SIZE-1) { - errorKan1("%s\n","Child process table is full.\n"); - Mycp = 0; - } - rob = KpoInteger(m); - /* Done */ - }else{ - /* Child */ - for (i=0; i>>\n"); + } + execve(argv[0],argv,environ); + /* This place will never be reached unless execv fails. */ + fprintf(stderr,"forkExec fails: "); + for (i=0; ilc).ival,(obj2.rc.op->rc).ival, + m,CurrentContextp->userDictionary); + }else if (strcmp(key,"or_attr")==0) { + if (size != 3) errorKan1("%s\n","[(or_attr) num symbol] extension."); + obj1 = getoa(obj,1); + obj2 = getoa(obj,2); + if (obj1.tag != Sinteger) errorKan1("%s\n","[(or_attr) num symbol] extension."); + if (obj2.tag != Sstring) errorKan1("%s\n","[(or_attr) num symbol] extension."); + m = KopInteger(obj1); + rob = KfindUserDictionary(obj2.lc.str); + if (rob.tag != NoObject.tag) { + if (strcmp(UD_str,obj2.lc.str) == 0) { + m |= UD_attr; + }else errorKan1("%s\n","or_attr: internal error."); + } + rob = KpoInteger(m); + putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival, + m,CurrentContextp->userDictionary); + }else if (strcmp(key,"getattr")==0) { + if (size != 2) errorKan1("%s\n","[(getattr) symbol] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sstring) errorKan1("%s\n","[(getattr) symbol] extension."); + rob = KfindUserDictionary(obj1.lc.str); + if (rob.tag != NoObject.tag) { + if (strcmp(UD_str,obj1.lc.str) == 0) { + rob = KpoInteger(UD_attr); + }else errorKan1("%s\n","getattr: internal error."); + }else rob = NullObject; + }else if (strcmp(key,"getServerEnv")==0) { + if (size != 2) errorKan1("%s\n","[(getServerEnv) serverName] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sdollar) errorKan1("%s\n","[(getServerEnv) serverName] extension."); + { + char **se; int ii; int nn; + se = getServerEnv(KopString(obj1)); + if (se == NULL) { + debugServerEnv(KopString(obj1)); + rob = NullObject; + }else{ + for (ii=0,nn=0; se[ii] != NULL; ii++) nn++; + rob = newObjectArray(nn); + for (ii=0; ii0) { + n = read(fd, s, total); + if (n < 0) { perror("read"); errorKan1("%s\n","[(read) ...]; read error.");} + s[n] = 0; + total -= n; s = &(s[n]); } - }else if (strcmp(key,"getUniqueFileName")==0) { - if (size != 2) errorKan1("%s\n","[(getUniqueFileName) path] extension."); - obj1 = getoa(obj,1); - if (obj1.tag != Sdollar) errorKan1("%s\n","[(getUniqueFileName) path] extension. path must be a string."); - rob = KpoString(ext_generateUniqueFileName(KopString(obj1))); - }else if (strcmp(key,"outputObjectToFile")==0) { - if (size != 3) errorKan1("%s\n","[(outputObjectToFile) path obj] extension."); - obj1 = getoa(obj,1); - if (obj1.tag != Sdollar) errorKan1("%s\n","[(outputObjectToFile) path obj] extension. path must be a string."); - obj2 = getoa(obj,2); - fp = fopen(KopString(obj1),"w"); - if (fp == NULL) errorKan1("%s\n","[(outputObjectToFile) path object] extension : could not open the path."); - printObject(obj2,0,fp); - fclose(fp); + rob = KpoString(s0); + } + }else if (strcmp(key,"regionMatches")==0) { + if (size != 3) errorKan1("%s\n","[(regionMatches) str strArray] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sdollar) errorKan1("%s\n","[(regionMatches) str strArray] extension. str must be a string."); + obj2 = getoa(obj,2); + if (obj2.tag != Sarray) errorKan1("%s\n","[(regionMatches) str strArray] extension. strArray must be an array."); + rob = KregionMatches(obj1,obj2); + }else if (strcmp(key,"newVector")==0) { + if (size != 2) errorKan1("%s\n","[(newVector) m] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sinteger) errorKan1("%s\n","[(newVector) m] extension. m must be an integer."); + rob = newObjectArray(KopInteger(obj1)); + }else if (strcmp(key,"newMatrix")==0) { + if (size != 3) errorKan1("%s\n","[(newMatrix) m n] extension."); + obj1 = getoa(obj,1); + if (obj1.tag != Sinteger) errorKan1("%s\n","[(newMatrix) m n] extension. m must be an integer."); + obj2 = getoa(obj,2); + if (obj2.tag != Sinteger) errorKan1("%s\n","[(newMatrix) m n] extension. n must be an integer."); + rob = newObjectArray(KopInteger(obj1)); + for (i=0; ilc).ival,(obj2.rc.op->rc).ival, - m,CurrentContextp->userDictionary); } + }else if (strcmp(key,"regexec")==0) { + if ((size != 3) && (size != 4)) errorKan1("%s\n","[(regexec) reg strArray flag(optional)] extension b"); + obj1 = getoa(obj,1); + if (obj1.tag != Sdollar) errorKan1("%s\n","regexec, the first argument should be a string (regular expression)."); + obj2 = getoa(obj,2); + if (obj2.tag != Sarray) errorKan1("%s\n","regexec, the second argument should be an array of a string."); + if (size == 3) obj3 = newObjectArray(0); + else obj3 = getoa(obj,3); + rob = oregexec(obj1,obj2,obj3); + }else if (strcmp(key,"unlink")==0) { + if (size != 2) errorKan1("%s\n","[(unlink) filename] extension b"); + obj1 = getoa(obj,1); + if (obj1.tag != Sdollar) errorKan1("%s\n","unlink, the first argument should be a string (filename)."); + rob = KpoInteger(oxDeleteFile(KopString(obj1))); + } #include "plugin.hh" +#include "Kclass/tree.hh" else{ - errorKan1("%s\n","Unknown tag for extension."); + fprintf(stderr,"key=%s; ",key); + errorKan1("%s\n","Unknown key for extension."); } return(rob); } +struct object KregionMatches(struct object sobj, struct object keyArray) +{ + struct object rob = OINIT; + int n,i,j,m,keyn; + char *s,*key; + rob = newObjectArray(3); + getoa(rob,0) = KpoInteger(-1); + getoa(rob,1) = NullObject; + getoa(rob,2) = NullObject; + + if (sobj.tag != Sdollar) return rob; + if (keyArray.tag != Sarray) return rob; + n = getoaSize(keyArray); + for (i=0; i