Annotation of OpenXM_contrib2/asir2000/builtin/file.c, Revision 1.20
1.4 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.5 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.4 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
47: *
1.20 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/file.c,v 1.19 2003/11/12 07:48:50 noro Exp $
1.4 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "parse.h"
1.15 noro 52: #include "ox.h"
1.1 noro 53: #include "base.h"
1.16 noro 54: #if !defined(VISUAL)
1.2 noro 55: #include "unistd.h"
1.16 noro 56: #endif
1.17 ohara 57: #if defined(PARI)
1.1 noro 58: #include "genpari.h"
1.2 noro 59: #endif
1.1 noro 60:
61: #if defined(VISUAL)
62: #include <windows.h>
1.9 noro 63: #include <process.h>
1.15 noro 64: #include <io.h>
1.1 noro 65: /* #define ECGEN_KEYNAME "SoftWare\\Fujitsu\\WinECgen\\1.00.000" */
66: #define ECGEN_KEYNAME "SoftWare\\Fujitsu\\FSEcParamGen\\V1.0L10"
67: #define ASIR_KEYNAME "SoftWare\\Fujitsu\\Asir\\1999.03.31"
68: #endif
69:
70: void Pget_rootdir();
71: void Paccess(),Premove_file();
72: void Pbsave_enc(), Pbload_enc();
73:
74: void Pload(), Pwhich(), Ploadfiles(), Poutput();
75: void Pbsave(), Pbload(), Pbload27();
76: void Pbsave_compat(), Pbload_compat();
77: void Pbsave_cmo(), Pbload_cmo();
1.13 noro 78: void Popen_file(), Pclose_file(), Pget_line(), Pget_byte(), Pput_byte();
1.10 noro 79: void Ppurge_stdin();
1.19 noro 80: void Pexec();
1.1 noro 81:
82: extern int des_encryption;
83: extern char *asir_libdir;
84:
85: struct ftab file_tab[] = {
1.10 noro 86: {"purge_stdin",Ppurge_stdin,0},
1.13 noro 87: {"open_file",Popen_file,-2},
1.3 noro 88: {"close_file",Pclose_file,1},
1.8 noro 89: {"get_byte",Pget_byte,1},
1.13 noro 90: {"put_byte",Pput_byte,2},
1.10 noro 91: {"get_line",Pget_line,-1},
1.1 noro 92: {"remove_file",Premove_file,1},
93: {"access",Paccess,1},
94: {"load",Pload,-1},
1.19 noro 95: {"exec",Pexec,1},
1.1 noro 96: {"which",Pwhich,1},
97: {"loadfiles",Ploadfiles,1},
98: {"output",Poutput,-1},
99: {"bsave",Pbsave,2},
100: {"bload",Pbload,1},
101: {"get_rootdir",Pget_rootdir,0},
1.6 noro 102: #if defined(VISUAL) && defined(DES_ENC)
1.1 noro 103: {"bsave_enc",Pbsave_enc,2},
104: {"bload_enc",Pbload_enc,1},
1.6 noro 105: #endif
1.1 noro 106: {"bload27",Pbload27,1},
107: {"bsave_compat",Pbsave_compat,2},
108: {"bload_compat",Pbload_compat,1},
109: {"bsave_cmo",Pbsave_cmo,2},
110: {"bload_cmo",Pbload_cmo,1},
111: {0,0,0},
112: };
1.3 noro 113:
114: static FILE *file_ptrs[BUFSIZ];
115:
1.15 noro 116: void Ppurge_stdin(Q *rp)
1.10 noro 117: {
118: purge_stdin(stdin);
119: *rp = 0;
120: }
121:
1.15 noro 122: void Popen_file(NODE arg,Q *rp)
1.3 noro 123: {
124: char *name;
125: FILE *fp;
126: char errbuf[BUFSIZ];
127: int i;
128:
129: asir_assert(ARG0(arg),O_STR,"open_file");
130: for ( i = 0; i < BUFSIZ && file_ptrs[i]; i++ );
131: if ( i == BUFSIZ )
132: error("open_file : too many open files");
133: name = BDY((STRING)ARG0(arg));
1.18 takayama 134: if (strcmp(name,"unix://stdin") == 0) {
135: fp = stdin;
136: }else if (strcmp(name,"unix://stdout") == 0) {
137: fp = stdout;
138: }else if (strcmp(name,"unix://stderr") == 0) {
139: fp = stderr;
140: }else{
141: if ( argc(arg) == 2 ) {
1.13 noro 142: asir_assert(ARG1(arg),O_STR,"open_file");
143: fp = fopen(name,BDY((STRING)ARG1(arg)));
1.18 takayama 144: } else
1.13 noro 145: fp = fopen(name,"r");
1.18 takayama 146: }
1.3 noro 147: if ( !fp ) {
1.13 noro 148: sprintf(errbuf,"open_file : cannot open \"%s\"",name);
1.3 noro 149: error(errbuf);
150: }
151: file_ptrs[i] = fp;
152: STOQ(i,*rp);
153: }
154:
1.15 noro 155: void Pclose_file(NODE arg,Q *rp)
1.3 noro 156: {
157: int i;
158:
1.8 noro 159: asir_assert(ARG0(arg),O_N,"close_file");
1.3 noro 160: i = QTOS((Q)ARG0(arg));
161: if ( file_ptrs[i] ) {
162: fclose(file_ptrs[i]);
163: file_ptrs[i] = 0;
164: } else
165: error("close_file : invalid argument");
166: *rp = ONE;
167: }
168:
1.15 noro 169: void Pget_line(NODE arg,STRING *rp)
1.3 noro 170: {
171: int i,j,c;
172: FILE *fp;
173: fpos_t head;
174: char *str;
1.10 noro 175: char buf[BUFSIZ];
176:
177: if ( !arg ) {
178: #if defined(VISUAL_LIB)
179: get_string(buf,sizeof(buf));
180: #else
181: fgets(buf,sizeof(buf),stdin);
182: #endif
183: i = strlen(buf);
184: str = (char *)MALLOC_ATOMIC(i+1);
185: strcpy(str,buf);
186: MKSTR(*rp,str);
187: return;
188: }
1.3 noro 189:
1.8 noro 190: asir_assert(ARG0(arg),O_N,"get_line");
1.3 noro 191: i = QTOS((Q)ARG0(arg));
192: if ( fp = file_ptrs[i] ) {
193: if ( feof(fp) ) {
194: *rp = 0;
195: return;
196: }
197: fgetpos(fp,&head);
198: j = 0;
199: while ( 1 ) {
200: c = getc(fp);
201: if ( c == EOF ) {
202: if ( !j ) {
203: *rp = 0;
204: return;
205: } else
206: break;
207: }
208: j++;
209: if ( c == '\n' )
210: break;
211: }
212: fsetpos(fp,&head);
213: str = (char *)MALLOC_ATOMIC(j+1);
214: fgets(str,j+1,fp);
215: MKSTR(*rp,str);
216: } else
217: error("get_line : invalid argument");
1.8 noro 218: }
219:
1.15 noro 220: void Pget_byte(NODE arg,Q *rp)
1.8 noro 221: {
222: int i,c;
223: FILE *fp;
224:
225: asir_assert(ARG0(arg),O_N,"get_byte");
226: i = QTOS((Q)ARG0(arg));
227: if ( fp = file_ptrs[i] ) {
228: if ( feof(fp) ) {
229: STOQ(-1,*rp);
230: return;
231: }
232: c = getc(fp);
233: STOQ(c,*rp);
234: } else
235: error("get_byte : invalid argument");
1.13 noro 236: }
237:
1.20 ! noro 238: void Pput_byte(NODE arg,Obj *rp)
1.13 noro 239: {
1.20 ! noro 240: int i,j,c;
1.13 noro 241: FILE *fp;
1.20 ! noro 242: Obj obj;
! 243: TB tb;
1.13 noro 244:
245: asir_assert(ARG0(arg),O_N,"put_byte");
246: i = QTOS((Q)ARG0(arg));
1.20 ! noro 247: if ( !(fp = file_ptrs[i]) )
! 248: error("put_byte : invalid argument");
! 249:
! 250: obj = (Obj)ARG1(arg);
! 251: if ( !obj || OID(obj) == O_N ) {
! 252: c = QTOS((Q)obj);
1.13 noro 253: putc(c,fp);
1.20 ! noro 254: } else if ( OID(obj) == O_STR )
! 255: fputs(BDY((STRING)obj),fp);
! 256: else if ( OID(obj) == O_TB ) {
! 257: tb = (TB)obj;
! 258: for ( j = 0; j < tb->next; j++ )
! 259: fputs(tb->body[j],fp);
! 260: }
! 261: *rp = obj;
1.3 noro 262: }
1.1 noro 263:
1.15 noro 264: void Pload(NODE arg,Q *rp)
1.1 noro 265: {
266: int ret = 0;
267: char *name,*name0;
268: char errbuf[BUFSIZ];
269:
270: if ( ARG0(arg) ) {
271: switch (OID(ARG0(arg))) {
272: case O_STR:
273: name0 = BDY((STRING)ARG0(arg));
274: searchasirpath(name0,&name);
275: if ( !name ) {
276: sprintf(errbuf,"load : \"%s\" not found in the search path",name0);
277: error(errbuf);
278: }
279: ret = loadfile(name);
280: if ( !ret ) {
281: sprintf(errbuf,"load : \"%s\" could not be loaded",name);
282: error(errbuf);
283: }
284: break;
285: default:
286: error("load : invalid argument");
287: break;
288: }
289: }
1.14 noro 290: STOQ(ret,*rp);
291: }
292:
1.19 noro 293: void Pexec(NODE arg,Q *rp)
1.14 noro 294: {
1.15 noro 295: int ret;
1.14 noro 296: char *name0,*name;
297:
298: name0 = BDY((STRING)ARG0(arg));
299: searchasirpath(name0,&name);
300: if ( !name )
301: ret = -1;
1.15 noro 302: else {
1.19 noro 303: execasirfile(name);
1.15 noro 304: ret = 0;
305: }
1.1 noro 306: STOQ(ret,*rp);
307: }
308:
1.15 noro 309: void Pwhich(NODE arg,STRING *rp)
1.1 noro 310: {
311: char *name;
312: STRING str;
313:
314: switch (OID(ARG0(arg))) {
315: case O_STR:
316: searchasirpath(BDY((STRING)ARG0(arg)),&name);
317: break;
318: default:
319: name = 0;
320: break;
321: }
322: if ( name ) {
323: MKSTR(str,name); *rp = str;
324: } else
325: *rp = 0;
326: }
327:
1.15 noro 328: void Ploadfiles(NODE arg,Q *rp)
1.1 noro 329: {
330: int ret;
331:
332: if ( ARG0(arg) )
333: if ( OID(ARG0(arg)) != O_LIST )
334: ret = 0;
335: else
336: ret = loadfiles(BDY((LIST)ARG0(arg)));
337: else
338: ret = 0;
339: STOQ(ret,*rp);
340: }
341:
1.15 noro 342: void Poutput(NODE arg,Q *rp)
1.1 noro 343: {
1.17 ohara 344: #if defined(PARI)
1.1 noro 345: extern FILE *outfile;
346: #endif
347: FILE *fp;
348:
349: fflush(asir_out);
350: if ( asir_out != stdout )
351: fclose(asir_out);
352: switch ( argc(arg) ) {
353: case 0:
354: fp = stdout; break;
355: case 1:
356: asir_assert(ARG0(arg),O_STR,"output");
357: fp = fopen(((STRING)ARG0(arg))->body,"a+");
358: if ( !fp )
359: error("output : invalid filename");
360: break;
361: }
1.17 ohara 362: #if defined(PARI)
1.1 noro 363: pari_outfile =
364: #endif
365: asir_out = fp;
366: *rp = ONE;
367: }
368:
369: extern int ox_file_io;
370:
1.15 noro 371: void Pbsave(NODE arg,Q *rp)
1.1 noro 372: {
373: FILE *fp;
374: VL vl,t;
375:
376: asir_assert(ARG1(arg),O_STR,"bsave");
377: get_vars_recursive(ARG0(arg),&vl);
378: for ( t = vl; t; t = NEXT(t) )
379: if ( t->v->attr == (pointer)V_UC )
380: error("bsave : not implemented");
381: fp = fopen(BDY((STRING)ARG1(arg)),"wb");
382: if ( !fp )
383: error("bsave : invalid filename");
384: ox_file_io = 1; /* network byte order is used */
385: savevl(fp,vl);
386: saveobj(fp,ARG0(arg));
387: fclose(fp);
388: ox_file_io = 0;
389: *rp = ONE;
390: }
391:
1.15 noro 392: void Pbload(NODE arg,Obj *rp)
1.1 noro 393: {
394: FILE *fp;
395:
396: asir_assert(ARG0(arg),O_STR,"bload");
397: fp = fopen(BDY((STRING)ARG0(arg)),"rb");
398: if ( !fp )
399: error("bload : invalid filename");
400: ox_file_io = 1; /* network byte order is used */
401: loadvl(fp);
402: loadobj(fp,rp);
403: fclose(fp);
404: ox_file_io = 0;
405: }
406:
1.15 noro 407: void Pbsave_cmo(NODE arg,Q *rp)
1.1 noro 408: {
409: FILE *fp;
410:
411: asir_assert(ARG1(arg),O_STR,"bsave_cmo");
412: fp = fopen(BDY((STRING)ARG1(arg)),"wb");
413: if ( !fp )
414: error("bsave_cmo : invalid filename");
415: ox_file_io = 1; /* network byte order is used */
416: write_cmo(fp,ARG0(arg));
417: fclose(fp);
418: ox_file_io = 0;
419: *rp = ONE;
420: }
421:
1.15 noro 422: void Pbload_cmo(NODE arg,Obj *rp)
1.1 noro 423: {
424: FILE *fp;
425:
426: asir_assert(ARG0(arg),O_STR,"bload_cmo");
427: fp = fopen(BDY((STRING)ARG0(arg)),"rb");
428: if ( !fp )
429: error("bload_cmo : invalid filename");
430: ox_file_io = 1; /* network byte order is used */
431: read_cmo(fp,rp);
432: fclose(fp);
433: ox_file_io = 0;
434: }
435:
1.7 noro 436: static struct oSTRING rootdir;
437:
1.1 noro 438: #if defined(VISUAL)
1.15 noro 439: void get_rootdir(char *name,int len)
1.1 noro 440: {
441: LONG ret;
442: HKEY hOpenKey;
443: DWORD Type;
1.7 noro 444: char *slash;
1.12 noro 445:
1.7 noro 446: if ( rootdir.body ) {
447: strcpy(name,rootdir.body);
1.12 noro 448: return;
449: }
450:
451: if ( access("UseCurrentDir",0) >= 0 ) {
452: GetCurrentDirectory(BUFSIZ,name);
453: slash = strrchr(name,'\\');
454: if ( slash )
455: *slash = 0;
1.7 noro 456: return;
457: }
1.1 noro 458: name[0] = 0;
459: ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, ECGEN_KEYNAME, 0,
460: KEY_QUERY_VALUE, &hOpenKey);
461: if ( ret != ERROR_SUCCESS )
462: ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, ASIR_KEYNAME, 0,
463: KEY_QUERY_VALUE, &hOpenKey);
464: if( ret == ERROR_SUCCESS ) {
465: RegQueryValueEx(hOpenKey, "Directory", NULL, &Type, name, &len);
466: RegCloseKey(hOpenKey);
1.7 noro 467: } else {
468: GetCurrentDirectory(len,name);
469: slash = strrchr(name,'\\');
470: if ( slash )
471: *slash = 0;
1.1 noro 472: }
473: }
1.7 noro 474:
1.15 noro 475: void set_rootdir(char *name)
1.7 noro 476: {
477: static char DirName[BUFSIZ];
478:
479: strcpy(DirName,name);
480: rootdir.id = O_STR;
481: rootdir.body = DirName;
482: asir_libdir = DirName;
483: /* XXX */
484: env_init();
485: }
486:
1.1 noro 487: #else
1.15 noro 488: void get_rootdir(char *name,int len)
1.1 noro 489: {
490: strcpy(name,asir_libdir);
491: }
1.7 noro 492:
1.15 noro 493: void set_rootdir(char *name)
1.7 noro 494: {
495: static char DirName[BUFSIZ];
496:
497: strcpy(DirName,name);
498: asir_libdir = DirName;
499: /* XXX */
500: env_init();
501: }
502:
1.1 noro 503: #endif
504:
1.15 noro 505: void Pget_rootdir(STRING *rp)
1.1 noro 506: {
507: static char DirName[BUFSIZ];
508:
509: if ( !rootdir.body ) {
510: get_rootdir(DirName,sizeof(DirName));
511: rootdir.id = O_STR;
512: rootdir.body = DirName;
513: }
514: *rp = &rootdir;
515: }
516:
1.6 noro 517: #if defined(VISUAL) && defined(DES_ENC)
1.15 noro 518: void Pbsave_enc(NODE arg,Obj *rp)
1.1 noro 519: {
520: init_deskey();
521: des_encryption = 1;
522: Pbsave(arg,rp);
523: des_encryption = 0;
524: }
525:
1.15 noro 526: void Pbload_enc(NODE arg,Obj *rp)
1.1 noro 527: {
528: init_deskey();
529: des_encryption = 1;
530: Pbload(arg,rp);
531: des_encryption = 0;
532: }
1.6 noro 533: #endif
1.1 noro 534:
1.15 noro 535: void Pbload27(NODE arg,Obj *rp)
1.1 noro 536: {
537: FILE *fp;
538: Obj r;
539:
540: asir_assert(ARG0(arg),O_STR,"bload27");
541: fp = fopen(BDY((STRING)ARG0(arg)),"rb");
542: if ( !fp )
543: error("bload : invalid filename");
544: loadvl(fp);
545: loadobj(fp,&r);
546: fclose(fp);
547: bobjtoobj(BASE27,r,rp);
548: }
549:
1.15 noro 550: void Pbsave_compat(NODE arg,Q *rp)
1.1 noro 551: {
552: FILE *fp;
553: VL vl,t;
554:
555: asir_assert(ARG1(arg),O_STR,"bsave_compat");
556: get_vars_recursive(ARG0(arg),&vl);
557: for ( t = vl; t; t = NEXT(t) )
558: if ( t->v->attr == (pointer)V_UC )
559: error("bsave : not implemented");
560: fp = fopen(BDY((STRING)ARG1(arg)),"wb");
561: if ( !fp )
562: error("bsave : invalid filename");
563: /* indicator of an asir32 file */
564: putw(0,fp); putw(0,fp);
565: savevl(fp,vl);
566: saveobj(fp,ARG0(arg));
567: fclose(fp);
568: *rp = ONE;
569: }
570:
1.15 noro 571: void Pbload_compat(NODE arg,Obj *rp)
1.1 noro 572: {
573: FILE *fp;
574: unsigned int hdr[2];
575: Obj r;
576: int c;
577:
578: asir_assert(ARG0(arg),O_STR,"bload_compat");
579: fp = fopen(BDY((STRING)ARG0(arg)),"rb");
580: if ( !fp )
581: error("bload : invalid filename");
582: fread(hdr,sizeof(unsigned int),2,fp);
583: if ( !hdr[0] && !hdr[1] ) {
584: /* asir32 file or asir27 0 */
585: c = fgetc(fp);
586: if ( c == EOF ) {
587: /* asir27 0 */
588: *rp = 0;
589: } else {
590: /* asir32 file */
591: ungetc(c,fp);
592: loadvl(fp);
593: loadobj(fp,rp);
594: }
595: } else {
596: /* asir27 file */
597: rewind(fp);
598: loadvl(fp);
599: loadobj(fp,&r);
600: bobjtoobj(BASE27,r,rp);
601: }
602: fclose(fp);
603: }
604:
1.15 noro 605: void Premove_file(NODE arg,Q *rp)
1.1 noro 606: {
607: unlink((char *)BDY((STRING)ARG0(arg)));
608: *rp = ONE;
609: }
610:
1.15 noro 611: void Paccess(NODE arg,Q *rp)
1.1 noro 612: {
613: #if defined(VISUAL)
614: if ( access(BDY((STRING)ARG0(arg)),04) >= 0 )
615: #else
616: if ( access(BDY((STRING)ARG0(arg)),R_OK) >= 0 )
617: #endif
618: *rp = ONE;
619: else
620: *rp = 0;
621: }
1.9 noro 622:
623: #if defined(VISUAL)
624: int process_id()
625: {
626: return GetCurrentProcessId();
627: }
628:
1.15 noro 629: void call_exe(char *name,char **av)
1.9 noro 630: {
631: _spawnv(_P_WAIT,name,av);
632: }
633: #endif
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>