DEADSOFTWARE

added cygwin support (only via cpfront)
[cpc.git] / src / posix / generic / Host / Mod / Files.cp
1 MODULE HostFiles;
3 IMPORT S := SYSTEM, Kernel, HostLang, Files, Log, stdlib := PosixCstdlib,
4 unistd := PosixCunistd, dirent := PosixCdirent, fcntl := PosixCfcntl,
5 sysstat := PosixCsys_stat, stdio := PosixCstdio, errno := PosixCerrno,
6 macro := PosixCmacro, libgen := PosixClibgen, time := PosixCtime;
8 (* !!! add buffer cache *)
9 (* !!! HostFiles64 must be base for HostFiles *)
11 CONST
12 closed = 0; new = 1; temp = 2; shared = 3; exclusive = 4;
14 TYPE
15 FullName* = Files.Name;
16 NativeName* = ARRAY 1024 OF SHORTCHAR;
18 Locator = POINTER TO RECORD (Files.Locator)
19 path-: FullName (* pathname # "" *)
20 END;
22 Directory = POINTER TO RECORD (Files.Directory) END;
24 File = POINTER TO RECORD (Files.File)
25 state: INTEGER;
26 len: INTEGER; (* !!! must be sysstat.off_t *)
27 fd: unistd.int;
28 ino: sysstat.ino_t;
29 pathname: FullName
30 END;
32 Reader = POINTER TO RECORD (Files.Reader)
33 f: File;
34 pos: INTEGER
35 END;
37 Writer = POINTER TO RECORD (Files.Writer)
38 f: File;
39 pos: INTEGER
40 END;
42 InodeIdentifier = RECORD (Kernel.Identifier)
43 ino: sysstat.ino_t
44 END;
46 VAR
47 ignoreAsk-: BOOLEAN;
48 root: Locator;
50 PROCEDURE (VAR id: InodeIdentifier) Identified (): BOOLEAN;
51 VAR f: File;
52 BEGIN
53 f := id.obj(File);
54 RETURN (f.state # closed) & (f.ino = id.ino)
55 END Identified;
57 PROCEDURE GetFileByInode (ino: sysstat.ino_t): File;
58 VAR id: InodeIdentifier; obj: ANYPTR; f: File;
59 BEGIN
60 ASSERT(ino # 0, 20);
61 id.typ := S.TYP(File);
62 id.ino := ino;
63 obj := Kernel.ThisFinObj(id);
64 IF obj # NIL THEN f := obj(File)
65 ELSE f := NIL
66 END;
67 RETURN f
68 END GetFileByInode;
70 PROCEDURE GetError (OUT res: INTEGER);
71 VAR err: INTEGER;
72 BEGIN
73 err := macro.errno();
74 CASE err OF
75 | errno.ENAMETOOLONG, errno.ENOTDIR: res := 1 (* invalid name/location *)
76 | errno.ENOENT: res := 2 (* file/dir not found *)
77 | errno.EEXIST: res := 3 (* file/dir already exists *)
78 | errno.EROFS: res := 4 (* write-protection *)
79 | errno.EIO: res := 5 (* io error *)
80 | errno.EACCES, errno.EPERM: res := 6 (* access denied *)
81 | errno.ENOMEM: res := 80 (* not enough memory *)
82 | errno.ENFILE, errno.ENOBUFS, errno.ENOSPC: res := 81 (* not enough system resources *)
83 ELSE res := -err
84 END
85 END GetError;
87 (* Locator *)
89 PROCEDURE NewLocator* (IN path: ARRAY OF CHAR): Locator;
90 VAR l: Locator; ch: SHORTCHAR;
91 BEGIN
92 NEW(l);
93 IF path = "" THEN l.path := "."
94 ELSE l.path := path$
95 END;
96 RETURN l
97 END NewLocator;
99 PROCEDURE (l: Locator) This (IN path: ARRAY OF CHAR): Locator;
100 VAR loc: Locator;
101 BEGIN
102 IF path = "" THEN NEW(loc); loc^ := l^
103 ELSIF path[0] = "/" THEN loc := NewLocator(path)
104 ELSE loc := NewLocator(l.path + "/" + path)
105 END;
106 RETURN loc
107 END This;
109 (* File *)
111 PROCEDURE (f: File) Length (): INTEGER;
112 BEGIN
113 RETURN f.len
114 END Length;
116 PROCEDURE (f: File) NewReader (old: Files.Reader): Reader;
117 VAR r: Reader;
118 BEGIN
119 ASSERT(f.state # closed, 20);
120 IF (old # NIL) & (old.Base() = f) THEN
121 r := old(Reader);
122 IF r.pos > f.len THEN r.pos := 0 END;
123 r.eof := FALSE
124 ELSE NEW(r); r.f := f; r.pos := 0
125 END;
126 RETURN r
127 END NewReader;
129 PROCEDURE (f: File) NewWriter (old: Files.Writer): Writer;
130 VAR w: Writer;
131 BEGIN
132 ASSERT(f.state # closed, 20);
133 ASSERT(f.state # shared, 21);
134 IF (old # NIL) & (old.Base() = f) THEN
135 w := old(Writer);
136 IF w.pos > f.len THEN w.pos := 0 END
137 ELSE NEW(w); w.f := f; w.pos := 0
138 END;
139 RETURN w
140 END NewWriter;
142 PROCEDURE (f: File) Flush;
143 VAR res: unistd.int;
144 BEGIN
145 IF f.state = exclusive THEN
146 res := unistd.fsync(f.fd);
147 ASSERT(res = 0, 100)
148 END
149 END Flush;
151 PROCEDURE IsName (IN name: Files.Name): BOOLEAN;
152 VAR i: INTEGER;
153 BEGIN
154 i := 0;
155 WHILE (name[i] # "/") & (name[i] # 0X) DO INC(i) END;
156 RETURN name[i] = 0X
157 END IsName;
159 PROCEDURE DirName (VAR path: ARRAY OF CHAR);
160 VAR i, j, k: INTEGER;
161 BEGIN
162 IF path[0] = "/" THEN i := 1; j := 1; k := 1
163 ELSE i := 0; j := 0; k := 0
164 END;
165 WHILE path[i] # 0X DO
166 IF path[i] = "/" THEN
167 k := j; j := i; INC(i);
168 WHILE (path[i] # 0X) & (path[i] = "/") DO INC(i) END;
169 IF path[i] = 0X THEN j := k END
170 ELSE
171 INC(i)
172 END
173 END;
174 path[j] := 0X
175 END DirName;
177 PROCEDURE (f: File) Register (name: Files.Name; type: Files.Type; ask: BOOLEAN; OUT res: INTEGER);
178 VAR i, err: INTEGER; dir: FullName; p0, p1: NativeName; s: sysstat.struct_stat; x: unistd.int;
179 BEGIN
180 ASSERT(f.state = new, 20);
181 ASSERT(name # "", 21);
182 ASSERT(IsName(name), 22);
183 HostLang.StringToHost(f.pathname, p0, HostLang.pep383, err);
184 IF err = 0 THEN
185 dir := f.pathname$;
186 DirName(dir);
187 HostLang.StringToHost(dir + "/" + name, p1, HostLang.pep383, err);
188 IF err = 0 THEN
189 x := stdio.rename(p0, p1);
190 IF x = 0 THEN res := 0 (* no error *)
191 ELSE GetError(res)
192 END;
193 f.state := exclusive;
194 f.Close
195 ELSE
196 res := 1 (* invalid name (too long?) *)
197 END
198 ELSE
199 res := 1 (* invalid name (too long?) *)
200 END
201 END Register;
203 PROCEDURE (f: File) Close;
204 VAR res: unistd.int; path: NativeName; err: INTEGER;
205 BEGIN
206 IF f.state # closed THEN
207 f.Flush;
208 IF f.state = new THEN
209 HostLang.StringToHost(f.pathname, path, HostLang.pep383, err);
210 ASSERT(err = 0, 100);
211 res := unistd.unlink(path);
212 ASSERT(res = 0, 101);
213 f.state := temp
214 END;
215 res := unistd.close(f.fd);
216 ASSERT(res = 0, 102);
217 f.state := closed
218 END
219 END Close;
221 PROCEDURE (f: File) Closed (): BOOLEAN;
222 BEGIN
223 RETURN f.state = closed
224 END Closed;
226 PROCEDURE (f: File) Shared (): BOOLEAN;
227 BEGIN
228 RETURN f.state = shared
229 END Shared;
231 PROCEDURE (f: File) FINALIZE;
232 BEGIN
233 f.Close
234 END FINALIZE;
236 (* Reader *)
238 PROCEDURE (r: Reader) Base (): File;
239 BEGIN
240 RETURN r.f
241 END Base;
243 PROCEDURE (r: Reader) Pos (): INTEGER;
244 BEGIN
245 RETURN r.pos
246 END Pos;
248 PROCEDURE (r: Reader) SetPos (pos: INTEGER);
249 BEGIN
250 ASSERT(pos >= 0, 20);
251 ASSERT(pos <= r.f.len, 21);
252 r.pos := pos;
253 r.eof := FALSE
254 END SetPos;
256 PROCEDURE (r: Reader) ReadByte (OUT x: BYTE);
257 VAR res: unistd.int; offset: unistd.off_t;
258 BEGIN
259 ASSERT(r.f.state # closed, 20);
260 offset := unistd.lseek(r.f.fd, r.pos, unistd.SEEK_SET);
261 ASSERT(offset = r.pos, 100);
262 res := unistd.read(r.f.fd, S.ADR(x), 1);
263 ASSERT(res # -1, 101);
264 IF res = 0 THEN x := 0 END;
265 r.pos := r.pos + res;
266 r.eof := res = 0
267 END ReadByte;
269 PROCEDURE (r: Reader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER);
270 VAR res: unistd.int; offset: unistd.off_t;
271 BEGIN
272 ASSERT(beg >= 0, 20);
273 ASSERT(len >= 0, 2);
274 ASSERT(beg + len <= LEN(x), 22);
275 ASSERT(r.f.state # closed, 23);
276 offset := unistd.lseek(r.f.fd, r.pos, unistd.SEEK_SET);
277 ASSERT(offset = r.pos, 100);
278 res := unistd.read(r.f.fd, S.ADR(x[beg]), len);
279 ASSERT(res # -1, 101);
280 r.pos := r.pos + res;
281 r.eof := res = 0
282 END ReadBytes;
284 (* Writer *)
286 PROCEDURE (w: Writer) Base (): File;
287 BEGIN
288 RETURN w.f
289 END Base;
291 PROCEDURE (w: Writer) Pos (): INTEGER;
292 BEGIN
293 RETURN w.pos
294 END Pos;
296 PROCEDURE (w: Writer) SetPos (pos: INTEGER);
297 BEGIN
298 ASSERT(pos >= 0, 20);
299 ASSERT(pos <= w.f.len, 21);
300 w.pos := pos
301 END SetPos;
303 PROCEDURE (w: Writer) WriteByte (x: BYTE);
304 VAR res: unistd.int; offset: unistd.off_t;
305 BEGIN
306 ASSERT(w.f.state # closed, 20);
307 offset := unistd.lseek(w.f.fd, w.pos, unistd.SEEK_SET);
308 ASSERT(offset = w.pos, 100);
309 res := unistd.write(w.f.fd, S.ADR(x), 1);
310 ASSERT(res # -1, 101);
311 w.pos := w.pos + res;
312 w.f.len := MAX(w.f.len, w.pos);
313 ASSERT(res = 1, 60)
314 END WriteByte;
316 PROCEDURE (w: Writer) WriteBytes (IN x: ARRAY OF BYTE; beg, len: INTEGER);
317 VAR res: unistd.int; offset: unistd.off_t;
318 BEGIN
319 ASSERT(beg >= 0, 20);
320 ASSERT(len >= 0, 21);
321 ASSERT(beg + len <= LEN(x), 22);
322 ASSERT(w.f.state # closed, 23);
323 offset := unistd.lseek(w.f.fd, w.pos, unistd.SEEK_SET);
324 ASSERT(offset = w.pos, 100);
325 res := unistd.write(w.f.fd, S.ADR(x[beg]), len);
326 ASSERT(res # -1, 101);
327 w.pos := w.pos + res;
328 w.f.len := MAX(w.f.len, w.pos);
329 ASSERT(res = len, 60)
330 END WriteBytes;
332 (* Directory *)
334 PROCEDURE (d: Directory) This (IN path: ARRAY OF CHAR): Locator;
335 BEGIN
336 RETURN root.This(path)
337 END This;
339 PROCEDURE MakeDir (path: ARRAY OF SHORTCHAR; OUT res: unistd.int);
340 VAR i: INTEGER; sep: BOOLEAN; err: unistd.int; s: sysstat.struct_stat; mode: sysstat.mode_t;
341 BEGIN
342 i := 0; err := 0;
343 mode := ORD(BITS(511(*a=rwx*)) - BITS(sysstat.umask(0)));
344 WHILE (err = 0) & (path[i] # 0X) DO
345 WHILE (path[i] # "/") & (path[i] # 0X) DO INC(i) END;
346 sep := path[i] = "/";
347 IF sep THEN path[i] := 0X END;
348 err := sysstat.mkdir(path, mode);
349 IF err = -1 THEN
350 GetError(err);
351 IF err = 3 THEN
352 (* already exists, continue make dirs *)
353 err := 0
354 END
355 END;
356 IF sep THEN path[i] := "/" END;
357 INC(i)
358 END;
359 res := err
360 END MakeDir;
362 PROCEDURE (d: Directory) New (loc: Files.Locator; ask: BOOLEAN): File;
363 VAR err: INTEGER; f: File; s: sysstat.struct_stat; fd, res: unistd.int; pathname: NativeName;
364 BEGIN
365 ASSERT(loc # NIL, 20);
366 WITH loc: Locator DO
367 HostLang.StringToHost(loc.path, pathname, HostLang.pep383, err);
368 IF err = 0 THEN
369 MakeDir(pathname, res);
370 IF res = 0 THEN
371 (* use fcntl.open() with O_TMPFILE for Linux 3.11+? *)
372 pathname := pathname + "/" + ".newXXXXXX";
373 fd := stdlib.mkstemp(pathname);
374 IF fd # -1 THEN
375 NEW(f); HostLang.HostToString(pathname, f.pathname, HostLang.pep383, err);
376 IF err = 0 THEN
377 (* !!! get valid inode? *)
378 f.fd := fd; f.len := 0; f.state := new; f.ino := 0;
379 loc.res := 0 (* no errors *)
380 ELSE
381 f := NIL;
382 res := unistd.close(fd);
383 ASSERT(res = 0, 100);
384 res := unistd.unlink(pathname);
385 ASSERT(res = 0, 101);
386 loc.res := 1 (* invalid name *)
387 END
388 ELSE
389 GetError(loc.res)
390 END
391 ELSE
392 loc.res := res
393 END
394 ELSE
395 loc.res := 1 (* invalid name *)
396 END
397 ELSE
398 loc.res := 1 (* invalid locator *)
399 END;
400 RETURN f
401 END New;
403 PROCEDURE IsRegFile (IN s: sysstat.struct_stat): BOOLEAN;
404 BEGIN
405 RETURN BITS(s.st_mode) * BITS(sysstat.S_IFMT) = BITS(sysstat.S_IFREG)
406 END IsRegFile;
408 PROCEDURE (d: Directory) Old (loc: Files.Locator; name: Files.Name; isShared: BOOLEAN): File;
409 CONST rwrwrw = 438;
410 VAR err: INTEGER; f, if: File; s: sysstat.struct_stat; fd, flags, res: unistd.int;
411 pathname: NativeName; mode: sysstat.mode_t; lock: fcntl.struct_flock;
413 PROCEDURE Cleanup;
414 BEGIN
415 f := NIL;
416 res := unistd.close(fd);
417 ASSERT(res = 0, 100)
418 END Cleanup;
420 BEGIN
421 ASSERT(loc # NIL, 20);
422 ASSERT(name # "", 21);
423 WITH loc: Locator DO
424 IF IsName(name) THEN
425 HostLang.StringToHost(loc.path + "/" + name, pathname, HostLang.pep383, err);
426 IF err = 0 THEN
427 res := macro.stat(pathname, s);
428 IF res = 0 THEN
429 IF IsRegFile(s) THEN
430 if := GetFileByInode(s.st_ino);
431 IF (if = NIL) OR isShared & (if.state = shared) THEN
432 mode := ORD(BITS(rwrwrw) - BITS(sysstat.umask(0)));
433 IF isShared THEN flags := fcntl.O_RDONLY
434 ELSE flags := fcntl.O_RDWR
435 END;
436 fd := fcntl.open(pathname, flags, mode);
437 IF fd # -1 THEN
438 IF isShared THEN lock.l_type := fcntl.F_RDLCK
439 ELSE lock.l_type := fcntl.F_WRLCK
440 END;
441 lock.l_whence := unistd.SEEK_SET;
442 lock.l_start := 0;
443 lock.l_len := 0;
444 lock.l_pid := 0;
445 res := fcntl.fcntl(fd, fcntl.F_SETLK, S.ADR(lock));
446 IF res # -1 THEN
447 NEW(f); HostLang.HostToString(pathname, f.pathname, HostLang.pep383, err);
448 IF err = 0 THEN
449 f.fd := fd; f.len := S.VAL((*!!!*)INTEGER, s.st_size); f.ino := s.st_ino;
450 IF isShared THEN f.state := shared
451 ELSE f.state := exclusive
452 END;
453 loc.res := 0 (* no errors *)
454 ELSE
455 loc.res := 1; (* invalid name *)
456 Cleanup
457 END
458 ELSE
459 GetError(loc.res); (* already locked *)
460 Cleanup
461 END
462 ELSE
463 GetError(loc.res) (* failed to open *)
464 END
465 ELSE
466 loc.res := 6 (* already opened / locked *)
467 END
468 ELSE
469 loc.res := 6 (* access denied (not a regular file) *)
470 END
471 ELSE
472 loc.res := 2 (* file not found *)
473 END
474 ELSE
475 loc.res := 1 (* invalid name *)
476 END
477 ELSE
478 loc.res := 1 (* invalid name *)
479 END
480 ELSE
481 loc.res := 1 (* invalid locator *)
482 END;
483 RETURN f
484 END Old;
486 PROCEDURE (d: Directory) Temp (): File;
487 VAR f: File; fd: unistd.int; name: ARRAY 12 OF SHORTCHAR;
488 BEGIN
489 (* use fcntl.open() with O_TMPFILE for Linux 3.11+? *)
490 name := ".tmpXXXXXX";
491 fd := stdlib.mkstemp(name);
492 ASSERT(fd # -1, 100);
493 (* !!! get pathname and unlink it here *)
494 NEW(f); f.fd := fd; f.pathname := ""; f.len := 0; f.ino := 0; f.state := temp;
495 RETURN f
496 END Temp;
498 PROCEDURE (d: Directory) Delete (loc: Files.Locator; name: Files.Name);
499 VAR pathname: NativeName; err: INTEGER; res: unistd.int;
500 BEGIN
501 ASSERT(loc # NIL, 20);
502 ASSERT(IsName(name), 21);
503 WITH loc: Locator DO
504 IF IsName(name) THEN
505 HostLang.StringToHost(loc.path + "/" + name, pathname, HostLang.pep383, err);
506 IF err = 0 THEN
507 res := unistd.unlink(pathname);
508 IF res = 0 THEN loc.res := 0 (* no error *)
509 ELSE GetError(loc.res)
510 END
511 ELSE
512 loc.res := 1 (* invalid name *)
513 END
514 ELSE
515 loc.res := 1 (* invalid name *)
516 END
517 ELSE
518 loc.res := 1 (* invalid locator *)
519 END
520 END Delete;
522 PROCEDURE (d: Directory) Rename (loc: Files.Locator; old, new: Files.Name; ask: BOOLEAN);
523 VAR p0, p1: NativeName; res: stdio.int; err: INTEGER;
524 BEGIN
525 ASSERT(loc # NIL, 20);
526 ASSERT(old # "", 21);
527 ASSERT(new # "", 22);
528 WITH loc: Locator DO
529 IF IsName(old) & IsName(new) THEN
530 HostLang.StringToHost(loc.path + "/" + old, p0, HostLang.pep383, err);
531 IF err = 0 THEN
532 HostLang.StringToHost(loc.path + "/" + new, p1, HostLang.pep383, err);
533 IF err = 0 THEN
534 res := stdio.rename(p0, p1);
535 IF res = 0 THEN loc.res := 0 (* no error *)
536 ELSE GetError(loc.res)
537 END
538 ELSE
539 loc.res := 1 (* invalid name *)
540 END
541 ELSE
542 loc.res := 1 (* invalid name *)
543 END
544 ELSE
545 loc.res := 1 (* invalid name *)
546 END
547 ELSE
548 loc.res := 1 (* invalid locator *)
549 END
550 END Rename;
552 PROCEDURE (d: Directory) SameFile (loc0: Files.Locator; name0: Files.Name; loc1: Files.Locator; name1: Files.Name): BOOLEAN;
553 VAR ok: BOOLEAN; a0, a1: NativeName; s0, s1: sysstat.struct_stat; err: INTEGER;
554 BEGIN
555 ASSERT(loc0 # NIL, 20);
556 ASSERT(name0 # "", 21);
557 ASSERT(loc1 # NIL, 22);
558 ASSERT(name1 # "", 23);
559 ok := FALSE;
560 WITH loc0: Locator DO
561 WITH loc1: Locator DO
562 IF IsName(name0) & IsName(name1) THEN
563 HostLang.StringToHost(loc0.path + "/" + name0, a0, HostLang.pep383, err);
564 IF err = 0 THEN
565 err := macro.stat(a0, s0);
566 IF err = 0 THEN
567 HostLang.StringToHost(loc1.path + "/" + name1, a1, HostLang.pep383, err);
568 IF err = 0 THEN
569 err := macro.stat(a1, s1);
570 IF err = 0 THEN
571 ok := s0.st_ino = s1.st_ino
572 END
573 END
574 END
575 END
576 END
577 ELSE (* don't trap *)
578 END
579 ELSE (* don't trap *)
580 END;
581 RETURN ok
582 END SameFile;
584 PROCEDURE IsDir (IN s: sysstat.struct_stat): BOOLEAN;
585 BEGIN
586 RETURN BITS(s.st_mode) * BITS(sysstat.S_IFMT) = BITS(sysstat.S_IFDIR)
587 END IsDir;
589 PROCEDURE GetAttr (IN path: NativeName; IN name: FullName; s: sysstat.struct_stat): SET;
590 VAR attr: SET;
591 BEGIN
592 attr := {};
593 IF name[0] = "." THEN INCL(attr, Files.hidden) END;
594 IF BITS(s.st_mode) * BITS(sysstat.S_IXOTH) # {} THEN INCL(attr, 16) END;
595 IF BITS(s.st_mode) * BITS(sysstat.S_IWOTH) # {} THEN INCL(attr, 17) END;
596 IF BITS(s.st_mode) * BITS(sysstat.S_IROTH) # {} THEN INCL(attr, 18) END;
597 IF BITS(s.st_mode) * BITS(sysstat.S_IXGRP) # {} THEN INCL(attr, 19) END;
598 IF BITS(s.st_mode) * BITS(sysstat.S_IWGRP) # {} THEN INCL(attr, 20) END;
599 IF BITS(s.st_mode) * BITS(sysstat.S_IRGRP) # {} THEN INCL(attr, 21) END;
600 IF BITS(s.st_mode) * BITS(sysstat.S_IXUSR) # {} THEN INCL(attr, 22) END;
601 IF BITS(s.st_mode) * BITS(sysstat.S_IWUSR) # {} THEN INCL(attr, 23) END;
602 IF BITS(s.st_mode) * BITS(sysstat.S_IRUSR) # {} THEN INCL(attr, 24) END;
603 IF BITS(s.st_mode) * BITS(sysstat.S_ISVTX) # {} THEN INCL(attr, 25) END;
604 IF BITS(s.st_mode) * BITS(sysstat.S_ISGID) # {} THEN INCL(attr, 26) END;
605 IF BITS(s.st_mode) * BITS(sysstat.S_ISUID) # {} THEN INCL(attr, 27) END;
606 (* !!! better to check real access? *)
607 IF BITS(s.st_mode) * BITS(sysstat.S_IRUSR) # {} THEN INCL(attr, Files.readOnly) END;
608 RETURN attr
609 END GetAttr;
611 PROCEDURE (d: Directory) FileList (loc: Files.Locator): Files.FileInfo;
612 VAR
613 pathname: NativeName;
614 name: FullName;
615 err: INTEGER;
616 p: dirent.PDIR;
617 ent: dirent.Pstruct_dirent;
618 s: sysstat.struct_stat;
619 res: sysstat.int;
620 tm: time.Pstruct_tm;
621 h, t: Files.FileInfo;
622 BEGIN
623 ASSERT(loc # NIL, 20);
624 WITH loc: Locator DO
625 HostLang.StringToHost(loc.path, pathname, HostLang.pep383, err);
626 IF err = 0 THEN
627 p := dirent.opendir(pathname);
628 IF p # NIL THEN
629 ent := dirent.readdir(p);
630 WHILE ent # NIL DO
631 HostLang.HostToString(ent.d_name, name, HostLang.pep383, err);
632 IF err = 0 THEN
633 HostLang.StringToHost(loc.path + "/" + name, pathname, HostLang.pep383, err);
634 IF err = 0 THEN
635 res := macro.stat(pathname, s);
636 IF (res = 0) & ~IsDir(s) THEN
637 IF h = NIL THEN NEW(h); t := h
638 ELSE NEW(t.next); t := t.next
639 END;
640 t.name := name$;
641 t.type := ""; (* ??? *)
642 t.length := S.VAL((*!!!*)INTEGER, s.st_size);
643 tm := time.localtime(s.st_mtim.tv_sec);
644 IF tm # NIL THEN
645 t.modified.year := tm.tm_year + 1900;
646 t.modified.month := tm.tm_mon + 1;
647 t.modified.day := tm.tm_mday;
648 t.modified.hour := tm.tm_hour;
649 t.modified.minute := tm.tm_min;
650 t.modified.second := tm.tm_sec
651 END;
652 t.attr := GetAttr(pathname, name, s)
653 END
654 END
655 END;
656 ent := dirent.readdir(p)
657 END;
658 res := dirent.closedir(p);
659 ASSERT(res = 0, 100);
660 loc.res := 0 (* no error *)
661 ELSE
662 GetError(loc.res)
663 END
664 ELSE
665 loc.res := 1 (* invalid name *)
666 END
667 ELSE
668 loc.res := 1 (* invalid locator *)
669 END;
670 RETURN h
671 END FileList;
673 PROCEDURE (d: Directory) LocList (loc: Files.Locator): Files.LocInfo;
674 VAR
675 pathname: NativeName;
676 name: FullName;
677 err: INTEGER;
678 p: dirent.PDIR;
679 ent: dirent.Pstruct_dirent;
680 s: sysstat.struct_stat;
681 res: sysstat.int;
682 tm: time.Pstruct_tm;
683 h, t: Files.LocInfo;
684 BEGIN
685 ASSERT(loc # NIL, 20);
686 WITH loc: Locator DO
687 HostLang.StringToHost(loc.path, pathname, HostLang.pep383, err);
688 IF err = 0 THEN
689 p := dirent.opendir(pathname);
690 IF p # NIL THEN
691 ent := dirent.readdir(p);
692 WHILE ent # NIL DO
693 HostLang.HostToString(ent.d_name, name, HostLang.pep383, err);
694 IF err = 0 THEN
695 HostLang.StringToHost(loc.path + "/" + name, pathname, HostLang.pep383, err);
696 IF err = 0 THEN
697 res := macro.stat(pathname, s);
698 IF (res = 0) & IsDir(s) & (name # ".") & (name # "..") THEN
699 IF h = NIL THEN NEW(h); t := h
700 ELSE NEW(t.next); t := t.next
701 END;
702 t.name := name$;
703 t.attr := GetAttr(pathname, name, s)
704 END
705 END
706 END;
707 ent := dirent.readdir(p)
708 END;
709 res := dirent.closedir(p);
710 ASSERT(res = 0, 100);
711 loc.res := 0 (* no error *)
712 ELSE
713 GetError(loc.res)
714 END
715 ELSE
716 loc.res := 1 (* invlid name *)
717 END
718 ELSE
719 loc.res := 1 (* invalid locator *)
720 END;
721 RETURN h
722 END LocList;
724 PROCEDURE (d: Directory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name);
725 BEGIN
726 filename := name + "." + type
727 END GetFileName;
729 (* Misc *)
731 (* !!! implement NofFiles *)
732 (* !!! implement GetModDate & GetName *)
734 PROCEDURE SetRootDir* (x: ARRAY OF CHAR);
735 BEGIN
736 root := NewLocator(x)
737 END SetRootDir;
739 PROCEDURE UseAsk*;
740 BEGIN
741 ignoreAsk := FALSE
742 END UseAsk;
744 PROCEDURE IgnoreAsk*;
745 BEGIN
746 ignoreAsk := TRUE
747 END IgnoreAsk;
749 PROCEDURE Init;
750 VAR d: Directory;
751 BEGIN
752 SetRootDir(".");
753 NEW(d); Files.SetDir(d)
754 END Init;
756 BEGIN
757 Init
758 END HostFiles.