| version 1.2, 2000/01/16 07:55:38 |
version 1.5, 2001/05/04 01:06:23 |
|
|
| /* $OpenXM$ */ |
/* $OpenXM: OpenXM/src/kan96xx/Kan/ext.c,v 1.4 2000/03/09 12:04:52 takayama Exp $ */ |
| #include <stdio.h> |
#include <stdio.h> |
| #include <sys/types.h> |
#include <sys/types.h> |
| #include <sys/stat.h> |
#include <sys/stat.h> |
| Line 26 static void mywait() { |
|
| Line 26 static void mywait() { |
|
| for (i=0; i<Mycp; i++) { |
for (i=0; i<Mycp; i++) { |
| if (Mychildren[i] == pid) { |
if (Mychildren[i] == pid) { |
| for (j=i; j<Mycp-1; j++) { |
for (j=i; j<Mycp-1; j++) { |
| Mychildren[j] = Mychildren[j+1]; |
Mychildren[j] = Mychildren[j+1]; |
| } |
} |
| if (Mycp > 0) Mycp--; |
if (Mycp > 0) Mycp--; |
| } |
} |
| Line 95 struct object Kextension(struct object obj) |
|
| Line 95 struct object Kextension(struct object obj) |
|
| struct stat buf; |
struct stat buf; |
| char **argv; |
char **argv; |
| FILE *fp; |
FILE *fp; |
| void (*oldsig)(); |
void (*oldsig)(); |
| |
extern SecureMode; |
| |
|
| if (obj.tag != Sarray) errorKan1("%s\n","Kextension(): The argument must be an array."); |
if (obj.tag != Sarray) errorKan1("%s\n","Kextension(): The argument must be an array."); |
| size = getoaSize(obj); |
size = getoaSize(obj); |
| Line 132 struct object Kextension(struct object obj) |
|
| Line 133 struct object Kextension(struct object obj) |
|
| if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT)) |
if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT)) |
| errorKan1("%s\n","The number must be 0, 1 or 2."); |
errorKan1("%s\n","The number must be 0, 1 or 2."); |
| putUserDictionary2((char *)NULL,0,0,m | SET_ATTR_FOR_ALL_WORDS, |
putUserDictionary2((char *)NULL,0,0,m | SET_ATTR_FOR_ALL_WORDS, |
| CurrentContextp->userDictionary); |
CurrentContextp->userDictionary); |
| }else if (strcmp(key,"keywords")==0) { |
}else if (strcmp(key,"keywords")==0) { |
| if (size != 1) errorKan1("%s\n","[(keywords)] extension."); |
if (size != 1) errorKan1("%s\n","[(keywords)] extension."); |
| rob = showSystemDictionary(1); |
rob = showSystemDictionary(1); |
| /* }else if (strcmp(key,"fork0")==0) { |
/* }else if (strcmp(key,"fork0")==0) { |
| if (size != 2) errorKan1("%s\n","[(fork0) sss] extension."); |
if (size != 2) errorKan1("%s\n","[(fork0) sss] extension."); |
| m = fork(); |
m = fork(); |
| if (m>0) { rob = KpoInteger(m); } |
if (m>0) { rob = KpoInteger(m); } |
| else { |
else { |
| system(KopString(getoa(obj,1))); exit(0); |
system(KopString(getoa(obj,1))); exit(0); |
| } */ |
} */ |
| }else if (strcmp(key,"defaultPolyRing")==0) { |
}else if (strcmp(key,"defaultPolyRing")==0) { |
| if (size != 2) errorKan1("%s\n","[(defaultPolyRing) n] extension."); |
if (size != 2) errorKan1("%s\n","[(defaultPolyRing) n] extension."); |
| rob = KdefaultPolyRing(getoa(obj,1)); |
rob = KdefaultPolyRing(getoa(obj,1)); |
| }else if (strcmp(key,"getenv")==0) { |
}else if (strcmp(key,"getenv")==0) { |
| if (size != 2) errorKan1("%s\n","[(getenv) envstr] extension."); |
if (size != 2) errorKan1("%s\n","[(getenv) envstr] extension."); |
| obj1 = getoa(obj,1); |
obj1 = getoa(obj,1); |
| if (obj1.tag != Sdollar) errorKan1("%s\n","[(getenv) envstr] extension"); |
if (obj1.tag != Sdollar) errorKan1("%s\n","[(getenv) envstr] extension"); |
| abc = getenv(KopString(obj1)); |
abc = getenv(KopString(obj1)); |
| if (abc == NULL) { |
if (abc == NULL) { |
| rob = NullObject; |
rob = NullObject; |
| }else{ |
}else{ |
| abc2 = (char *)sGC_malloc(sizeof(char)*(strlen(abc)+2)); |
abc2 = (char *)sGC_malloc(sizeof(char)*(strlen(abc)+2)); |
| strcpy(abc2,abc); |
strcpy(abc2,abc); |
| rob = KpoString(abc2); |
rob = KpoString(abc2); |
| |
} |
| |
}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)); |
| |
obj3 = newObjectArray(1); |
| |
putoa(obj3,0,KpoInteger((int) buf.st_size)); |
| |
putoa(rob,1,obj3); /* We have not yet read buf fully */ |
| |
} |
| |
}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; |
| } |
} |
| }else if (strcmp(key,"stat")==0) { |
rob = KpoInteger(m); |
| if (size != 2) errorKan1("%s\n","[(stat) fname] extension."); |
/* Done */ |
| obj1 = getoa(obj,1); |
}else{ |
| if (obj1.tag != Sdollar) errorKan1("%s\n","[(stat) fname] extension ; string fname."); |
/* Child */ |
| m = stat(KopString(obj1),&buf); |
for (i=0; i<fdListc; i++) { |
| rob = newObjectArray(2); |
/* close the specified files */ |
| if (m == -1) { |
close(KopInteger(getoa(obj2,i))); |
| /* 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 */ |
|
| } |
} |
| }else if (strcmp(key,"forkExec")==0) { |
/* execl */ |
| if (size != 4) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension."); |
if (m == 1) { |
| obj1 = getoa(obj,1); |
{ |
| if (obj1.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array argList."); |
sigset_t sss; |
| obj2 = getoa(obj,2); |
sigemptyset(&sss); |
| if (obj2.tag != Sarray) errorKan1("%s\n","[(forkExec) argList fdList sigblock] extension. array fdList."); |
sigaddset(&sss,SIGINT); |
| obj3 = getoa(obj,3); |
sigprocmask(SIG_BLOCK,&sss,NULL); |
| 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<fdListc; i++) { |
|
| /* close the specified files */ |
|
| close(KopInteger(getoa(obj2,i))); |
|
| } |
|
| /* execl */ |
|
| if (m == 1) { |
|
| { |
|
| sigset_t sss; |
|
| sigemptyset(&sss); |
|
| sigaddset(&sss,SIGINT); |
|
| sigprocmask(SIG_BLOCK,&sss,NULL); |
|
| } |
|
| } |
|
| argv = (char **) sGC_malloc(sizeof(char *)*(argListc+1)); |
|
| if (argv == NULL) { |
|
| fprintf(stderr," no more momory. forkExec --- exiting.\n"); |
|
| _exit(10); |
|
| } |
|
| for (i=0; i<argListc; i++) { |
|
| argv[i] = KopString(getoa(obj1,i)); |
|
| argv[i+1] = NULL; |
|
| } |
|
| execv(argv[0],argv); |
|
| /* This place will never be reached unless execv fails. */ |
|
| fprintf(stderr,"forkExec fails: "); |
|
| for (i=0; i<argListc; i++) { |
|
| fprintf(stderr,"%s ",argv[i]); |
|
| } |
|
| fprintf(stderr,"\nExiting, but staying as Zombie.\n"); |
|
| _exit(10); |
|
| } |
} |
| }else if (strcmp(key,"getchild")==0) { |
argv = (char **) sGC_malloc(sizeof(char *)*(argListc+1)); |
| if (size != 1) errorKan1("%s\n","[(getchild)] extension."); |
if (argv == NULL) { |
| rob = newObjectArray(Mycp); |
fprintf(stderr," no more momory. forkExec --- exiting.\n"); |
| for (i=0; i<Mycp; i++) { |
_exit(10); |
| putoa(rob,i,KpoInteger(Mychildren[i])); |
|
| } |
} |
| }else if (strcmp(key,"getUniqueFileName")==0) { |
for (i=0; i<argListc; i++) { |
| if (size != 2) errorKan1("%s\n","[(getUniqueFileName) path] extension."); |
argv[i] = KopString(getoa(obj1,i)); |
| obj1 = getoa(obj,1); |
argv[i+1] = NULL; |
| if (obj1.tag != Sdollar) errorKan1("%s\n","[(getUniqueFileName) path] extension. path must be a string."); |
} |
| rob = KpoString(ext_generateUniqueFileName(KopString(obj1))); |
execv(argv[0],argv); |
| }else if (strcmp(key,"outputObjectToFile")==0) { |
/* This place will never be reached unless execv fails. */ |
| if (size != 3) errorKan1("%s\n","[(outputObjectToFile) path obj] extension."); |
fprintf(stderr,"forkExec fails: "); |
| obj1 = getoa(obj,1); |
for (i=0; i<argListc; i++) { |
| if (obj1.tag != Sdollar) errorKan1("%s\n","[(outputObjectToFile) path obj] extension. path must be a string."); |
fprintf(stderr,"%s ",argv[i]); |
| obj2 = getoa(obj,2); |
} |
| fp = fopen(KopString(obj1),"w"); |
fprintf(stderr,"\nExiting, but staying as Zombie.\n"); |
| if (fp == NULL) errorKan1("%s\n","[(outputObjectToFile) path object] extension : could not open the path."); |
_exit(10); |
| printObject(obj2,0,fp); |
|
| fclose(fp); |
|
| rob = NullObject; |
|
| }else if (strcmp(key,"hilbert")==0) { |
|
| if (size != 3) errorKan1("%s\n","[(hilbert) obgb obvlist] extension."); |
|
| rob = hilberto(getoa(obj,1),getoa(obj,2)); |
|
| }else if (strcmp(key,"chattr")==0) { |
|
| if (size != 3) errorKan1("%s\n","[(chattr) num symbol] extension."); |
|
| obj1 = getoa(obj,1); |
|
| obj2 = getoa(obj,2); |
|
| if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattr) num symbol] extension."); |
|
| if (obj2.tag != Sstring) errorKan1("%s\n","[(chattr) num symbol] extension."); |
|
| m = KopInteger(obj1); |
|
| if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT)) |
|
| errorKan1("%s\n","The number must be 0, 1 or 2."); |
|
| putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival, |
|
| m,CurrentContextp->userDictionary); |
|
| } |
} |
| |
}else if (strcmp(key,"getchild")==0) { |
| |
if (size != 1) errorKan1("%s\n","[(getchild)] extension."); |
| |
rob = newObjectArray(Mycp); |
| |
for (i=0; i<Mycp; i++) { |
| |
putoa(rob,i,KpoInteger(Mychildren[i])); |
| |
} |
| |
}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 = NullObject; |
| |
}else if (strcmp(key,"hilbert")==0) { |
| |
if (size != 3) errorKan1("%s\n","[(hilbert) obgb obvlist] extension."); |
| |
rob = hilberto(getoa(obj,1),getoa(obj,2)); |
| |
}else if (strcmp(key,"chattr")==0) { |
| |
if (size != 3) errorKan1("%s\n","[(chattr) num symbol] extension."); |
| |
obj1 = getoa(obj,1); |
| |
obj2 = getoa(obj,2); |
| |
if (obj1.tag != Sinteger) errorKan1("%s\n","[(chattr) num symbol] extension."); |
| |
if (obj2.tag != Sstring) errorKan1("%s\n","[(chattr) num symbol] extension."); |
| |
m = KopInteger(obj1); |
| |
if (!( m == 0 || m == PROTECT || m == ABSOLUTE_PROTECT)) |
| |
errorKan1("%s\n","The number must be 0, 1 or 2."); |
| |
putUserDictionary2(obj2.lc.str,(obj2.rc.op->lc).ival,(obj2.rc.op->rc).ival, |
| |
m,CurrentContextp->userDictionary); |
| |
} |
| #include "plugin.hh" |
#include "plugin.hh" |
| else{ |
else{ |
| errorKan1("%s\n","Unknown tag for extension."); |
errorKan1("%s\n","Unknown tag for extension."); |