src/posix/generic/Host/Mod/Files.cp

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