1 /* Part of XPCE --- The SWI-Prolog GUI toolkit
2
3 Author: Jan Wielemaker and Anjo Anjewierden
4 E-mail: jan@swi.psy.uva.nl
5 WWW: http://www.swi.psy.uva.nl/projects/xpce/
6 Copyright (c) 1985-2002, University of Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #include <h/kernel.h>
36 #include <h/unix.h>
37 #include <sys/types.h>
38 #include <sys/stat.h>
39 #ifdef HAVE_UNISTD_H
40 #include <unistd.h>
41 #endif
42 #include <fcntl.h>
43 #include <errno.h>
44 #include <string.h>
45
46 #ifdef HAVE_SYS_PARAM_H
47 #include <sys/param.h>
48 #endif
49 #ifndef MAXPATHLEN
50 #define MAXPATHLEN 1024
51 #endif
52
53 #if HAVE_SYS_ACCESS_H /* AIX 3.2.5 */
54 #include <sys/access.h>
55 #endif
56
57 #if defined(__linux__) && !defined(PATH_MAX)
58 #include <linux/limits.h>
59 #endif
60
61 static status kindFile(FileObj f, Name encoding);
62 static Sheet FileFilters;
63
64 static status
initialiseFile(FileObj f,Name name,Name encoding)65 initialiseFile(FileObj f, Name name, Name encoding)
66 { Name fn;
67
68 initialiseSourceSink((SourceSink)f);
69
70 if ( isDefault(encoding) )
71 encoding = NAME_text;
72
73 assign(f, status, NAME_closed);
74 assign(f, bom, DEFAULT);
75 assign(f, path, DEFAULT);
76 #ifdef __WINDOWS__
77 assign(f, newline_mode, NAME_dos);
78 #else
79 assign(f, newline_mode, NAME_posix);
80 #endif
81 f->fd = NULL;
82
83 kindFile(f, encoding);
84
85 if ( isDefault(name) )
86 {
87 #ifdef HAVE_MKSTEMP
88 #define TMP_FILE_DONE
89 char namebuf[100];
90 int fileno;
91 char *s;
92
93 if ( (s=getenv("TMPDIR")) && strlen(s) < sizeof(namebuf)-13 )
94 { strcpy(namebuf, s);
95 strcat(namebuf, "/xpce-XXXXXX");
96 } else
97 strcpy(namebuf, "/tmp/xpce-XXXXXX");
98
99 if ( (fileno = mkstemp(namebuf)) < 0 )
100 return errorPce(f, NAME_openFile, NAME_write, getOsErrorPce(PCE));
101 if ( (f->fd = Sfdopen(fileno, "w")) == NULL )
102 { close(fileno);
103 return errorPce(f, NAME_openFile, NAME_write, getOsErrorPce(PCE));
104 }
105
106 name = CtoName(namebuf);
107 assign(f, status, NAME_tmpWrite);
108 #endif
109
110 #if !defined(TMP_FILE_DONE) && defined(HAVE_TEMPNAM)
111 #define TMP_FILE_DONE /* Prefer this on __WINDOWS__ */
112 #ifdef __WINDOWS__
113 char *s = tempnam("c:\\tmp", "xpce");
114 #else
115 char *s = tempnam("/tmp", "xpce");
116 #endif
117
118 if ( s )
119 { name = CtoName(s);
120 /*Cprintf("tempnam() returns %s\n", s);*/
121 free(s);
122 } else
123 { return errorPce(f, NAME_noTempFile, getOsErrorPce(PCE));
124 }
125 #endif
126
127 #if !defined(TMP_FILE_DONE) && defined(HAVE_TMPNAM)
128 #define TMP_FILE_DONE /* use unsafe tmpnam */
129 char namebuf[L_tmpnam];
130 char *s = tmpnam(namebuf);
131
132 if ( s )
133 { name = CtoName(s);
134 /*Cprintf("tmpnam() returns %s\n", s);*/
135 } else
136 { return errorPce(f, NAME_noTempFile, getOsErrorPce(PCE));
137 }
138 #endif
139
140 #if !defined(TMP_FILE_DONE)
141 Cprintf("No temporary files on this platform");
142 fail;
143 #endif
144 }
145
146 if ( (fn=expandFileName(name)) )
147 { assign(f, name, fn);
148 succeed;
149 } else
150 fail;
151 }
152
153
154 Name
expandFileName(Name in)155 expandFileName(Name in)
156 { wchar_t expanded[MAXPATHLEN];
157 int len;
158
159 if ( (len=expandFileNameW(charArrayToWC((CharArray)in, NULL),
160 expanded, MAXPATHLEN)) > 0 )
161 {
162 #if O_XOS
163 wchar_t lng[MAXPATHLEN];
164 char buf[MAXPATHLEN];
165
166 if ( _xos_long_file_nameW(expanded, lng, MAXPATHLEN) &&
167 _xos_canonical_filenameW(lng, buf, sizeof(buf), 0) )
168 { return UTF8ToName(buf);
169 } else
170 { errorPce(in, NAME_representation, NAME_nameTooLong);
171 fail;
172 }
173 #else
174 return WCToName(expanded, len);
175 #endif
176 }
177
178 fail;
179 }
180
181
182
183 static status
kindFile(FileObj f,Name encoding)184 kindFile(FileObj f, Name encoding)
185 { if ( f->status != NAME_closed )
186 return errorPce(f, NAME_noChangeAfterOpen);
187
188 if ( encoding == NAME_text )
189 { if ( !isName(f->encoding) )
190 assign(f, encoding, getClassVariableValueObject(f, NAME_encoding));
191 assign(f, kind, NAME_text);
192 } else if ( encoding == NAME_binary || encoding == NAME_octet )
193 { assign(f, kind, NAME_binary);
194 assign(f, encoding, NAME_octet);
195 } else
196 { assign(f, encoding, encoding);
197 assign(f, kind, NAME_text);
198 }
199
200 succeed;
201 }
202
203
204 Name
getOsNameFile(FileObj f)205 getOsNameFile(FileObj f)
206 { if ( notDefault(f->path) )
207 answer(f->path);
208
209 answer(f->name);
210 }
211
212
213 static status
unlinkFile(FileObj f)214 unlinkFile(FileObj f)
215 { return closeFile(f);
216 }
217
218
219 static status
storeFile(FileObj f,FileObj file)220 storeFile(FileObj f, FileObj file)
221 { return storeSlotsObject(f, file);
222 }
223
224
225 static status
loadFile(FileObj f,IOSTREAM * fd,ClassDef def)226 loadFile(FileObj f, IOSTREAM *fd, ClassDef def)
227 { TRY(loadSlotsObject(f, fd, def)); /* reopen? */
228
229 if ( isNil(f->path) )
230 assign(f, path, DEFAULT); /* backward compatibility load */
231 if ( !isName(f->kind) )
232 assign(f, kind, NAME_binary); /* same */
233 if ( !isName(f->encoding) )
234 assign(f, encoding, (f->kind == NAME_binary ? NAME_octet : NAME_text));
235 if ( !isDefault(f->bom) && !isBoolean(f->bom) )
236 assign(f, bom, DEFAULT);
237 if ( !isName(f->newline_mode) )
238 {
239 #ifdef __WINDOWS__
240 assign(f, newline_mode, NAME_dos);
241 #else
242 assign(f, newline_mode, NAME_posix);
243 #endif
244 }
245 assign(f, status, NAME_closed);
246 f->fd = NULL;
247
248 succeed;
249 }
250
251
252 static FileObj
getConvertFile(Class class,Name name)253 getConvertFile(Class class, Name name)
254 { answer(answerObject(ClassFile, name, EAV));
255 }
256
257
258 status
closeFile(FileObj f)259 closeFile(FileObj f)
260 { if ( f->status != NAME_closed )
261 { status rval = checkErrorFile(f);
262
263 Sclose(f->fd);
264 f->fd = NULL;
265 assign(f, status, NAME_closed);
266
267 return rval;
268 }
269
270 succeed;
271 }
272
273
274 status
existsFile(FileObj f,BoolObj mustbefile)275 existsFile(FileObj f, BoolObj mustbefile)
276 { STAT_TYPE buf;
277 const char *fn = charArrayToFN((CharArray)f->name);
278
279 #ifdef HAVE_ACCESS
280 if ( mustbefile == OFF )
281 { if ( access(fn, F_OK) == 0 )
282 succeed;
283 fail;
284 }
285 #endif
286 if ( STAT_FUNC(fn, &buf) == -1 )
287 fail;
288 if ( mustbefile != OFF && (buf.st_mode & S_IFMT) != S_IFREG )
289 fail;
290 succeed;
291 }
292
293
294 status
sameOsPath(const char * s1,const char * s2)295 sameOsPath(const char *s1, const char *s2)
296 { if ( streq(s1, s2) )
297 succeed;
298
299 #if O_XOS
300 return _xos_same_file(s1, s2);
301 #endif
302
303 #if __unix__
304 { struct stat buf1;
305 struct stat buf2;
306
307 if ( stat(s1, &buf1) == 0 &&
308 stat(s2, &buf2) == 0 &&
309 buf1.st_ino == buf2.st_ino &&
310 buf1.st_dev == buf2.st_dev )
311 succeed;
312 }
313 #endif
314
315 fail;
316 }
317
318
319 static status
sameFile(FileObj f1,FileObj f2)320 sameFile(FileObj f1, FileObj f2)
321 { Name n1 = getOsNameFile(f1);
322 Name n2 = getOsNameFile(f2);
323
324 if ( !n1 || !n2 )
325 fail;
326
327 return sameOsPath(strName(n1), strName(n2));
328 }
329
330
331
332 static status
absolutePathFile(FileObj f)333 absolutePathFile(FileObj f)
334 { char path[MAXPATHLEN];
335
336 if ( absolutePath(charArrayToUTF8((CharArray)f->name), path, sizeof(path)) > 0 )
337 { assign(f, path, UTF8ToName(path));
338 succeed;
339 }
340
341 return errorPce(f, NAME_representation, NAME_nameTooLong);
342 }
343
344
345 Name
getAbsolutePathFile(FileObj f)346 getAbsolutePathFile(FileObj f)
347 { char path[MAXPATHLEN];
348
349 if ( notDefault(f->path) )
350 answer(f->path);
351
352 if ( absolutePath(charArrayToUTF8((CharArray)f->name), path, sizeof(path)) > 0 )
353 return UTF8ToName(path);
354
355 errorPce(f, NAME_representation, NAME_nameTooLong);
356 fail;
357 }
358
359
360 status
isAbsoluteFile(FileObj f)361 isAbsoluteFile(FileObj f)
362 { return isAbsolutePath(charArrayToUTF8((CharArray)f->name));
363 }
364
365
366 #define CPBUFSIZE 4096
367
368 #ifndef O_BINARY
369 #define O_BINARY 0
370 #endif
371
372 #ifdef __WINDOWS__
373 #include <fcntl.h>
374 #endif
375
376 #ifndef O_RDONLY
377 #define O_RDONLY _O_RDONLY
378 #define O_WRONLY _O_WRONLY
379 #endif
380
381 static int
open_file(FileObj f,int access,...)382 open_file(FileObj f, int access, ...)
383 { va_list args;
384 int mode;
385 int fd = -1;
386
387 va_start(args, access);
388 mode = va_arg(args, int);
389 va_end(args);
390
391 fd = open(charArrayToFN((CharArray)f->name), access, mode);
392
393 if ( fd < 0 )
394 errorPce(f, NAME_openFile,
395 (access & O_RDONLY) ? NAME_read : NAME_write,
396 getOsErrorPce(PCE));
397
398 return fd;
399 }
400
401
402 static status
copyFile(FileObj to,FileObj from)403 copyFile(FileObj to, FileObj from)
404 { int fdfrom, fdto;
405 char buf[CPBUFSIZE];
406 status rval;
407 int n;
408
409 if ( (fdfrom = open_file(from, O_RDONLY|O_BINARY)) < 0 )
410 fail;
411 if ( (fdto = open_file(to, O_WRONLY|O_BINARY|O_CREAT|O_TRUNC, 0666)) < 0 )
412 { close(fdfrom);
413 fail;
414 }
415
416 while( (n = read(fdfrom, buf, CPBUFSIZE)) > 0 )
417 { char *b = buf;
418
419 while(n > 0)
420 { int n2;
421
422 if ( (n2=write(fdto, b, n)) < 0 )
423 { errorPce(to, NAME_ioError, getOsErrorPce(PCE));
424 rval = FAIL;
425 goto out;
426 }
427 b += n2;
428 n -= n2;
429 }
430 }
431 if ( n < 0 )
432 { errorPce(from, NAME_ioError, getOsErrorPce(PCE));
433 rval = FAIL;
434 } else
435 rval = SUCCEED;
436
437 out:
438 close(fdfrom);
439 close(fdto);
440
441 return rval;
442 }
443
444
445 static status
backup_name(const char * old,const char * ext,char * bak,size_t len)446 backup_name(const char *old, const char *ext, char *bak, size_t len)
447 { if ( strlen(old) + strlen(ext) + 1 <= len )
448 { sprintf(bak, "%s%s", old, ext);
449 succeed;
450 } else
451 { errno = ENAMETOOLONG;
452 fail;
453 }
454 }
455
456
457 static Name
getBackupFileNameFile(FileObj f,Name ext)458 getBackupFileNameFile(FileObj f, Name ext)
459 { char bak[MAXPATHLEN*2];
460
461 if ( backup_name(nameToUTF8(f->name),
462 isDefault(ext) ? "~" : nameToUTF8(ext),
463 bak, sizeof(bak)) )
464 answer(UTF8ToName(bak));
465
466 errorPce(f, NAME_representation, NAME_nameTooLong);
467 fail;
468 }
469
470
471 static status
backupFile(FileObj f,Name ext)472 backupFile(FileObj f, Name ext)
473 { if ( existsFile(f, ON) )
474 { Name newname = get(f, NAME_backupFileName, ext, EAV);
475 const char *new;
476 const char *old = nameToFN(getOsNameFile(f));
477 int fdfrom = -1, fdto = -1;
478 status rval = FAIL;
479
480 if ( newname )
481 new = nameToFN(newname);
482 else
483 fail; /* or succeed? */
484
485 if ( (fdfrom = open(old, O_RDONLY)) >= 0 &&
486 (fdto = open(new, O_WRONLY|O_CREAT|O_TRUNC, 0666)) >= 0 )
487 { char buf[CPBUFSIZE];
488 int n;
489
490 while( (n = read(fdfrom, buf, CPBUFSIZE)) > 0 )
491 { if ( write(fdto, buf, n) != n )
492 { rval = FAIL;
493 goto out;
494 }
495 }
496 rval = (n == 0) ? SUCCEED : FAIL;
497 }
498
499 out:
500 if ( rval == FAIL )
501 errorPce(f, NAME_backupFile, newname, getOsErrorPce(PCE));
502
503 if ( fdfrom >= 0 )
504 close(fdfrom);
505 if ( fdto >= 0 )
506 close(fdto);
507
508 return rval;
509 }
510
511 succeed;
512 }
513
514
515 static status
accessFile(FileObj f,Name mode)516 accessFile(FileObj f, Name mode)
517 { int m;
518 Name name = getOsNameFile(f);
519
520 if ( name )
521 { if ( mode == NAME_read )
522 m = R_OK;
523 else if ( mode == NAME_write || mode == NAME_append )
524 m = W_OK;
525 else /*if ( mode == NAME_execute )*/
526 #ifdef X_OK
527 m = X_OK;
528 #else
529 m = R_OK;
530 #endif
531
532 if ( access(strName(name), m) == 0 )
533 succeed;
534 }
535
536 fail;
537 }
538
539
540 static Attribute
getFilterFile(FileObj f)541 getFilterFile(FileObj f)
542 { Cell cell;
543
544 closeFile(f);
545
546 for_cell(cell, FileFilters->attributes)
547 { char path[MAXPATHLEN];
548 Attribute a = cell->value;
549 Name extension = a->name;
550 STAT_TYPE buf;
551
552 if ( !isName(extension) )
553 { errorPce(extension, NAME_unexpectedType, TypeName);
554 fail;
555 }
556
557 sprintf(path, "%s%s", strName(f->name), strName(extension));
558 if ( STAT_FUNC(path, &buf) == 0 &&
559 (buf.st_mode & S_IFMT) == S_IFREG )
560 { if ( !isName(a->value) )
561 { errorPce(a->value, NAME_unexpectedType, TypeName);
562 fail;
563 }
564
565 answer(a);
566 }
567 }
568
569 fail;
570 }
571
572
573 status
doBOMFile(FileObj f)574 doBOMFile(FileObj f)
575 { assert(f->fd); /* must be open */
576
577 if ( f->kind == NAME_text )
578 { if ( f->status == NAME_read )
579 { if ( f->bom != OFF )
580 { if ( ScheckBOM(f->fd) < 0 )
581 { error:
582
583 reportErrorFile(f);
584 closeFile(f);
585
586 fail;
587 }
588
589 assign(f, bom, (f->fd->flags & SIO_BOM) ? ON : OFF);
590 if ( f->bom == ON )
591 assign(f, encoding, encoding_to_name(f->fd->encoding));
592 }
593 } else /* write */
594 { if ( f->bom == ON )
595 { if ( SwriteBOM(f->fd) < 0 )
596 { goto error;
597 }
598 }
599 }
600 }
601
602 succeed;
603 }
604
605
606 status
openFile(FileObj f,Name mode,Name filter,CharArray extension)607 openFile(FileObj f, Name mode, Name filter, CharArray extension)
608 { CharArray path;
609 Name name = getOsNameFile(f);
610 char fdmode[3];
611
612 if ( f->status == NAME_tmpWrite )
613 { if ( mode == NAME_write || mode == NAME_append )
614 { assign(f, status, NAME_write);
615 succeed;
616 }
617 }
618
619 closeFile(f);
620
621 if ( !name )
622 fail;
623
624 if ( isDefault(filter) )
625 filter = f->filter;
626
627 if ( isDefault(extension) )
628 path = (CharArray) name;
629 else
630 path = getAppendCharArray((CharArray) name, extension);
631
632 if ( mode == NAME_write )
633 fdmode[0] = 'w';
634 else if ( mode == NAME_append )
635 fdmode[0] = 'a';
636 else /* read */
637 fdmode[0] = 'r';
638
639 if ( f->kind == NAME_text )
640 fdmode[1] = '\0';
641 else
642 fdmode[1] = 'b';
643
644 fdmode[2] = '\0';
645
646 if ( isNil(filter) )
647 { DEBUG(NAME_file, Cprintf("Opening %s (%s) using mode %s\n",
648 pp(f->name), pp(f), fdmode));
649 f->fd = Sopen_file(charArrayToFN(path), fdmode);
650 } else
651 #ifndef HAVE_POPEN
652 { return errorPce(f, NAME_noPopen);
653 }
654 #else
655 { char cmd[LINESIZE];
656 const char *fn = nameToFN(filter);
657 const char *pn = charArrayToFN(path);
658 const char *rn = (mode == NAME_read ? "<" : mode == NAME_write ? ">" : ">>");
659
660 if ( fdmode[0] == 'a' )
661 fdmode[0] = 'w';
662
663 if ( strlen(fn)+strlen(pn)+7 > LINESIZE )
664 return errorPce(f, NAME_representation, NAME_nameTooLong);
665
666 sprintf(cmd, "%s %s \"%s\"", fn, rn, pn);
667 f->fd = Sopen_pipe(cmd, fdmode);
668 }
669 #endif /*HAVE_POPEN*/
670
671 if ( f->fd == NULL )
672 { if ( isNil(filter) && mode == NAME_read && errno == ENOENT )
673 { Attribute a;
674
675 if ( (a = get(f, NAME_filter, EAV)) )
676 { if ( !isName(a->value) || !isName(a->name) )
677 fail;
678 return openFile(f, mode, a->value, a->name);
679 }
680 }
681
682 return errorPce(f, NAME_openFile, mode, getOsErrorPce(PCE));
683 }
684
685 if ( mode == NAME_append )
686 mode = NAME_write;
687 assign(f, status, mode);
688 assign(f, filter, filter);
689
690 if ( mode == NAME_read )
691 { if ( !doBOMFile(f) )
692 fail;
693 if ( !setStreamEncodingSourceSink((SourceSink)f, f->fd) )
694 { closeFile(f);
695 fail;
696 }
697 } else
698 { if ( !setStreamEncodingSourceSink((SourceSink)f, f->fd) )
699 { closeFile(f);
700 fail;
701 }
702
703 if ( mode != NAME_append && !doBOMFile(f) )
704 fail;
705 }
706
707 succeed;
708 }
709
710
711 status
removeFile(FileObj f)712 removeFile(FileObj f)
713 { Name name = getOsNameFile(f);
714
715 closeFile(f); /* Ok? */
716
717 if ( remove(nameToFN(name)) == 0 )
718 succeed;
719 if ( existsFile(f, OFF) )
720 return errorPce(f, NAME_removeFile, getOsErrorPce(PCE));
721
722 fail;
723 }
724
725
726 static status
nameFile(FileObj f,Name name)727 nameFile(FileObj f, Name name)
728 { int rval;
729 Name ofn = getOsNameFile(f);
730 Name nfn = expandFileName(name);
731
732 if ( !nfn )
733 fail;
734
735 if ( existsFile(f, OFF) )
736 { const char *ofns = nameToFN(ofn);
737 const char *nfns = nameToFN(nfn);
738
739 #ifdef HAVE_RENAME
740 remove(nfns);
741 rval = rename(ofns, nfns);
742 #else
743 unlink(nfns);
744 if ((rval = link(ofns, nfns)) == 0 && (rval = unlink(ofns)) != 0)
745 unlink(nfns);
746 #endif /*__unix__*/
747
748 if ( rval == 0 )
749 { assign(f, name, nfn);
750 succeed;
751 }
752
753 return errorPce(f, NAME_renameFile, name, getOsErrorPce(PCE));
754 } else
755 { assign(f, name, name);
756 succeed;
757 }
758 }
759
760
761 static status
check_file(FileObj f,Name mode)762 check_file(FileObj f, Name mode)
763 { if ( (mode == f->status) ||
764 (mode == NAME_write && f->status == NAME_append) ||
765 (mode == NAME_open && f->status != NAME_closed) )
766 succeed;
767
768 return errorPce(f, NAME_notOpenFile, mode);
769 }
770
771
772 static Int
getIndexFile(FileObj f)773 getIndexFile(FileObj f)
774 { TRY( check_file(f, NAME_open) );
775
776 answer(toInt(Stell(f->fd)));
777 }
778
779
780 static status
seekFile(FileObj f,Int index,Name whence)781 seekFile(FileObj f, Int index, Name whence)
782 { TRY( check_file(f, NAME_open) );
783 if ( notNil(f->filter) )
784 return errorPce(f, NAME_cannotSeekNonFile);
785
786 if ( isDefault(whence) )
787 whence = NAME_start;
788
789 if ( Sseek(f->fd, valInt(index), whence == NAME_start ? 0 :
790 whence == NAME_here ? 1 :
791 2 ) == -1 )
792 return errorPce(f, NAME_seekFile, index, whence, getOsErrorPce(PCE));
793
794 succeed;
795 }
796
797
798 static status
append_file(FileObj f,PceString str)799 append_file(FileObj f, PceString str)
800 { TRY( check_file(f, NAME_write) );
801
802 if ( f->encoding == NAME_octet )
803 { if ( Sfwrite(str->s_text,
804 isstrA(str) ? sizeof(charA) : sizeof(charW),
805 str->s_size,
806 f->fd) != str->s_size )
807 return reportErrorFile(f);
808 } else
809 { if ( isstrA(str) )
810 { const charA *s = str->s_textA;
811 const charA *e = &s[str->s_size];
812
813 for(; s<e; s++)
814 { if ( Sputcode(*s, f->fd) < 0 )
815 return reportErrorFile(f);
816 }
817 } else
818 { const charW *s = str->s_textW;
819 const charW *e = &s[str->s_size];
820
821 for(; s<e; s++)
822 { if ( Sputcode(*s, f->fd) < 0 )
823 return reportErrorFile(f);
824 }
825 }
826 }
827
828 succeed;
829 }
830
831
832 static status
newlineFile(FileObj f)833 newlineFile(FileObj f)
834 { return append_file(f, str_nl(NULL)); /* only ASCII */
835 }
836
837
838 static status
appendFile(FileObj f,CharArray str)839 appendFile(FileObj f, CharArray str)
840 { return append_file(f, &str->data);
841 }
842
843
844 static status
formatFile(FileObj f,CharArray fmt,int argc,Any * argv)845 formatFile(FileObj f, CharArray fmt, int argc, Any *argv)
846 { string s;
847
848 TRY(str_writefv(&s, fmt, argc, argv));
849 append_file(f, &s);
850 str_unalloc(&s);
851
852 succeed;
853 }
854
855
856 static status
flushFile(FileObj f)857 flushFile(FileObj f)
858 { if ( f->fd )
859 Sflush(f->fd);
860
861 succeed;
862 }
863
864
865 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
866 We can use the faster fstat() here, but confirmed by various messages on
867 the web, MS-Windows implementation of _fstat() is broken, returning
868 EBADF for perfectly valid filedescriptors. Shouldn't make a difference,
869 only slow ...
870 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
871
872 static int
statFile(FileObj f,STAT_TYPE * buf)873 statFile(FileObj f, STAT_TYPE *buf)
874 {
875 #ifndef __WINDOWS__
876 int fno;
877
878 if ( f->fd != NULL && (fno = Sfileno(f->fd)) >= 0)
879 { return FSTAT_FUNC(fno, buf);
880 } else
881 #endif
882 { Name name = getOsNameFile(f);
883
884 return STAT_FUNC(nameToFN(name), buf);
885 }
886 }
887
888
889
890 static Int
getSizeFile(FileObj f)891 getSizeFile(FileObj f)
892 { STAT_TYPE buf;
893
894 if ( statFile(f, &buf) == -1 )
895 { errorPce(f, NAME_cannotStat, getOsErrorPce(PCE));
896 fail;
897 }
898
899 answer(toInt(buf.st_size));
900 }
901
902
903 static Date
getTimeFile(FileObj f,Name which)904 getTimeFile(FileObj f, Name which)
905 { STAT_TYPE buf;
906
907 if ( isDefault(which) )
908 which = NAME_modified;
909
910 if ( statFile(f, &buf) < 0 )
911 { errorPce(f, NAME_cannotStat, getOsErrorPce(PCE));
912 fail;
913 }
914
915 if ( which == NAME_modified )
916 answer(CtoDate(buf.st_mtime));
917 else
918 answer(CtoDate(buf.st_atime));
919 }
920
921
922 Name
getBaseNameFile(FileObj f)923 getBaseNameFile(FileObj f)
924 { const char *ufn = nameToUTF8(f->name);
925
926 answer(UTF8ToName(baseName(ufn)));
927 }
928
929
930 static Name
getDirectoryNameFile(FileObj f)931 getDirectoryNameFile(FileObj f)
932 { char dir[MAXPATHLEN];
933
934 dirName(nameToUTF8(getOsNameFile(f)), dir, sizeof(dir));
935
936 answer(UTF8ToName(dir));
937 }
938
939
940 static StringObj
getReadLineFile(FileObj f)941 getReadLineFile(FileObj f)
942 { tmp_string tmp;
943 StringObj rval;
944
945 TRY( check_file(f, NAME_read) );
946
947 str_tmp_init(&tmp);
948
949 for(;;)
950 { int c = Sgetcode(f->fd);
951
952 if ( c == EOF )
953 { if ( tmp.s.s_size == 0 )
954 fail;
955 break;
956 }
957
958 str_tmp_put(&tmp, (wint_t)c);
959 if ( c == '\n' )
960 break;
961 }
962
963 rval = StringToString(&tmp.s);
964 str_tmp_done(&tmp);
965
966 return rval;
967 }
968
969
970 static StringObj
getReadFile(FileObj f,Int n)971 getReadFile(FileObj f, Int n)
972 { size_t size;
973 StringObj s;
974
975 TRY( check_file(f, NAME_read) );
976 if ( isDefault(n) )
977 { Int here = getIndexFile(f);
978 Int len = getSizeFile(f);
979
980 if ( !here || !len )
981 fail;
982 n = sub(len, here);
983 }
984
985 size = valInt(n);
986 if ( size > STR_MAX_SIZE )
987 { errorPce(f, NAME_stringTooLong, toInt(size));
988 fail;
989 }
990
991 if ( f->encoding == NAME_octet )
992 { size_t m;
993
994 s = answerObject(ClassString, EAV);
995 str_unalloc(&s->data);
996 str_inithdr(&s->data, FALSE);
997 s->data.s_size = (int)size;
998 str_alloc(&s->data);
999
1000 if ( (m = Sfread(s->data.s_textA, 1, size, f->fd)) != size )
1001 { deleteString(s, toInt(m), DEFAULT); /* TBD: error? */
1002 }
1003 } else
1004 { tmp_string tmp;
1005 int c;
1006
1007 str_tmp_init(&tmp);
1008 while(tmp.s.s_size < size && (c = Sgetcode(f->fd)) != EOF )
1009 { str_tmp_put(&tmp, (wint_t)c);
1010 }
1011 if ( !checkErrorFile(f) )
1012 { str_tmp_done(&tmp);
1013 fail;
1014 }
1015 s = StringToString(&tmp.s);
1016 str_tmp_done(&tmp);
1017 }
1018
1019 answer(s);
1020 }
1021
1022
1023 static Int
getCharacterFile(FileObj f)1024 getCharacterFile(FileObj f)
1025 { int chr;
1026
1027 TRY( check_file(f, NAME_read) );
1028 if ( Sfeof(f->fd) )
1029 fail;
1030
1031 chr = Sgetcode(f->fd);
1032
1033 answer(toInt(chr));
1034 }
1035
1036
1037 /********************************
1038 * SAVE/LOAD SUPPORT *
1039 ********************************/
1040
1041 status
reportErrorFile(FileObj f)1042 reportErrorFile(FileObj f)
1043 { errorPce(f, NAME_ioError, getOsErrorPce(PCE));
1044 fail;
1045 }
1046
1047
1048 status
checkErrorFile(FileObj f)1049 checkErrorFile(FileObj f)
1050 { if ( f->fd == NULL )
1051 succeed;
1052
1053 if ( Sferror(f->fd) )
1054 return reportErrorFile(f);
1055
1056 succeed;
1057 }
1058
1059
1060 status
storeCharFile(FileObj f,int c)1061 storeCharFile(FileObj f, int c)
1062 { if ( f->encoding == NAME_octet )
1063 Sputc(c, f->fd);
1064 else
1065 Sputcode(c, f->fd);
1066
1067 return checkErrorFile(f);
1068 }
1069
1070
1071 void
putstdw(unsigned long w,IOSTREAM * fd)1072 putstdw(unsigned long w, IOSTREAM *fd)
1073 {
1074 #ifndef WORDS_BIGENDIAN
1075 union
1076 { unsigned long l;
1077 unsigned char c[4];
1078 } cvrt;
1079 unsigned long rval;
1080
1081 cvrt.l = w;
1082 rval = (cvrt.c[0] << 24) |
1083 (cvrt.c[1] << 16) |
1084 (cvrt.c[2] << 8) |
1085 cvrt.c[3];
1086 Sputw(rval, fd);
1087 #else /*WORDS_BIGENDIAN*/
1088 Sputw(w, fd);
1089 #endif /*WORDS_BIGENDIAN*/
1090 }
1091
1092
1093 status
storeWordFile(FileObj f,Any w)1094 storeWordFile(FileObj f, Any w)
1095 { putstdw((uintptr_t) w, f->fd);
1096
1097 return checkErrorFile(f);
1098 }
1099
1100 #ifdef WORDS_BIGENDIAN
1101 static const int double_byte_order[] = { 7,6,5,4,3,2,1,0 };
1102 #else
1103 static const int double_byte_order[] = { 0,1,2,3,4,5,6,7 };
1104 #endif
1105
1106 #define BYTES_PER_DOUBLE (sizeof(double_byte_order)/sizeof(int))
1107
1108 status
storeDoubleFile(FileObj file,double f)1109 storeDoubleFile(FileObj file, double f)
1110 { unsigned char *cl = (unsigned char *)&f;
1111 unsigned int i;
1112
1113 for(i=0; i<BYTES_PER_DOUBLE; i++)
1114 Sputc(cl[double_byte_order[i]], file->fd);
1115
1116 return checkErrorFile(file);
1117 }
1118
1119
1120 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1121 storeStringFile() stores a string to a file. For compatibility reasons
1122 the format is somewhat strange. If the string is 8-bit, it is stored as
1123 length followed by the character data. Otherwise it is stores as
1124 NEGATIVE length followed by a sequence of UTF-8 character codes.
1125
1126 Note that if the string is wide but need not be, it is saved as if it is
1127 an ISO Latin-1 string.
1128 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1129
1130 status
storeStringFile(FileObj f,PceString s)1131 storeStringFile(FileObj f, PceString s)
1132 { if ( isstrA(s) )
1133 { TRY(storeWordFile(f, (Any) (uintptr_t)s->s_size));
1134 Sfwrite(s->s_textA, sizeof(char), s->s_size, f->fd);
1135
1136 DEBUG(NAME_save, Cprintf("Saved ISO string, %ld chars\n", s->s_size));
1137 } else if ( !str_iswide(s) )
1138 { const charW *w = s->s_textW;
1139 const charW *e = &w[s->s_size];
1140
1141 TRY(storeWordFile(f, (Any) (uintptr_t)s->s_size));
1142 for( ; w<e; w++)
1143 { if ( Sputc(*w, f->fd) < 0 )
1144 return checkErrorFile(f);
1145 }
1146
1147 DEBUG(NAME_save,
1148 Cprintf("Saved converted ISO string, %ld chars\n", s->s_size));
1149 } else
1150 { IOENC oenc;
1151 const charW *w = s->s_textW;
1152 const charW *e = &w[s->s_size];
1153
1154 TRY(storeWordFile(f, (Any) -(uintptr_t)s->s_size));
1155 oenc = f->fd->encoding;
1156 f->fd->encoding = ENC_UTF8;
1157 for( ; w<e; w++)
1158 { if ( Sputcode(*w, f->fd) < 0 )
1159 { f->fd->encoding = oenc;
1160 return checkErrorFile(f);
1161 }
1162 }
1163 f->fd->encoding = oenc;
1164
1165 DEBUG(NAME_save, Cprintf("Saved wide string, %ld chars\n", s->s_size));
1166 }
1167
1168 return checkErrorFile(f);
1169 }
1170
1171
1172 status
storeNameFile(FileObj f,Name n)1173 storeNameFile(FileObj f, Name n)
1174 { return storeStringFile(f, &n->data);
1175 }
1176
1177
1178 status
storeIntFile(FileObj f,Int i)1179 storeIntFile(FileObj f, Int i)
1180 { return storeWordFile(f, (Any) valInt(i));
1181 }
1182
1183
1184 /********************************
1185 * PATHS *
1186 ********************************/
1187
1188 static int
waccess(const wchar_t * name,int m)1189 waccess(const wchar_t *name, int m)
1190 { string s;
1191 const char *ufn;
1192
1193 str_set_n_wchar(&s, wcslen(name), (wchar_t *)name);
1194 ufn = stringToFN(&s);
1195
1196 DEBUG(NAME_find, Cprintf("find: trying \"%s\"\n", ufn));
1197
1198 return access(ufn, m);
1199 }
1200
1201
1202 #ifndef X_OK
1203 #define X_OK 0
1204 #endif
1205
1206 status
findFile(FileObj f,CharArray path,Name mode)1207 findFile(FileObj f, CharArray path, Name mode)
1208 { wchar_t *base;
1209 wchar_t basebuf[MAXPATHLEN];
1210 const wchar_t *pathstr;
1211 size_t bl;
1212 int m;
1213
1214 if ( isAbsolutePath(nameToUTF8(f->name)) )
1215 succeed;
1216
1217 base = charArrayToWC((CharArray)f->name, &bl);
1218 if ( base[0] == '.' )
1219 succeed;
1220
1221 if ( isDefault(mode) || mode == NAME_read )
1222 m = R_OK;
1223 else if ( mode == NAME_write || mode == NAME_append )
1224 m = W_OK;
1225 else /*if ( mode == NAME_execute )*/
1226 m = X_OK;
1227
1228 if ( notDefault(f->path) && access(nameToFN(f->path), m) == 0 )
1229 succeed;
1230
1231 if ( bl+1 > MAXPATHLEN )
1232 return errorPce(f, NAME_representation, NAME_nameTooLong);
1233 wcscpy(basebuf, base);
1234 base = basebuf;
1235
1236 if ( isDefault(path) )
1237 pathstr = L".";
1238 else
1239 pathstr = charArrayToWC(path, NULL);
1240
1241 while( pathstr && *pathstr )
1242 { wchar_t name[MAXPATHLEN];
1243 wchar_t bin[MAXPATHLEN];
1244 const wchar_t *end = pathstr;
1245 size_t l;
1246
1247 #ifdef __WINDOWS__
1248 if ( end[0] < 0x80 && isalpha(end[0]) && end[1] == ':' )
1249 end += 2;
1250 #endif
1251
1252 if ( (end = wcschr(end, ':')) == NULL )
1253 { wcscpy(name, pathstr);
1254 pathstr = NULL;
1255 } else
1256 { wcsncpy(name, pathstr, end-pathstr);
1257 name[end-pathstr] = EOS;
1258 pathstr = &end[1];
1259 }
1260
1261 if ( wcschr(name, L'$') || name[0] == L'~' )
1262 { if ( (l=expandFileNameW(name, bin, MAXPATHLEN)) > 0 )
1263 wcsncpy(name, bin, l);
1264 else
1265 continue;
1266 } else
1267 { l = wcslen(name);
1268 }
1269
1270 name[l] = '/';
1271 wcscpy(&name[l+1], base);
1272
1273 if ( waccess(name, m) == 0 )
1274 { assign(f, path, WCToName(name, wcslen(name)));
1275 succeed;
1276 }
1277 }
1278
1279 return errorPce(f, NAME_cannotFindFile, path);
1280 }
1281
1282
1283 /*******************************
1284 * CLASS DECLARATION *
1285 *******************************/
1286
1287 /* Type declarations */
1288
1289 static char *T_seek[] =
1290 { "byte=int", "from=[{start,here,end}]" };
1291 static char *T_format[] =
1292 { "format=char_array", "argument=any ..." };
1293 static char *T_open[] =
1294 { "mode={read,write,append}", "filter=[name]",
1295 "extension=[char_array]" };
1296 static char *T_find[] =
1297 { "path=[char_array]", "access=[{read,write,append,execute}]" };
1298 static char *T_initialise[] =
1299 { "path=[name]",
1300 "encoding=[{text,binary,iso_latin_1,utf8,unicode_be,unicode_le}]"
1301 };
1302
1303 /* Instance Variables */
1304
1305 static vardecl var_file[] =
1306 { SV(NAME_name, "name=name", IV_GET|IV_STORE, nameFile,
1307 NAME_path, "Name of the file"),
1308 IV(NAME_path, "path=[name]", IV_BOTH,
1309 NAME_path, "Full path-name of the file"),
1310 SV(NAME_kind, "{text,binary}", IV_GET|IV_STORE, kindFile,
1311 NAME_fileType, "Text or binary file"),
1312 IV(NAME_status, "{closed,read,write,tmp_write}", IV_GET,
1313 NAME_open, "(How) opened or closed?"),
1314 IV(NAME_filter, "command=name*", IV_BOTH,
1315 NAME_filter, "Name of input/output filter used"),
1316 IV(NAME_bom, "[bool]", IV_BOTH,
1317 NAME_encoding, "Byte Order Mark"),
1318 IV(NAME_newlineMode, "{posix,dos,detect}", IV_BOTH,
1319 NAME_encoding, "Newline representation"),
1320 IV(NAME_fd, "alien:FILE *", IV_NONE,
1321 NAME_internal, "Unix file (stream) handle")
1322 };
1323
1324 /* Send Methods */
1325
1326 static senddecl send_file[] =
1327 { SM(NAME_initialise, 2, T_initialise, initialiseFile,
1328 DEFAULT, "Create from name and kind"),
1329 SM(NAME_unlink, 0, NULL, unlinkFile,
1330 DEFAULT, "Close file"),
1331 SM(NAME_encoding, 1, "{text,binary,iso_latin_1,utf8,unicode_be,unicode_le}",
1332 kindFile, NAME_fileType, "Specify text or binary encoding type"),
1333 SM(NAME_backup, 1, "extension=[name]", backupFile,
1334 NAME_copy, "Make a backup by adding extension (~)"),
1335 SM(NAME_copy, 1, "from=file", copyFile,
1336 NAME_copy, "Copy to destination file"),
1337 SM(NAME_remove, 0, NULL, removeFile,
1338 NAME_delete, "Unlink from Unix file system"),
1339 SM(NAME_find, 2, T_find, findFile,
1340 NAME_location, "Find file in search-path"),
1341 SM(NAME_seek, 2, T_seek, seekFile,
1342 NAME_location, "Seek to index from {start,here,end}"),
1343 SM(NAME_close, 0, NULL, closeFile,
1344 NAME_open, "Close file"),
1345 SM(NAME_open, 3, T_open, openFile,
1346 NAME_open, "Open file in mode, read/write through filter"),
1347 SM(NAME_absolutePath, 0, NULL, absolutePathFile,
1348 NAME_path, "Convert <-name to an absolute path"),
1349 SM(NAME_isAbsolute, 0, NULL, isAbsoluteFile,
1350 NAME_path, "Test if <-name specifies an absolute path"),
1351 SM(NAME_access, 1, "mode={read,write,append,execute}", accessFile,
1352 NAME_test, "Test if file has access"),
1353 SM(NAME_exists, 1, "must_be_file=[bool]", existsFile,
1354 NAME_test, "Test if file exists"),
1355 SM(NAME_same, 1, "file=file", sameFile,
1356 NAME_test, "Test if two paths refer to the same physical file"),
1357 SM(NAME_append, 1, "text=char_array", appendFile,
1358 NAME_write, "Append string to file"),
1359 SM(NAME_flush, 0, NULL, flushFile,
1360 NAME_write, "Flush pending output"),
1361 SM(NAME_format, 2, T_format, formatFile,
1362 NAME_write, "Format arguments and ->append"),
1363 SM(NAME_newline, 0, NULL, newlineFile,
1364 NAME_write, "Append newline to file")
1365 };
1366
1367 /* Get Methods */
1368
1369 static getdecl get_file[] =
1370 { GM(NAME_convert, 1, "file", "path=name", getConvertFile,
1371 DEFAULT, "Convert name to file"),
1372 GM(NAME_backupFileName, 1, "char_array", "extension=[char_array]",
1373 getBackupFileNameFile,
1374 NAME_copy, "Name for storing ->backup data"),
1375 GM(NAME_size, 0, "bytes=int", NULL, getSizeFile,
1376 NAME_dimension, "Size in characters"),
1377 GM(NAME_filter, 0, "extension_and_filter=attribute", NULL, getFilterFile,
1378 NAME_filter, "Determine input filter from extension"),
1379 GM(NAME_index, 0, "byte=int", NULL, getIndexFile,
1380 NAME_location, "Current index (Unix tell())"),
1381 GM(NAME_absolutePath, 0, "path=name", NULL, getAbsolutePathFile,
1382 NAME_path, "Convert <-name to an absolute path"),
1383 GM(NAME_baseName, 0, "name", NULL, getBaseNameFile,
1384 NAME_path, "Base name of file in directory"),
1385 GM(NAME_directoryName, 0, "name", NULL, getDirectoryNameFile,
1386 NAME_path, "Directory name of file"),
1387 GM(NAME_character, 0, "char", NULL, getCharacterFile,
1388 NAME_read, "Read next character as ASCII value"),
1389 GM(NAME_read, 1, "string", "count=[int]", getReadFile,
1390 NAME_read, "New string width next n characters"),
1391 GM(NAME_readLine, 0, "string", NULL, getReadLineFile,
1392 NAME_read, "New string with next line"),
1393 GM(NAME_time, 1, "date=date", "which_time=[{modified,access}]", getTimeFile,
1394 NAME_time, "New date holding modification/access time")
1395 };
1396
1397 /* Resources */
1398
1399 #define rc_file NULL
1400 /*
1401 static classvardecl rc_file[] =
1402 {
1403 };
1404 */
1405
1406 /* Class Declaration */
1407
1408 static Name file_termnames[] = { NAME_name };
1409
1410 ClassDecl(file_decls,
1411 var_file, send_file, get_file, rc_file,
1412 1, file_termnames,
1413 "$Rev$");
1414
1415 status
makeClassFile(Class class)1416 makeClassFile(Class class)
1417 { declareClass(class, &file_decls);
1418 setLoadStoreFunctionClass(class, loadFile, storeFile);
1419
1420 #if defined(__WINDOWS__)
1421 featureClass(class, NAME_caseSensitive, OFF);
1422 featureClass(class, NAME_casePreserving, ON);
1423 featureClass(class, NAME_8plus3names, OFF);
1424 #else
1425 featureClass(class, NAME_caseSensitive, ON);
1426 featureClass(class, NAME_casePreserving, ON);
1427 featureClass(class, NAME_8plus3names, OFF);
1428 #endif
1429
1430 FileFilters = globalObject(NAME_compressionFilters, ClassSheet,
1431 newObject(ClassAttribute,
1432 CtoName(".Z"),
1433 CtoName("uncompress"),
1434 EAV),
1435 newObject(ClassAttribute,
1436 CtoName(".gz"),
1437 CtoName("gunzip"),
1438 EAV),
1439 EAV);
1440
1441 succeed;
1442 }
1443