Trurl-based/_Linux_/Host/Mod/Files.txt

   1 MODULE HostFiles;
   2
   3         (* THIS IS TEXT COPY OF Files.odc *)
   4         (* DO NOT EDIT *)
   5
   6         (*
   7                 A. V. Shiryaev, 2012.11: filenames encoding translation implemented
   8         *)
   9
  10         IMPORT SYSTEM, Kernel, Files, LinLibc, Iconv := LinIconv;
  11
  12         CONST
  13                 tempName = "odcxxxxx";
  14                 docType = "odc";
  15
  16                 serverVersion = TRUE;
  17
  18                 pathLen* = 260;
  19
  20                 nofbufs = 4;    (* max number of buffers per file *)
  21                 bufsize = 2 * 1024;     (* size of each buffer *)
  22
  23                 invalid = LinLibc.NULL;
  24
  25                 temp = 0; new = 1; shared = 2; hidden = 3; exclusive = 4; closed = 5;   (* file states *)
  26                 create = -1;
  27
  28                 ok = 0;
  29                 invalidName = 1;
  30                 invalidNameErr = MAX(INTEGER); (* On Windows this is 123 *)
  31                 notFound = 2;
  32                 fileNotFoundErr = LinLibc.ENOENT;
  33                 pathNotFoundErr = LinLibc.ENOENT;
  34                 existsAlready = 3;
  35                 fileExistsErr = LinLibc.EEXIST;
  36                 alreadyExistsErr = LinLibc.EEXIST; (* is alreadyExistsErr needed? *)
  37                 writeProtected = 4;
  38                 writeProtectedErr = LinLibc.EACCES;
  39                 ioError = 5; (* same as LinLibc.EIO *)
  40                 accessDenied = 6;
  41                 accessDeniedErr = LinLibc.EACCES;
  42                 sharingErr = LinLibc.EACCES;
  43                 netAccessDeniedErr = LinLibc.EACCES;
  44                 notEnoughMem = 80;
  45                 notEnoughMemoryErr = LinLibc.ENOMEM;
  46                 notEnoughDisk = 81;
  47                 diskFullErr = LinLibc.EDQUOT;
  48                 tooManyOpenFilesErr = LinLibc.EMFILE;
  49
  50                 noMoreFilesErr = 18;
  51
  52                 cancel = -8; retry = -9;
  53
  54         TYPE
  55                 FullName* = ARRAY pathLen OF CHAR;
  56
  57                 Locator* = POINTER TO RECORD (Files.Locator)
  58                         path-: FullName;        (* without trailing "/" *)
  59                         maxLen-: INTEGER;       (* maximum name length *)
  60                         caseSens-: BOOLEAN;     (* case sensitive file compares *)
  61                         rootLen-: INTEGER       (* for network version *)
  62                 END;
  63
  64                 Buffer = POINTER TO RECORD
  65                         dirty: BOOLEAN;
  66                         org, len: INTEGER;
  67                         data: ARRAY bufsize OF BYTE
  68                 END;
  69
  70                 File = POINTER TO RECORD (Files.File)
  71                         state: INTEGER;
  72                         name: FullName;
  73                         ref: LinLibc.PtrFILE;
  74                         loc: Locator;
  75                         swapper: INTEGER;       (* index into file table / next buffer to swap *)
  76                         len: INTEGER;
  77                         bufs: ARRAY nofbufs OF Buffer;
  78                         t: LONGINT      (* time stamp of last file operation *)
  79                 END;
  80
  81                 Reader = POINTER TO RECORD (Files.Reader)
  82                         base: File;
  83                         org, offset: INTEGER;
  84                         buf: Buffer
  85                 END;
  86
  87                 Writer = POINTER TO RECORD (Files.Writer)
  88                         base: File;
  89                         org, offset: INTEGER;
  90                         buf: Buffer
  91                 END;
  92
  93                 Directory = POINTER TO RECORD (Files.Directory)
  94                         temp, startup: Locator
  95                 END;
  96
  97                 Identifier = RECORD (Kernel.Identifier)
  98                         name: FullName
  99                 END;
 100
 101                 Searcher = RECORD (Kernel.Identifier)
 102                         t0: INTEGER;
 103                         f: File
 104                 END;
 105
 106                 Counter = RECORD (Kernel.Identifier)
 107                         count: INTEGER
 108                 END;
 109
 110                 ShortName = ARRAY pathLen * 4 OF SHORTCHAR;
 111
 112                 Encoding = ARRAY 32 OF SHORTCHAR;
 113
 114         VAR
 115                 MapParamString*: PROCEDURE(in, p0, p1, p2: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
 116                 dir: Directory;
 117                 wildcard: Files.Type;
 118                 startupDir: FullName;
 119                 startupLen: INTEGER;
 120                 res: INTEGER;
 121                 e, d: Iconv.iconv_t;
 122
 123         (* debugging functions *)
 124
 125         PROCEDURE Msg (IN str: ARRAY OF CHAR);
 126                 VAR ss: ARRAY 1024 OF SHORTCHAR; res, l: INTEGER;
 127         BEGIN
 128                 ss := SHORT(str);
 129                 l := LEN(ss$);
 130                 ss[l] := 0AX; ss[l + 1] := 0X;
 131                 res := LinLibc.printf(ss);
 132                 res := LinLibc.fflush(0)
 133         END Msg;
 134
 135         PROCEDURE Int (x: LONGINT);
 136                 VAR j, k: INTEGER; ch: CHAR; a, s: ARRAY 32 OF CHAR;
 137         BEGIN
 138                 IF x # MIN(LONGINT) THEN
 139                         IF x < 0 THEN s[0] := "-"; k := 1; x := -x ELSE k := 0 END;
 140                         j := 0; REPEAT a[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0
 141                 ELSE
 142                         a := "8085774586302733229"; s[0] := "-"; k := 1;
 143                         j := 0; WHILE a[j] # 0X DO INC(j) END
 144                 END;
 145                 ASSERT(k + j < LEN(s), 20);
 146                 REPEAT DEC(j); ch := a[j]; s[k] := ch; INC(k) UNTIL j = 0;
 147                 s[k] := 0X;
 148                 Msg(s);
 149         END Int;
 150
 151         (* end of debugging functions *)
 152
 153         (* encoding translation *)
 154
 155         PROCEDURE GetEnc (OUT enc: Encoding; OUT ok: BOOLEAN);
 156                 VAR env: LinLibc.PtrSTR;
 157                         i, j: INTEGER;
 158
 159                 PROCEDURE IsSLetter (c: SHORTCHAR): BOOLEAN;
 160                 BEGIN
 161                         RETURN (c >= 'a') & (c <= 'z')
 162                 END IsSLetter;
 163
 164                 PROCEDURE IsBLetter (c: SHORTCHAR): BOOLEAN;
 165                 BEGIN
 166                         RETURN (c >= 'A') & (c <= 'Z')
 167                 END IsBLetter;
 168
 169                 PROCEDURE IsValidEncChar (x: SHORTCHAR): BOOLEAN;
 170                 BEGIN
 171                         RETURN ((x >= 'A') & (x <= 'Z')) OR ((x >= '0') & (x <= '9')) OR (x = '-') OR (x = '_')
 172                                 OR ((x >= 'a') & (x <= 'z'))
 173                 END IsValidEncChar;
 174
 175         BEGIN
 176                 env := LinLibc.getenv("LANG");
 177                 IF env # NIL THEN
 178                         IF env$ = "C" THEN
 179                                 enc := "ASCII"; ok := TRUE
 180                         ELSE
 181                                 IF IsSLetter(env[0]) & IsSLetter(env[1]) & (env[2] = '_')
 182                                 & IsBLetter(env[3]) & IsBLetter(env[4]) & (env[5] = '.') THEN
 183                                         i := 6; j := 0;
 184                                         WHILE IsValidEncChar(env[i]) & (j < LEN(enc) - 1) DO
 185                                                 enc[j] := env[i];
 186                                                 INC(j); INC(i)
 187                                         END;
 188                                         IF (env[i] = 0X) & (j < LEN(enc)) THEN
 189                                                 enc[j] := 0X; ok := TRUE
 190                                         ELSE ok := FALSE
 191                                         END
 192                                 ELSE ok := FALSE
 193                                 END
 194                         END
 195                 ELSE ok := FALSE
 196                 END
 197         END GetEnc;
 198
 199         PROCEDURE InitConv;
 200                 VAR enc: Encoding; ok: BOOLEAN;
 201         BEGIN
 202                 GetEnc(enc, ok);
 203                 IF ok THEN
 204                         IF Kernel.littleEndian THEN
 205                                 e := Iconv.iconv_open(enc, "UCS-2LE");
 206                                 d := Iconv.iconv_open("UCS-2LE", enc)
 207                         ELSE
 208                                 e := Iconv.iconv_open(enc, "UCS-2BE");
 209                                 d := Iconv.iconv_open("UCS-2BE", enc)
 210                         END
 211                 ELSE e := -1; d := -1
 212                 END
 213         END InitConv;
 214
 215         PROCEDURE CloseConv;
 216                 VAR res: INTEGER;
 217         BEGIN
 218                 IF e # -1 THEN res := Iconv.iconv_close(e); e := -1 END;
 219                 IF d # -1 THEN res := Iconv.iconv_close(d); d := -1 END
 220         END CloseConv;
 221
 222         PROCEDURE ResetCodec (c: Iconv.iconv_t): BOOLEAN;
 223                 VAR res, fLen, tLen: Iconv.size_t;
 224         BEGIN
 225                 ASSERT(c # -1, 20);
 226                 fLen := 0; tLen := 0;
 227                 res := Iconv.iconv(c, NIL, fLen, NIL, tLen);
 228                 RETURN res # -1
 229         END ResetCodec;
 230
 231         PROCEDURE Short (IN f: FullName; OUT t: ShortName; OUT ok: BOOLEAN);
 232                 VAR fR, fLen, tLen: INTEGER;
 233                         from: Iconv.PtrLSTR; to: Iconv.PtrSTR; res: Iconv.size_t;
 234         BEGIN
 235                 (* do not use encoder for basic set of chars *)
 236                 fR := 0; WHILE (f[fR] >= ' ') & (f[fR] <= '~') DO t[fR] := SHORT(f[fR]); INC(fR) END;
 237                 IF f[fR] = 0X THEN t[fR] := 0X; ok := TRUE
 238                 ELSIF (e # -1) & ResetCodec(e) THEN
 239                         from := f; to := t; fLen := LEN(f$) * SIZE(CHAR) (* 2 *); tLen := LEN(t) - 1;
 240                         res := Iconv.iconv_encode(e, from, fLen, to, tLen);
 241                         IF (res >= 0) & (fLen = 0) & (tLen >= 0) THEN to[0] := 0X; ok := TRUE
 242                         ELSE t[0] := 0X; ok := FALSE
 243                         END
 244                 ELSE t[0] := 0X; ok := FALSE
 245                 END
 246         END Short;
 247
 248         PROCEDURE Long (IN f: ShortName; OUT t: FullName; OUT ok: BOOLEAN);
 249                 VAR fR, fLen, tLen: INTEGER;
 250                         from: Iconv.PtrSTR; to: Iconv.PtrLSTR; res: Iconv.size_t;
 251         BEGIN
 252                 (* do not use decoder for basic set of chars *)
 253                 fR := 0; WHILE (f[fR] >= ' ') & (f[fR] <= '~') & (fR < LEN(t) - 1) DO t[fR] := f[fR]; INC(fR) END;
 254                 IF f[fR] = 0X THEN
 255                         IF fR < LEN(t) THEN t[fR] := 0X; ok := TRUE
 256                         ELSE t[0] := 0X; ok := FALSE (* f is too long *)
 257                         END
 258                 ELSIF (d # -1) & ResetCodec(d) THEN
 259                         from := f; to := t; fLen := LEN(f$); tLen := (LEN(t) - 1) * SIZE(CHAR) (* 2 *);
 260                         res := Iconv.iconv_decode(d, from, fLen, to, tLen);
 261                         IF (res >= 0) & (fLen = 0) & (tLen >= 0) THEN to[0] := 0X; ok := TRUE
 262                         ELSE t[0] := 0X; ok := FALSE
 263                         END
 264                 ELSE t[0] := 0X; ok := FALSE
 265                 END
 266         END Long;
 267
 268         (* end of encoding translation *)
 269
 270
 271         (*      get error num from linux        *)
 272         PROCEDURE LinLibc_errno (): INTEGER;
 273                 VAR
 274                         addr, errno: INTEGER;
 275         BEGIN
 276                 addr := LinLibc.__errno_location();
 277                 SYSTEM.GET(addr, errno);
 278                 RETURN errno
 279         END LinLibc_errno;
 280
 281         PROCEDURE Error (n: INTEGER): INTEGER;
 282                 VAR res: INTEGER;
 283         BEGIN
 284                 IF n = ok THEN res := ok
 285                 ELSIF n = invalidNameErr THEN res := invalidName
 286                 ELSIF (n = fileNotFoundErr) OR (n = pathNotFoundErr) THEN res := notFound
 287                 ELSIF (n = fileExistsErr) OR (n = alreadyExistsErr) THEN res := existsAlready
 288                 ELSIF n = writeProtectedErr THEN res := writeProtected
 289                 ELSIF (n = sharingErr) OR (n = accessDeniedErr) OR (n = netAccessDeniedErr) THEN res := accessDenied
 290                 ELSIF n = notEnoughMemoryErr THEN res := notEnoughMem
 291                 ELSIF (n = diskFullErr) OR (n = tooManyOpenFilesErr) THEN res := notEnoughDisk
 292                 ELSE res := -n
 293                 END;
 294                 RETURN res
 295         END Error;
 296
 297         PROCEDURE Diff (IN a, b: ARRAY OF CHAR; caseSens: BOOLEAN): INTEGER;
 298                 VAR i: INTEGER; cha, chb: CHAR;
 299         BEGIN
 300                 i := 0;
 301                 REPEAT
 302                         cha := a[i]; chb := b[i]; INC(i);
 303                         IF cha # chb THEN
 304                                 IF ~caseSens THEN
 305                                         IF (cha >= "a") & ((cha <= "z") OR (cha >= 0E0X) & (cha <= 0FEX) & (cha # 0F7X)) THEN
 306                                                 cha := CAP(cha)
 307                                         END;
 308                                         IF (chb >= "a") & ((chb <= "z") OR (chb >= 0E0X) & (chb <= 0FEX) & (chb # 0F7X)) THEN
 309                                                 chb := CAP(chb)
 310                                         END
 311                                 END;
 312                                 IF cha = "\" THEN cha := "/" END;
 313                                 IF chb = "\" THEN chb := "/" END;
 314                                 IF cha # chb THEN RETURN ORD(cha) - ORD(chb) END
 315                         END
 316                 UNTIL cha = 0X;
 317                 RETURN 0
 318         END Diff;
 319
 320         PROCEDURE Stat (IN fname: FullName; VAR buf: LinLibc.stat_t; OUT res: INTEGER);
 321                 VAR s: ShortName; ok1: BOOLEAN;
 322         BEGIN
 323                 Short(fname, s, ok1);
 324                 res := LinLibc.__xstat(3, s, buf); (* macro expansion of "stat" *)
 325         END Stat;
 326
 327         PROCEDURE ModeToAttr (mode: SET; OUT attr: SET; OUT isDir: BOOLEAN);
 328                 CONST read = 8; write = 7; execute = 6; file = 15; (* bits for permissions for the current user (see man chmod) *)
 329         BEGIN
 330                 attr := {};
 331                 IF ~(write IN mode) THEN INCL(attr, Files.readOnly) END;
 332                 isDir := ~(file IN mode) (* see "man 2 stat" for details *)
 333         END ModeToAttr;
 334
 335         PROCEDURE NewLocator* (IN fname: ARRAY OF CHAR): Locator;
 336                 VAR loc: Locator; i: INTEGER;
 337         BEGIN
 338                 NEW(loc); loc.path := fname$; i := 0;
 339                 WHILE loc.path[i] # 0X DO INC(i) END;
 340                 IF (loc.path[i-1] = "/") OR (loc.path[i-1] = "\") THEN loc.path[i-1] := 0X END;
 341                 loc.maxLen := LinLibc.NAME_MAX; loc.caseSens := TRUE;
 342                 RETURN loc
 343         END NewLocator;
 344
 345         PROCEDURE GetType (IN name: ARRAY OF CHAR; VAR type: Files.Type);
 346                 VAR i, j: INTEGER; ch: CHAR;
 347         BEGIN
 348                 i := 0; j := 0;
 349                 WHILE name[i] # 0X DO INC(i) END;
 350                 WHILE (i > 0) & (name[i] # ".") DO DEC(i) END;
 351                 IF i > 0 THEN
 352                         INC(i); ch := name[i];
 353                         WHILE (j < LEN(type) - 1) & (ch # 0X) DO
 354                                 IF (ch >= "A") & (ch <= "Z") THEN ch := CHR(ORD(ch) + (ORD("a") - ORD("A"))) END;
 355                                 type[j] := ch; INC(j);
 356                                 INC(i); ch := name[i]
 357                         END
 358                 END;
 359                 type[j] := 0X
 360         END GetType;
 361
 362         PROCEDURE Append (IN path, name: ARRAY OF CHAR; type: Files.Type; max: INTEGER;
 363                 VAR res: ARRAY OF CHAR
 364         );
 365                 VAR i, j, n, m, dot: INTEGER; ch: CHAR;
 366         BEGIN
 367                 i := 0;
 368                 WHILE path[i] # 0X DO res[i] := path[i]; INC(i) END;
 369                 IF path # "" THEN
 370                         ASSERT((res[i-1] # "/") & (res[i-1] # "\"), 100);
 371                         res[i] := "/"; INC(i)
 372                 END;
 373                 j := 0; ch := name[0]; n := 0; m := max; dot := -1;
 374                 IF max = 12 THEN m := 8 END;
 375                 WHILE (i < LEN(res) - 1) & (ch # 0X) DO
 376                         IF (ch = "/") OR (ch = "\") THEN
 377                                 res[i] := ch; INC(i); n := 0; m := max; dot := -1;
 378                                 IF max = 12 THEN m := 8 END
 379                         ELSIF (n < m) OR (ch = ".") & (n = 8) THEN
 380                                 res[i] := ch; INC(i); INC(n);
 381                                 IF ch = "." THEN dot := n;
 382                                         IF max = 12 THEN m := n + 3 END
 383                                 END
 384                         END;
 385                         INC(j); ch := name[j]
 386                 END;
 387                 IF (dot = -1) & (type # "") THEN
 388                         IF max = 12 THEN m := n + 4 END;
 389                         IF (n < m) & (i < LEN(res) - 1) THEN res[i] := "."; INC(i); INC(n); dot := n END
 390                 END;
 391                 IF n = dot THEN j := 0;
 392                         WHILE (n < m) & (i < LEN(res) - 1) & (type[j] # 0X) DO res[i] := type[j]; INC(i); INC(j) END
 393                 END;
 394                 res[i] := 0X
 395         END Append;
 396
 397         PROCEDURE CloseFileHandle (f: File; VAR res: INTEGER);
 398         BEGIN
 399                 IF (f.ref = invalid) OR (LinLibc.fclose(f.ref) = 0) THEN res := ok      (* !!! *)
 400                 ELSE res := LinLibc_errno()
 401                 END;
 402                 f.ref := invalid
 403         END CloseFileHandle;
 404
 405         PROCEDURE CloseFile (f: File; VAR res: INTEGER);
 406                 VAR s: INTEGER; n: ShortName; ok1: BOOLEAN;
 407         BEGIN
 408                 IF f.state = exclusive THEN
 409                         f.Flush;
 410                         res := LinLibc.fflush(f.ref)
 411                  END;
 412                 s := f.state; f.state := closed;
 413                 CloseFileHandle (f, res);
 414                 IF (s IN {temp, new, hidden}) & (f.name # "") THEN
 415                         Short(f.name, n, ok1);
 416                         res := LinLibc.remove(n)
 417                 END
 418         END CloseFile;
 419
 420         PROCEDURE (f: File) FINALIZE;
 421                 VAR res: INTEGER;
 422         BEGIN
 423                 IF f.state # closed THEN CloseFile(f, res) END
 424         END FINALIZE;
 425
 426         PROCEDURE (VAR id: Identifier) Identified (): BOOLEAN;
 427                 VAR f: File;
 428         BEGIN
 429                 f := id.obj(File);
 430                 RETURN (f.state IN {shared, exclusive}) & (Diff(f.name, id.name, f.loc.caseSens) = 0)
 431         END Identified;
 432
 433         PROCEDURE ThisFile (IN name: FullName): File;
 434                 VAR id: Identifier; p: ANYPTR;
 435         BEGIN
 436                 id.typ := SYSTEM.TYP(File); id.name := name$;
 437                 p := Kernel.ThisFinObj(id);
 438                 IF p # NIL THEN RETURN p(File)
 439                 ELSE RETURN NIL
 440                 END
 441         END ThisFile;
 442
 443         PROCEDURE (VAR s: Searcher) Identified (): BOOLEAN;
 444                 VAR f: File;
 445         BEGIN
 446                 f := s.obj(File);
 447                 IF (f.ref # invalid) & ((s.f = NIL) OR (f.t < s.f.t)) THEN s.f := f END;
 448                 RETURN FALSE
 449         END Identified;
 450
 451         PROCEDURE SearchFileToClose;
 452                 VAR s: Searcher; p: ANYPTR; (* res: LONGINT; *)
 453         BEGIN
 454                 s.typ := SYSTEM.TYP(File); s.f := NIL;
 455                 p := Kernel.ThisFinObj(s);
 456                 IF s.f # NIL THEN
 457                         res := LinLibc.fclose(s.f.ref); s.f.ref := invalid;
 458                         IF res = 0 THEN res := LinLibc_errno(); HALT(100) END
 459                 END
 460         END SearchFileToClose;
 461
 462         PROCEDURE ExistingFile (VAR n: ShortName): BOOLEAN;
 463                 VAR f: LinLibc.PtrFILE; ret: BOOLEAN; res: INTEGER;
 464         BEGIN
 465                 f := LinLibc.fopen(n, "r");
 466                 IF f  # LinLibc.NULL THEN
 467                         res := LinLibc.fclose(f);
 468                         ret := TRUE
 469                 ELSE
 470                         ret := FALSE
 471                 END;
 472                 RETURN ret
 473         END ExistingFile;
 474
 475         PROCEDURE MoveFile (VAR old, new: ShortName; VAR res: INTEGER); (* as the WinApi.MoveFile *)
 476         BEGIN
 477                 IF ExistingFile(new) THEN
 478                         res := fileExistsErr
 479                 ELSE
 480                         IF LinLibc.rename(old, new) = 0 THEN res := ok
 481                         ELSE res := LinLibc_errno();
 482                         END
 483                 END
 484         END MoveFile;
 485
 486         PROCEDURE NewFileRef (state: INTEGER; VAR name: FullName; VAR ref, res: INTEGER);
 487                 VAR n: ShortName; ok1: BOOLEAN;
 488         BEGIN
 489                 Short(name, n, ok1);
 490                 IF state = create THEN (* Create should fail if file already exists *)
 491                         IF ExistingFile(n) THEN
 492                                 ref := invalid; res := fileExistsErr
 493                         ELSE
 494                                 ref := LinLibc.fopen(n, "w+");
 495                                 IF ref = invalid THEN res := LinLibc_errno() ELSE res := ok END
 496                         END
 497                 ELSIF state = shared THEN
 498                         ref := LinLibc.fopen(n, "r");
 499                         IF ref = invalid THEN res := LinLibc_errno() ELSE res := ok END
 500                 ELSE
 501                         ref := LinLibc.fopen(n, "r+");
 502                         IF ref = invalid THEN res := LinLibc_errno() ELSE res := ok END
 503                 END
 504         END NewFileRef;
 505
 506         PROCEDURE OpenFile (state: INTEGER; VAR name: FullName; VAR ref, res: INTEGER);
 507         BEGIN
 508                 NewFileRef(state, name, ref, res);
 509                 IF ref = invalid THEN
 510                         IF res = tooManyOpenFilesErr THEN
 511                                 Kernel.Collect;
 512                                 NewFileRef(state, name, ref, res);
 513                                 IF ref = invalid THEN
 514                                         res := LinLibc_errno();
 515                                         IF res = tooManyOpenFilesErr THEN
 516                                                 SearchFileToClose;
 517                                                 NewFileRef(state, name, ref, res);
 518                                         END
 519                                 ELSE res := ok
 520                                 END
 521                         END
 522                 ELSE res := ok
 523                 END
 524         END OpenFile;
 525
 526         PROCEDURE GetTempFileName (IN path: FullName; OUT name: FullName; num: INTEGER);
 527                 VAR i: INTEGER; str: ARRAY 16 OF CHAR;
 528         BEGIN
 529                 str := tempName; i := 7;
 530                 WHILE i > 2 DO
 531                         str[i] := CHR(num MOD 10 + ORD("0")); DEC(i); num := num DIV 10
 532                 END;
 533                 Append(path, str, "", 8, name)
 534         END GetTempFileName;
 535
 536         PROCEDURE CreateFile (f: File; VAR res: INTEGER);
 537                 VAR num, n: INTEGER;
 538         BEGIN
 539                 IF f.name = "" THEN
 540                         num := LinLibc.clock(); n := 200;
 541                         REPEAT
 542                                 GetTempFileName(f.loc.path, f.name, num); INC(num); DEC(n);
 543                                 OpenFile(create, f.name, f.ref, res)
 544                         UNTIL (res # fileExistsErr) OR (n = 0)
 545                 ELSE
 546                         OpenFile(f.state, f.name, f.ref, res)
 547                 END
 548         END CreateFile;
 549
 550         PROCEDURE Delete (IN fname, path: FullName; VAR res: INTEGER);
 551                 VAR num, n: INTEGER; f: File; new: FullName; attr: SET; fn, nn: ShortName; buf: LinLibc.stat_t; isDir: BOOLEAN;
 552                         ok1: BOOLEAN;
 553         BEGIN
 554                 ASSERT(fname # "", 100);
 555                 f := ThisFile(fname); Short(fname, fn, ok1);
 556                 IF f = NIL THEN
 557                         IF LinLibc.remove(fn) = 0 THEN
 558                                 res := ok
 559                         ELSE
 560                                 res := LinLibc.fflush(0);
 561                                 IF LinLibc.remove(fn) = 0 THEN res := ok ELSE res := LinLibc_errno() END
 562                         END
 563                 ELSE (* still in use => make it anonymous *)
 564                         IF f.ref # invalid THEN res := LinLibc.fclose(f.ref); f.ref := invalid END;     (* !!! *)
 565                         Stat(f.name, buf, res);
 566                         ModeToAttr(buf.st_mode, attr, isDir);
 567                         IF (res = ok) & ~(Files.readOnly IN attr) THEN
 568                                 num := LinLibc.clock(); n := 200;
 569                                 REPEAT
 570                                         GetTempFileName(path, new, num); INC(num); DEC(n);
 571                                         Short(new, nn, ok1);
 572                                         MoveFile(fn, nn, res);
 573                                 UNTIL (res # fileExistsErr) OR (n = 0);
 574                                 IF res = ok THEN
 575                                         f.state := hidden; f.name := new$
 576                                 END
 577                         ELSE
 578                                 res := writeProtectedErr
 579                         END
 580                 END
 581         END Delete;
 582
 583         PROCEDURE FlushBuffer (f: File; i: INTEGER);
 584                 VAR buf: Buffer; res: INTEGER;
 585         BEGIN
 586                 buf := f.bufs[i];
 587                 IF (buf # NIL) & buf.dirty THEN
 588                         IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
 589                         IF f.ref # invalid THEN
 590                                 res := LinLibc.fseek(f.ref, buf.org, LinLibc.SEEK_SET);
 591                                 IF LinLibc.fwrite(SYSTEM.ADR(buf.data), 1, buf.len, f.ref) < buf.len THEN
 592                                         res := LinLibc_errno(); HALT(101)
 593                                 END;
 594                                 res := LinLibc.fflush(f.ref);
 595                                 buf.dirty := FALSE; f.t := Kernel.Time()
 596                         END
 597                 END
 598         END FlushBuffer;
 599
 600         (* File *)
 601
 602         PROCEDURE (f: File) NewReader (old: Files.Reader): Files.Reader;
 603                 VAR r: Reader;
 604         BEGIN   (* portable *)
 605                 ASSERT(f.state # closed, 20);
 606                 IF (old # NIL) & (old IS Reader) THEN r := old(Reader) ELSE NEW(r) END;
 607                 IF r.base # f THEN
 608                         r.base := f; r.buf := NIL; r.SetPos(0)
 609                 END;
 610                 r.eof := FALSE;
 611                 RETURN r
 612         END NewReader;
 613
 614         PROCEDURE (f: File) NewWriter (old: Files.Writer): Files.Writer;
 615                 VAR w: Writer;
 616         BEGIN   (* portable *)
 617                 ASSERT(f.state # closed, 20); ASSERT(f.state # shared, 21);
 618                 IF (old # NIL) & (old IS Writer) THEN w := old(Writer) ELSE NEW(w) END;
 619                 IF w.base # f THEN
 620                         w.base := f; w.buf := NIL; w.SetPos(f.len)
 621                 END;
 622                 RETURN w
 623         END NewWriter;
 624
 625         PROCEDURE (f: File) Length (): INTEGER;
 626         BEGIN   (* portable *)
 627                 RETURN f.len
 628         END Length;
 629
 630         PROCEDURE (f: File) Flush;
 631                 VAR i: INTEGER;
 632         BEGIN   (* portable *)
 633                 i := 0; WHILE i # nofbufs DO FlushBuffer(f, i); INC(i) END
 634         END Flush;
 635
 636         PROCEDURE GetPath (IN fname: FullName; OUT path: FullName);
 637                 VAR i: INTEGER;
 638         BEGIN
 639                 path := fname$; i := LEN(path$);
 640                 WHILE (i > 0) & (path[i] # "\") & (path[i] # "/") & (path[i-1] # ":") DO DEC(i) END;
 641                 path[i] := 0X
 642         END GetPath;
 643
 644         PROCEDURE CreateDir (VAR path: FullName; VAR res: INTEGER);
 645                 VAR (*sec: KERNEL32.SecurityAttributes;*) p: FullName; s: ShortName; ok1: BOOLEAN;
 646         BEGIN
 647                 ASSERT(path # "", 100);
 648                 Short(path, s, ok1);
 649                 res := LinLibc.mkdir(s, {0..MAX(SET)}); (* full rights are masked with the umask, is this correct? *)
 650                 IF res # ok THEN
 651                         res := LinLibc_errno();
 652                         IF (res = LinLibc.ENOTDIR) OR (res = LinLibc.ENOENT) THEN
 653                                 GetPath(path, p);
 654                                 CreateDir(p, res);      (* recursive call *)
 655                                 IF res = ok THEN
 656                                         res := LinLibc.mkdir(s, {0..MAX(SET)}); (* full rights are masked with the umask, is this correct? *)
 657                                         IF res # ok THEN res := LinLibc_errno() END
 658                                 END
 659                         END
 660                 END
 661         END CreateDir;
 662
 663         PROCEDURE CheckPath (VAR path: FullName; ask: BOOLEAN; VAR res: INTEGER);
 664                 VAR s: ARRAY 300 OF CHAR; t: ARRAY 32 OF CHAR;
 665         BEGIN
 666                 (*IF ask THEN
 667                         IF MapParamString # NIL THEN
 668                                 MapParamString("#Host:CreateDir", path, "", "", s);
 669                                 MapParamString("#Host:MissingDirectory", "", "", "", t)
 670                         ELSE
 671                                 s := path$; t := "Missing Directory"
 672                         END;
 673                         res := Kernel.MessageBox(t, s, {Kernel.mbOk, Kernel.mbCancel})
 674                 ELSE
 675                         res := Kernel.mbOk
 676                 END;*)
 677                 (*IF res = Kernel.mbOk THEN*) CreateDir(path, res)
 678                 (*ELSIF res = Kernel.mbCancel THEN res := cancel
 679                 END*)
 680         END CheckPath;
 681
 682         PROCEDURE CheckDelete (IN fname, path: FullName; ask: BOOLEAN; VAR res: INTEGER);
 683                 VAR s: ARRAY 300 OF CHAR; t: ARRAY 16 OF CHAR;
 684         BEGIN
 685                 REPEAT
 686                         Delete(fname, path, res);
 687                         IF (res = writeProtectedErr)
 688                                 OR (res = sharingErr)
 689                                 OR (res = accessDeniedErr)
 690                                 OR (res = netAccessDeniedErr)
 691                         THEN
 692                                 (*IF ask THEN
 693                                         IF MapParamString # NIL THEN
 694                                                 IF res = writeProtectedErr THEN
 695                                                         MapParamString("#Host:ReplaceWriteProtected", fname, 0DX, "", s)
 696                                                 ELSIF (res = accessDeniedErr) OR (res = netAccessDeniedErr) THEN
 697                                                         MapParamString("#Host:ReplaceAccessDenied", fname, 0DX, "", s)
 698                                                 ELSE
 699                                                         MapParamString("#Host:ReplaceInUse", fname, 0DX, "", s)
 700                                                 END;
 701                                                 MapParamString("#Host:FileError", "", "", "", t)
 702                                         ELSE
 703                                                 s := fname$; t := "File Error"
 704                                         END;
 705                                         res := Kernel.MessageBox(t, s, {Kernel.mbRetry, Kernel.mbCancel});
 706                                         IF res = Kernel.mbCancel THEN res := cancel
 707                                         ELSIF res = Kernel.mbRetry THEN res := retry
 708                                         END
 709                                 ELSE*)
 710                                         res := cancel
 711                                 (*END*)
 712                         ELSE
 713                                 res := ok
 714                         END
 715                 UNTIL res # retry
 716         END CheckDelete;
 717
 718         PROCEDURE (f: File) Register (name: Files.Name; type: Files.Type; ask: BOOLEAN; OUT res: INTEGER);
 719                 VAR b: INTEGER; fname: FullName; fn, nn: ShortName; ok1: BOOLEAN;
 720         BEGIN
 721                 ASSERT(f.state = new, 20); ASSERT(name # "", 21);
 722                 Append(f.loc.path, name, type, f.loc.maxLen, fname);
 723                 CheckDelete(fname, f.loc.path, ask,  res);
 724                 ASSERT(res # 87, 100);
 725                 IF res = ok THEN
 726                         IF f.name = "" THEN
 727                                 f.name := fname$;
 728                                 OpenFile(create, f.name, f.ref, res);
 729                                 IF res = ok THEN
 730                                         f.state := exclusive; CloseFile(f, res);
 731                                         Short(f.name, fn, ok1);
 732                                 END
 733                         ELSE
 734                                 f.state := exclusive; CloseFile(f, res);
 735                                 Short(f.name, fn, ok1); Short(fname, nn, ok1);
 736                                 MoveFile(fn, nn, res);
 737                                 IF res = ok THEN
 738                                         f.name := fname$;
 739                                         Short(f.name, fn, ok1);
 740                                 ELSE
 741                                         ASSERT(res # 87, 101);
 742                                         Short(f.name, fn, ok1);
 743                                         b := LinLibc.remove(fn);
 744                                 END
 745                         END
 746                 END;
 747                 res := Error(res)
 748         END Register;
 749
 750         PROCEDURE (f: File) Close;
 751                 VAR res: INTEGER;
 752         BEGIN   (* portable *)
 753                 IF f.state # closed THEN
 754 (*
 755                         IF f.state = exclusive THEN
 756                                 CloseFile(f, res)
 757                         ELSE
 758                                 CloseFileHandle(f, res)
 759                         END
 760 *)
 761                         CloseFile(f, res)
 762                 END
 763         END Close;
 764
 765
 766         (* Locator *)
 767
 768         PROCEDURE (loc: Locator) This* (IN path: ARRAY OF CHAR): Locator;
 769                 VAR new: Locator; i: INTEGER;
 770         BEGIN
 771                 IF path = "" THEN
 772                         NEW(new); new^ := loc^
 773                 ELSIF path[0] = "/" THEN        (* absolute path *)
 774                         new := NewLocator(path);
 775                         new.rootLen := 0
 776                 ELSIF (path[0] = "\") OR (path[0] = "/") THEN
 777                         IF (path[1] = "\") OR (path[1] = "/") THEN      (* network path *)
 778                                 new := NewLocator(path);
 779                                 new.rootLen := 0
 780                         ELSE
 781                                 NEW(new); new^ := dir.startup^;
 782                                 new.res := invalidName;
 783                                 RETURN new
 784                         END
 785                 ELSE
 786                         NEW(new); Append(loc.path, path, "", loc.maxLen, new.path);
 787                         i := 0; WHILE new.path[i] # 0X DO INC(i) END;
 788                         IF (new.path[i-1] = "/") OR (new.path[i-1] = "\") THEN new.path[i-1] := 0X END;
 789                         new.maxLen := loc.maxLen;
 790                         new.caseSens := loc.caseSens;
 791                         new.rootLen := loc.rootLen
 792                 END;
 793                 new.res := ok;
 794                 RETURN new
 795         END This;
 796
 797         (* Reader *)
 798
 799         PROCEDURE (r: Reader) Base (): Files.File;
 800         BEGIN   (* portable *)
 801                 RETURN r.base
 802         END Base;
 803
 804         PROCEDURE (r: Reader) SetPos (pos: INTEGER);
 805                 VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer;
 806         BEGIN
 807                 f := r.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25);
 808                 ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21);
 809                 offset := pos MOD bufsize; org := pos - offset;
 810                 i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
 811                 IF i # nofbufs THEN
 812                         buf := f.bufs[i];
 813                         IF buf = NIL THEN       (* create new buffer *)
 814                                 NEW(buf); f.bufs[i] := buf; buf.org := -1
 815                         END
 816                 ELSE    (* choose an existing buffer *)
 817                         f.swapper := (f.swapper + 1) MOD nofbufs;
 818                         FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1
 819                 END;
 820                 IF buf.org # org THEN
 821                         IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END;
 822                         count := buf.len;
 823                         IF count > 0 THEN
 824                                 IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
 825                                 IF f.ref # invalid THEN
 826                                         IF LinLibc.fseek(f.ref, org, LinLibc.SEEK_SET) # 0 THEN
 827                                                 res := LinLibc_errno(); HALT(101)
 828                                         END;
 829                                         IF  LinLibc.fread(SYSTEM.ADR(buf.data), 1, count, f.ref) < count THEN
 830                                                 res := LinLibc_errno();  HALT(102)
 831                                         END;
 832                                         f.t := Kernel.Time()
 833                                 END
 834                         END;
 835                         buf.org := org; buf.dirty := FALSE
 836                 END;
 837                 r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE
 838                 (* 0<= r.org <= r.base.len *)
 839                 (* 0 <= r.offset < bufsize *)
 840                 (* 0 <= r.buf.len <= bufsize *)
 841                 (* r.offset <= r.base.len *)
 842                 (* r.offset <= r.buf.len *)
 843         END SetPos;
 844
 845         PROCEDURE (r: Reader) Pos (): INTEGER;
 846         BEGIN   (* portable *)
 847                 ASSERT(r.base # NIL, 20);
 848                 RETURN r.org + r.offset
 849         END Pos;
 850
 851         PROCEDURE (r: Reader) ReadByte (OUT x: BYTE);
 852         BEGIN   (* portable *)
 853                 IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END;
 854                 IF r.offset < r.buf.len THEN
 855                         x := r.buf.data[r.offset]; INC(r.offset)
 856                 ELSE
 857                         x := 0; r.eof := TRUE
 858                 END
 859         END ReadByte;
 860
 861         PROCEDURE (r: Reader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER);
 862                 VAR from, to, count, restInBuf: INTEGER;
 863         BEGIN   (* portable *)
 864                 ASSERT(beg >= 0, 21);
 865                 IF len > 0 THEN
 866                         ASSERT(beg + len <= LEN(x), 23);
 867                         WHILE len # 0 DO
 868                                 IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END;
 869                                 restInBuf := r.buf.len - r.offset;
 870                                 IF restInBuf = 0 THEN r.eof := TRUE; RETURN
 871                                 ELSIF restInBuf <= len THEN count := restInBuf
 872                                 ELSE count := len
 873                                 END;
 874                                 from := SYSTEM.ADR(r.buf.data[r.offset]); to := SYSTEM.ADR(x) + beg;
 875                                 SYSTEM.MOVE(from, to, count);
 876                                 INC(r.offset, count); INC(beg, count); DEC(len, count)
 877                         END;
 878                         r.eof := FALSE
 879                 ELSE ASSERT(len = 0, 22)
 880                 END
 881         END ReadBytes;
 882
 883         (* Writer *)
 884
 885         PROCEDURE (w: Writer) Base (): Files.File;
 886         BEGIN   (* portable *)
 887                 RETURN w.base
 888         END Base;
 889
 890         PROCEDURE (w: Writer) SetPos (pos: INTEGER);
 891                 VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer;
 892         BEGIN
 893                 f := w.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25);
 894                 ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21);
 895                 offset := pos MOD bufsize; org := pos - offset;
 896                 i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
 897                 IF i # nofbufs THEN
 898                         buf := f.bufs[i];
 899                         IF buf = NIL THEN       (* create new buffer *)
 900                                 NEW(buf); f.bufs[i] := buf; buf.org := -1
 901                         END
 902                 ELSE    (* choose an existing buffer *)
 903                         f.swapper := (f.swapper + 1) MOD nofbufs;
 904                         FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1
 905                 END;
 906                 IF buf.org # org THEN
 907                         IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END;
 908                         count := buf.len;
 909                         IF count > 0 THEN
 910                                 IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END;
 911                                 IF f.ref # invalid THEN
 912                                         IF LinLibc.fseek(f.ref, org, LinLibc.SEEK_SET) # 0 THEN
 913                                                 res := LinLibc_errno(); HALT(101)
 914                                         END;
 915                                         IF  LinLibc.fread(SYSTEM.ADR(buf.data), 1, count, f.ref) < count THEN
 916                                                 res := LinLibc_errno();  HALT(102)
 917                                         END;
 918                                         f.t := Kernel.Time()
 919                                 END
 920                         END;
 921                         buf.org := org; buf.dirty := FALSE
 922                 END;
 923                 w.buf := buf; w.org := org; w.offset := offset
 924                 (* 0<= w.org <= w.base.len *)
 925                 (* 0 <= w.offset < bufsize *)
 926                 (* 0 <= w.buf.len <= bufsize *)
 927                 (* w.offset <= w.base.len *)
 928                 (* w.offset <= w.buf.len *)
 929         END SetPos;
 930
 931         PROCEDURE (w: Writer) Pos (): INTEGER;
 932         BEGIN   (* portable *)
 933                 ASSERT(w.base # NIL, 20);
 934                 RETURN w.org + w.offset
 935         END Pos;
 936
 937         PROCEDURE (w: Writer) WriteByte (x: BYTE);
 938         BEGIN   (* portable *)
 939                 ASSERT(w.base.state # closed, 25);
 940                 IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END;
 941                 w.buf.data[w.offset] := x; w.buf.dirty := TRUE;
 942                 IF w.offset = w.buf.len THEN INC(w.buf.len); INC(w.base.len) END;
 943                 INC(w.offset)
 944         END WriteByte;
 945
 946         PROCEDURE (w: Writer) WriteBytes (IN x: ARRAY OF BYTE; beg, len: INTEGER);
 947                 VAR from, to, count, restInBuf: INTEGER;
 948         BEGIN   (* portable *)
 949                 ASSERT(beg >= 0, 21); ASSERT(w.base.state # closed, 25);
 950                 IF len > 0 THEN
 951                         ASSERT(beg + len <= LEN(x), 23);
 952                         WHILE len # 0 DO
 953                                 IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END;
 954                                 restInBuf := bufsize - w.offset;
 955                                 IF restInBuf <= len THEN count := restInBuf ELSE count := len END;
 956                                 from := SYSTEM.ADR(x) + beg; to := SYSTEM.ADR(w.buf.data[w.offset]);
 957                                 SYSTEM.MOVE(from, to, count);
 958                                 INC(w.offset, count); INC(beg, count); DEC(len, count);
 959                                 IF w.offset > w.buf.len THEN INC(w.base.len, w.offset - w.buf.len); w.buf.len := w.offset END;
 960                                 w.buf.dirty := TRUE
 961                         END
 962                 ELSE ASSERT(len = 0, 22)
 963                 END
 964         END WriteBytes;
 965
 966         (* Directory *)
 967
 968         PROCEDURE (d: Directory) This (IN path: ARRAY OF CHAR): Files.Locator;
 969         BEGIN
 970                 RETURN d.startup.This(path)
 971         END This;
 972
 973         PROCEDURE (d: Directory) New (loc: Files.Locator; ask: BOOLEAN): Files.File;
 974                 VAR f: File; res: INTEGER; attr: SET; isDir: BOOLEAN; buf: LinLibc.stat_t;
 975         BEGIN
 976                 ASSERT(loc # NIL, 20); f := NIL; res := ok;
 977                 WITH loc: Locator DO
 978                         IF loc.path # "" THEN
 979                                 Stat(loc.path, buf, res);
 980                                 IF res # ok THEN
 981                                         IF loc.res = 76 THEN CreateDir(loc.path, res)
 982                                         ELSE CheckPath(loc.path, ask, res)
 983                                         END
 984                                 ELSE
 985                                         ModeToAttr(buf.st_mode, attr, isDir);
 986                                         IF  ~isDir THEN res := fileExistsErr END
 987                                 END
 988                         END;
 989                         IF res = ok THEN
 990                                 NEW(f); f.loc := loc; f.name := "";
 991                                 f.state := new; f.swapper := -1; f.len := 0; f.ref := invalid
 992                         END
 993                 ELSE res := invalidNameErr
 994                 END;
 995                 loc.res := Error(res);
 996                 RETURN f
 997         END New;
 998
 999         PROCEDURE (d: Directory) Temp (): Files.File;
1000                 VAR f: File;
1001         BEGIN
1002                 NEW(f); f.loc := d.temp; f.name := "";
1003                 f.state := temp; f.swapper := -1; f.len := 0; f.ref := invalid;
1004                 RETURN f
1005         END Temp;
1006
1007         PROCEDURE GetShadowDir (loc: Locator; OUT dir: FullName);
1008                 VAR i, j: INTEGER;
1009         BEGIN
1010                 dir := startupDir$; i := startupLen; j := loc.rootLen;
1011                 WHILE loc.path[j] # 0X DO dir[i] := loc.path[j]; INC(i); INC(j) END;
1012                 dir[i] := 0X
1013         END GetShadowDir;
1014
1015         PROCEDURE (d: Directory) Old (loc: Files.Locator; name: Files.Name; shrd: BOOLEAN): Files.File;
1016                 VAR res: INTEGER; f: File; ref: LinLibc.PtrFILE; fname: FullName; type: Files.Type; s: BYTE; buf: LinLibc.stat_t;
1017         BEGIN
1018                 ASSERT(loc # NIL, 20); ASSERT(name # "", 21);
1019                 res := ok; f := NIL;
1020                 WITH loc: Locator DO
1021                         Append(loc.path, name, "", loc.maxLen, fname);
1022                         f := ThisFile(fname);
1023                         IF f # NIL THEN
1024                                 IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL
1025                                 ELSE loc.res := ok; RETURN f
1026                                 END
1027                         END;
1028                         IF shrd THEN s := shared ELSE s := exclusive END;
1029                         OpenFile(s, fname, ref, res);
1030                         IF ((res = fileNotFoundErr) OR (res = pathNotFoundErr)) & (loc.rootLen > 0) THEN
1031                                 GetShadowDir(loc, fname);
1032                                 Append(fname, name, "", loc.maxLen, fname);
1033                                 f := ThisFile(fname);
1034                                 IF f # NIL THEN
1035                                         IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL
1036                                         ELSE loc.res := ok; RETURN f
1037                                         END
1038                                 END;
1039                                 OpenFile(s, fname, ref, res)
1040                         END;
1041                         IF res = ok THEN
1042                                 NEW(f); f.loc := loc;
1043                                 f.swapper := -1;
1044                                 GetType(name, type);
1045                                 f.InitType(type);
1046                                 ASSERT(ref # invalid, 107);
1047                                 f.ref := ref; f.name := fname$; f.state := s; f.t := Kernel.Time();
1048                                 Stat(f.name, buf, res);
1049                                 f.len := buf.st_size;
1050                                 res := LinLibc.fseek(ref, 0, LinLibc.SEEK_SET);
1051                         END
1052                 END;
1053                 loc.res := Error(res);
1054                 RETURN f
1055         END Old;
1056
1057         PROCEDURE (d: Directory) Delete* (loc: Files.Locator; name: Files.Name);
1058                 VAR res: INTEGER; fname: FullName;
1059         BEGIN
1060                 ASSERT(loc # NIL, 20);
1061                 WITH loc: Locator DO
1062                         Append(loc.path, name, "", loc.maxLen, fname);
1063                         Delete(fname, loc.path, res)
1064                 ELSE res := invalidNameErr
1065                 END;
1066                 loc.res := Error(res)
1067         END Delete;
1068
1069         PROCEDURE (d: Directory) Rename* (loc: Files.Locator; old, new: Files.Name; ask: BOOLEAN);
1070                 VAR res, i: INTEGER; oldname, newname: FullName; f: File; on, nn, tn: ShortName; buf: LinLibc.stat_t;
1071                         ok1: BOOLEAN; tName: FullName;
1072         BEGIN
1073                 ASSERT(loc # NIL, 20);
1074                 WITH loc: Locator DO
1075                         Append(loc.path, old, "", loc.maxLen, oldname); Append(loc.path, new, "", loc.maxLen, newname);
1076                         Short(oldname, on, ok1); Short(newname, nn, ok1);
1077                         Stat(oldname, buf, res);
1078                         IF res = ok THEN
1079                                 f := ThisFile(oldname);
1080                                 IF (f # NIL) & (f.ref # invalid) THEN res := LinLibc.fclose(f.ref); f.ref := invalid END;
1081                                 IF Diff(oldname, newname, loc.caseSens) # 0 THEN
1082                                         CheckDelete(newname, loc.path, ask, res);
1083                                         IF res = ok THEN
1084                                                 IF LinLibc.rename(on, nn) = 0 THEN
1085                                                         IF f # NIL THEN (* still in use => update file table *)
1086                                                                 f.name := newname$
1087                                                         END
1088                                                 ELSE res := LinLibc_errno()
1089                                                 END
1090                                         END
1091                                 ELSE    (* destination is same file as source *)
1092                                         tName := oldname; i := LEN(tName$) - 1;
1093                                         REPEAT
1094                                                 tName[i] := CHR(ORD(tName[i]) + 1);
1095                                                 Short(tName, tn, ok1);
1096                                                 MoveFile(on, tn, res);
1097                                         UNTIL (res # fileExistsErr) & (res # alreadyExistsErr) & (res # 87);
1098                                         IF res = ok THEN
1099                                                 MoveFile(tn, nn, res)
1100                                         END
1101                                 END
1102                         ELSE res := fileNotFoundErr
1103                         END
1104                 ELSE res := invalidNameErr
1105                 END;
1106                 loc.res := Error(res)
1107         END Rename;
1108
1109         PROCEDURE (d: Directory) SameFile* (loc0: Files.Locator; name0: Files.Name;
1110                 loc1: Files.Locator; name1: Files.Name
1111         ): BOOLEAN;
1112                 VAR p0, p1: FullName;
1113         BEGIN
1114                 ASSERT(loc0 # NIL, 20); ASSERT(loc1 # NIL, 21);
1115                 WITH loc0: Locator DO Append(loc0.path, name0, "", loc0.maxLen, p0) END;
1116                 WITH loc1: Locator DO Append(loc1.path, name1, "", loc1.maxLen, p1) END;
1117                 RETURN Diff(p0, p1, loc0(Locator).caseSens) = 0
1118         END SameFile;
1119
1120         PROCEDURE (d: Directory) FileList* (loc: Files.Locator): Files.FileInfo;
1121                 VAR diff, res: INTEGER; first, last, info: Files.FileInfo; s: FullName;
1122                         ss, fname: ShortName; dirp: LinLibc.PtrDIR; dp: LinLibc.PtrDirent; buf: LinLibc.stat_t; tm: LinLibc.tm;
1123                         isDir: BOOLEAN; attr: SET; ok1: BOOLEAN; dName: FullName;
1124         BEGIN
1125                 ASSERT(loc # NIL, 20);
1126                 first := NIL; last :=NIL;
1127                 WITH loc: Locator DO
1128                         Short(loc.path, ss, ok1);
1129                         dirp := LinLibc.opendir(ss);
1130                         IF dirp # LinLibc.NULL THEN
1131                                 dp := LinLibc.readdir(dirp);
1132                                 WHILE dp # NIL DO
1133                                         Long(dp.d_name$, dName, ok1);
1134                                         IF ok1 & (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dName$) < LEN(info.name)) THEN
1135                                                 fname := ss + "/" + dp.d_name;
1136                                                 res := LinLibc.__xstat(3, fname, buf); (* macro expansion of "stat" *)
1137                                                 ModeToAttr(buf.st_mode, attr, isDir);
1138                                                 IF ~isDir THEN
1139                                                         info := first; last := NIL; s := dName;
1140                                                         WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
1141                                                         NEW(info);
1142                                                         info.name := dName$;
1143                                                         GetType(info.name, info.type);
1144                                                         info.length := buf.st_size;
1145                                                         tm := LinLibc.localtime(buf.st_mtime);
1146                                                         IF tm # NIL THEN
1147                                                                 info.modified.year := tm.tm_year  + 1900;
1148                                                                 info.modified.month := tm.tm_mon + 1;
1149                                                                 info.modified.day := tm.tm_mday;
1150                                                                 info.modified.hour := tm.tm_hour;
1151                                                                 info.modified.minute := tm.tm_min;
1152                                                                 info.modified.second := tm.tm_sec
1153                                                         END;
1154                                                         info.attr := attr;
1155                                                         IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
1156                                                 END
1157                                         END;
1158                                         dp := LinLibc.readdir(dirp)
1159                                 END;
1160                                 res := LinLibc.closedir(dirp)
1161                         ELSE res := LinLibc_errno()
1162                         END;
1163                         (* check startup directory *)
1164                         IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN
1165                                 GetShadowDir(loc, s);
1166                                 Short(s, ss, ok1);
1167                                 dirp := LinLibc.opendir(ss);
1168                                 IF dirp # LinLibc.NULL THEN
1169                                         dp := LinLibc.readdir(dirp);
1170                                         WHILE dp # NIL DO
1171                                                 Long(dp.d_name$, dName, ok1);
1172                                                 IF ok1 & (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dName$) < LEN(info.name)) THEN
1173                                                         fname := ss + "/" + dp.d_name;
1174                                                         res := LinLibc.__xstat(3, fname, buf); (* macro expansion of "stat" *)
1175                                                         ModeToAttr(buf.st_mode, attr, isDir);
1176                                                         IF ~isDir THEN
1177                                                                 info := first; last := NIL; s := dName;
1178                                                                 IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END;
1179                                                                 WHILE (info # NIL) & (diff < 0) DO
1180                                                                         last := info; info := info.next;
1181                                                                         IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END
1182                                                                 END;
1183                                                                 IF (info = NIL) OR (diff # 0) THEN
1184                                                                         NEW(info);
1185                                                                         info.name := dName$;
1186                                                                         GetType(info.name, info.type);
1187                                                                         info.length := buf.st_size;
1188                                                                         tm := LinLibc.localtime(buf.st_mtime);
1189                                                                         IF tm # NIL THEN
1190                                                                                 info.modified.year := tm.tm_year  + 1900;
1191                                                                                 info.modified.month := tm.tm_mon + 1;
1192                                                                                 info.modified.day := tm.tm_mday;
1193                                                                                 info.modified.hour := tm.tm_hour;
1194                                                                                 info.modified.minute := tm.tm_min;
1195                                                                                 info.modified.second := tm.tm_sec
1196                                                                         END;
1197                                                                         info.attr := attr;
1198                                                                         IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
1199                                                                 END
1200                                                         END
1201                                                 END;
1202                                                 dp := LinLibc.readdir(dirp)
1203                                         END;
1204                                         res := LinLibc.closedir(dirp)
1205                                 ELSE res := LinLibc_errno()
1206                                 END
1207                         END;
1208                         loc.res := Error(res)
1209                 ELSE loc.res := invalidName
1210                 END;
1211                 RETURN first
1212         END FileList;
1213
1214         PROCEDURE (d: Directory) LocList* (loc: Files.Locator): Files.LocInfo;
1215                 VAR diff, res: INTEGER; first, last, info: Files.LocInfo; s: FullName; isDir: BOOLEAN; attr: SET;
1216                         ss, fname: ShortName; dirp: LinLibc.PtrDIR; dp: LinLibc.PtrDirent; buf: LinLibc.stat_t;
1217                         ok1: BOOLEAN; dName: FullName;
1218         BEGIN
1219                 ASSERT(loc # NIL, 20);
1220                 first := NIL; last :=NIL;
1221                 WITH loc: Locator DO
1222                         Short(loc.path, ss, ok1);
1223                         dirp := LinLibc.opendir(ss);
1224                         IF dirp # LinLibc.NULL THEN
1225                                 dp := LinLibc.readdir(dirp);
1226                                 WHILE dp # NIL DO
1227                                         Long(dp.d_name$, dName, ok1);
1228                                         IF ok1 & (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dName$) < LEN(info.name)) THEN
1229                                                 fname := ss + "/" + dp.d_name;
1230                                                 res := LinLibc.__xstat(3, fname, buf); (* macro expansion of "stat" *)
1231                                                 ModeToAttr(buf.st_mode, attr, isDir);
1232                                                 IF isDir THEN
1233                                                         info := first; last := NIL; s := dName;
1234                                                         WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
1235                                                         NEW(info);
1236                                                         info.name := dName$;
1237                                                         info.attr := attr;
1238                                                         IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
1239                                                 END
1240                                         END;
1241                                         dp := LinLibc.readdir(dirp)
1242                                 END;
1243                                 res := LinLibc.closedir(dirp)
1244                         ELSE res := LinLibc_errno()
1245                         END;
1246                         (* check startup directory *)
1247                         IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN
1248                                 GetShadowDir(loc, s);
1249                                 Short(s, ss, ok1);
1250                                 dirp := LinLibc.opendir(ss);
1251                                 IF dirp # LinLibc.NULL THEN
1252                                         dp := LinLibc.readdir(dirp);
1253                                         WHILE dp # NIL DO
1254                                                 Long(dp.d_name$, dName, ok1);
1255                                                 IF ok1 & (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dName$) < LEN(info.name)) THEN
1256                                                         fname := ss + "/" + dp.d_name;
1257                                                         res := LinLibc.__xstat(3, fname, buf); (* macro expansion of "stat" *)
1258                                                         ModeToAttr(buf.st_mode, attr, isDir);
1259                                                         IF isDir THEN
1260                                                                 info := first; last := NIL; s := dName;
1261                                                                 IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END;
1262                                                                 WHILE (info # NIL) & (diff < 0) DO
1263                                                                         last := info; info := info.next;
1264                                                                         IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END
1265                                                                 END;
1266                                                                 IF (info = NIL) OR (diff # 0) THEN
1267                                                                         NEW(info);
1268                                                                         info.name := dName$;
1269                                                                         info.attr := attr;
1270                                                                         IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END
1271                                                                 END
1272                                                         END
1273                                                 END;
1274                                                 dp := LinLibc.readdir(dirp)
1275                                         END;
1276                                         res := LinLibc.closedir(dirp)
1277                                 ELSE res := LinLibc_errno()
1278                                 END
1279                         END;
1280                         loc.res := Error(res)
1281                 ELSE loc.res := invalidName
1282                 END;
1283                 RETURN first
1284         END LocList;
1285
1286         PROCEDURE (d: Directory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name);
1287         BEGIN
1288                 Append("", name, type, LEN(filename), filename)
1289         END GetFileName;
1290
1291         (** Miscellaneous **)
1292
1293         PROCEDURE (VAR id: Counter) Identified (): BOOLEAN;
1294                 VAR f: File;
1295         BEGIN
1296                 f := id.obj(File);
1297                 IF f.state # closed THEN INC(id.count) END;
1298                 RETURN FALSE
1299         END Identified;
1300
1301         PROCEDURE NofFiles* (): INTEGER;
1302                 VAR p: ANYPTR; cnt: Counter;
1303         BEGIN
1304                 cnt.typ := SYSTEM.TYP(File);
1305                 cnt.count := 0; p := Kernel.ThisFinObj(cnt);
1306                 RETURN cnt.count
1307         END NofFiles;
1308
1309         PROCEDURE GetModDate* (f: Files.File; VAR year, month, day, hour, minute, second: INTEGER);
1310                 VAR buf: LinLibc.stat_t; tm: LinLibc.tm;
1311         BEGIN
1312                 ASSERT(f IS File, 20);
1313                 Stat(f(File).name, buf, res);
1314                 IF res = ok THEN
1315                         tm := LinLibc.localtime(buf.st_mtime);
1316                         IF tm # NIL THEN
1317                                 year := tm.tm_year  + 1900; month := tm.tm_mon + 1; day := tm.tm_mday;
1318                                 hour := tm.tm_hour; minute := tm.tm_min; second := tm.tm_sec
1319                         ELSE
1320                                 res := -1
1321                         END
1322                 END;
1323                 IF res # ok THEN year := 0; month := 0; day := 0; hour := 0; minute := 0; second := 0 END
1324         END GetModDate;
1325
1326         PROCEDURE SetRootDir* (path: ARRAY OF CHAR);
1327                 VAR i: INTEGER;
1328         BEGIN
1329                 dir.startup := NewLocator(path);
1330                 dir.startup.rootLen := 0; i := 0;
1331                 WHILE startupDir[i] # 0X DO INC(i) END;
1332                 startupLen := i
1333         END SetRootDir;
1334
1335 (*
1336         PROCEDURE GetName (VAR p: ARRAY OF CHAR; VAR i: INTEGER; OUT name, opt: FullName);
1337                 VAR ch, tch: CHAR; j: INTEGER;
1338         BEGIN
1339                 j := 0; ch := p[i]; tch := " ";
1340                 WHILE ch = " " DO INC(i); ch := p[i] END;
1341                 IF (ch = "'") OR (ch = '"') THEN tch := ch; INC(i); ch := p[i] END;
1342                 WHILE (ch >= " ") & (ch # tch) DO
1343                         name[j] := ch;
1344                         IF (ch >= "a") & (ch <= "z") OR (ch >= "à") & (ch <= "ö") OR (ch >= "ø") & (ch <= "þ") THEN ch := CAP(ch)
1345                         ELSIF ch = "-" THEN ch := "/"
1346                         END;
1347                         opt[j] := ch; INC(j); INC(i); ch := p[i]
1348                 END;
1349                 IF ch > " " THEN INC(i); ch := p[i] END;
1350                 WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := p[i] END;
1351                 name[j] := 0X; opt[j] := 0X
1352         END GetName;
1353
1354         PROCEDURE Init;
1355                 VAR res, i, slp: INTEGER; path, opt: FullName; attr: SET; p: LinLibc.PtrSTR; str: ARRAY 256 OF CHAR;
1356                         buf: LinLibc.stat_t; isDir: BOOLEAN;
1357         BEGIN
1358 (*
1359                 TODO:
1360                 Instead of using getcwd below to find the local path it would be better to use Kernel.bootinfo.argv[0].
1361                 But this only works if the PATH variable of the shell is not set to hold the BlackBox directory. In that
1362                 case all directories in the PATH variable has to be searched for the blackbox executable:
1363                         if (argv[0][0] == '/')
1364                                 s = argv[0]
1365                         else {
1366                                 str = getenv( "PATH" ); len = strlen( str );
1367                                 for ( i = 0, s = 0; i < len; i++ )
1368                                         if ( str[i] == ':' ) {
1369                                                 str[i] = '\0';
1370                                         if ( checkpath( str + s, argv[0] ) ) break;
1371                                         else s = i + 1;
1372                                 }
1373                         }
1374 *)
1375                 wildcard := "*"; NEW(dir);
1376                 str := Kernel.cmdLine$;
1377                 i := 0; slp := -1;
1378                 WHILE (str[i] # " ") & (str[i] # 0X) DO
1379                         startupDir[i] := str[i];
1380                         IF str[i] = "/" THEN slp := i END;
1381                         INC(i)
1382                 END;
1383                 startupDir[i] := 0X;
1384                 IF slp < 0 THEN
1385                         appName := startupDir;
1386                         p := NIL;
1387                         p := LinLibc.getcwd(p, 0);
1388                         startupDir := p$;
1389                         LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p));
1390                         i := 0;
1391                         WHILE startupDir[i] # 0X DO INC(i) END;
1392                         startupLen := i;
1393                 ELSE
1394                         i := slp  + 1;
1395                         WHILE startupDir[i] # 0X DO appName[i - slp - 1] := startupDir[i]; INC(i) END;
1396                         startupDir[slp] := 0X;
1397                         startupLen := slp;
1398                 END;
1399                 dir.startup := NewLocator(startupDir);
1400                 dir.startup.rootLen := 0;
1401 (*
1402                 p := NIL;
1403                 p := LinLibc.getcwd(p, 0);
1404                 startupDir := p$; LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p));
1405                 dir.startup := NewLocator(startupDir);
1406                 dir.startup.rootLen := 0; i := 0;
1407                 WHILE startupDir[i] # 0X DO INC(i) END;
1408                 startupLen := i;
1409                 str := Kernel.cmdLine$;
1410 *)
1411 (*
1412                 i := 0;
1413                 WHILE (str[i] # " ") & (str[i] # 0X) DO appName[i] := str[i]; INC(i) END;
1414                 appName[i] := 0X;
1415 *)
1416                 i := 0; res := 1;
1417                 REPEAT
1418                         GetName(str, i, path, opt);
1419                         IF opt = "/USE" THEN
1420                                 GetName(str, i, path, opt);
1421                                 Stat(path, buf, res);
1422                                 IF res =ok THEN
1423                                         ModeToAttr(buf.st_mode, attr, isDir);
1424                                         IF isDir THEN res := ok ELSE res := invalidName END
1425                                 END
1426                         END
1427                 UNTIL (res = 0) OR (str[i] < " ");
1428                 IF serverVersion & (res = 0) THEN
1429                         i := 0; WHILE path[i] # 0X DO INC(i) END;
1430                         IF (path[i-1] = "/") OR (path[i-1] = "\") THEN DEC(i); path[i] := 0X END;
1431                         dir.startup := NewLocator(path);
1432                         dir.startup.rootLen := SHORT(i)
1433                 END;
1434                 dir.temp := NewLocator(LinLibc.P_tmpdir);
1435                 Files.SetDir(dir)
1436         END Init;
1437 *)
1438
1439         PROCEDURE Init;
1440                 CONST bbServerDir = "BB_PRIMARY_DIR"; bbWorkDir = "BB_SECONDARY_DIR";
1441                 VAR res: INTEGER; attr: SET; p: LinLibc.PtrSTR;
1442                         buf: LinLibc.stat_t; isDir, def1: BOOLEAN;
1443                         ok1: BOOLEAN; fname: FullName;
1444         BEGIN
1445                 InitConv;
1446
1447                 wildcard := "*"; NEW(dir);
1448
1449                 p := LinLibc.getenv(bbServerDir);       (* p = NIL -> undefined *)
1450                 def1 := FALSE;
1451                 IF p # NIL THEN
1452                         Long(p$, fname, ok1);
1453                         IF ok1 THEN
1454                                 Stat(fname, buf, res);
1455                                 IF res = ok THEN
1456                                         ModeToAttr(buf.st_mode, attr, isDir);
1457                                         def1 := isDir
1458                                 END
1459                         END;
1460                         IF ~def1 THEN Msg("HostFiles: Value of " + bbServerDir + " isn't directory, using cwd") END
1461                 END;
1462                 IF ~def1 THEN
1463                         p := NIL;
1464                         p := LinLibc.getcwd(p, 0);
1465                         Long(p$, fname, ok1);
1466                         IF ~ok1 THEN fname := "." END;
1467                         LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p))
1468                 END;
1469                 startupDir := fname; startupLen := LEN(startupDir$);
1470                 dir.startup := NewLocator(startupDir);
1471                 dir.startup.rootLen := 0;
1472
1473                 p := LinLibc.getenv(bbWorkDir); (* p = NIL -> undefined *)
1474                 IF def1 & (p # NIL) THEN
1475                         Long(p$, fname, ok1);
1476                         IF ok1 THEN
1477                                 Stat(fname, buf, res);
1478                                 ok1 := res = ok;
1479                                 IF ok1 THEN
1480                                         ModeToAttr(buf.st_mode, attr, isDir);
1481                                         ok1 := isDir
1482                                 END
1483                         END;
1484                         IF ~serverVersion THEN
1485                                 (* - *)
1486                         ELSIF ok1 THEN
1487                                 dir.startup := NewLocator(fname); dir.startup.rootLen := LEN(fname$)
1488                         ELSE
1489                                 Msg("HostFiles: Value of " + bbWorkDir + " isn't directory, server configuration isn't enabled")
1490                         END
1491                 END;
1492
1493                 dir.temp := NewLocator(LinLibc.P_tmpdir);
1494                 Files.SetDir(dir)
1495         END Init;
1496
1497 BEGIN
1498         Init
1499 CLOSE
1500         CloseConv
1501 END HostFiles.