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

   1 MODULE HostFiles;
   2
   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;
   7
   8   (* !!! add buffer cache *)
   9   (* !!! HostFiles64 must be base for HostFiles *)
  10
  11   CONST
  12     closed = 0; new = 1; temp = 2; shared = 3; exclusive = 4;
  13
  14   TYPE
  15     FullName* = Files.Name;
  16     NativeName* = ARRAY 1024 OF SHORTCHAR;
  17
  18     Locator = POINTER TO RECORD (Files.Locator)
  19       path-: FullName (* pathname # "" *)
  20     END;
  21
  22     Directory = POINTER TO RECORD (Files.Directory) END;
  23
  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;
  31
  32     Reader = POINTER TO RECORD (Files.Reader)
  33       f: File;
  34       pos: INTEGER
  35     END;
  36
  37     Writer = POINTER TO RECORD (Files.Writer)
  38       f: File;
  39       pos: INTEGER
  40     END;
  41
  42     InodeIdentifier = RECORD (Kernel.Identifier)
  43       ino: sysstat.ino_t
  44     END;
  45
  46   VAR
  47     ignoreAsk-: BOOLEAN;
  48     root: Locator;
  49
  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;
  56
  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;
  69
  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;
  86
  87   (* Locator *)
  88
  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;
  98
  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;
 108
 109   (* File *)
 110
 111   PROCEDURE (f: File) Length (): INTEGER;
 112   BEGIN
 113     RETURN f.len
 114   END Length;
 115
 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;
 128
 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;
 141
 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;
 150
 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;
 158
 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;
 176
 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;
 202
 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;
 220
 221   PROCEDURE (f: File) Closed (): BOOLEAN;
 222   BEGIN
 223     RETURN f.state = closed
 224   END Closed;
 225
 226   PROCEDURE (f: File) Shared (): BOOLEAN;
 227   BEGIN
 228     RETURN f.state = shared
 229   END Shared;
 230
 231   PROCEDURE (f: File) FINALIZE;
 232   BEGIN
 233     f.Close
 234   END FINALIZE;
 235
 236   (* Reader *)
 237
 238   PROCEDURE (r: Reader) Base (): File;
 239   BEGIN
 240     RETURN r.f
 241   END Base;
 242
 243   PROCEDURE (r: Reader) Pos (): INTEGER;
 244   BEGIN
 245     RETURN r.pos
 246   END Pos;
 247
 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;
 255
 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;
 268
 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;
 283
 284   (* Writer *)
 285
 286   PROCEDURE (w: Writer) Base (): File;
 287   BEGIN
 288     RETURN w.f
 289   END Base;
 290
 291   PROCEDURE (w: Writer) Pos (): INTEGER;
 292   BEGIN
 293     RETURN w.pos
 294   END Pos;
 295
 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;
 302
 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;
 315
 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;
 331
 332   (* Directory *)
 333
 334   PROCEDURE (d: Directory) This (IN path: ARRAY OF CHAR): Locator;
 335   BEGIN
 336     RETURN root.This(path)
 337   END This;
 338
 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 := S.VAL((*!!!*)sysstat.mode_t, 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;
 361
 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;
 402
 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;
 407
 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;
 412
 413     PROCEDURE Cleanup;
 414     BEGIN
 415       f := NIL;
 416       res := unistd.close(fd);
 417       ASSERT(res = 0, 100)
 418     END Cleanup;
 419
 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 := S.VAL((*!!!*)sysstat.mode_t, 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;
 485
 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;
 497
 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;
 521
 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;
 551
 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;
 583
 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;
 588
 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;
 610
 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;
 672
 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;
 723
 724   PROCEDURE (d: Directory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name);
 725   BEGIN
 726     filename := name + "." + type
 727   END GetFileName;
 728
 729   (* Misc *)
 730
 731   (* !!! implement NofFiles *)
 732   (* !!! implement GetModDate & GetName *)
 733
 734   PROCEDURE SetRootDir* (x: ARRAY OF CHAR);
 735   BEGIN
 736     root := NewLocator(x)
 737   END SetRootDir;
 738
 739   PROCEDURE UseAsk*;
 740   BEGIN
 741     ignoreAsk := FALSE
 742   END UseAsk;
 743
 744   PROCEDURE IgnoreAsk*;
 745   BEGIN
 746     ignoreAsk := TRUE
 747   END IgnoreAsk;
 748
 749   PROCEDURE Init;
 750     VAR d: Directory;
 751   BEGIN
 752     SetRootDir(".");
 753     NEW(d); Files.SetDir(d)
 754   END Init;
 755
 756 BEGIN
 757   Init
 758 END HostFiles.