MODULE HostFiles; (* THIS IS TEXT COPY OF Files.odc *) (* DO NOT EDIT *) (* A. V. Shiryaev, 2012.11: filenames encoding translation implemented *) IMPORT SYSTEM, Kernel, Files, LinLibc, Iconv := LinIconv; CONST tempName = "odcxxxxx"; docType = "odc"; serverVersion = TRUE; pathLen* = 260; nofbufs = 4; (* max number of buffers per file *) bufsize = 2 * 1024; (* size of each buffer *) invalid = LinLibc.NULL; temp = 0; new = 1; shared = 2; hidden = 3; exclusive = 4; closed = 5; (* file states *) create = -1; ok = 0; invalidName = 1; invalidNameErr = MAX(INTEGER); (* On Windows this is 123 *) notFound = 2; fileNotFoundErr = LinLibc.ENOENT; pathNotFoundErr = LinLibc.ENOENT; existsAlready = 3; fileExistsErr = LinLibc.EEXIST; alreadyExistsErr = LinLibc.EEXIST; (* is alreadyExistsErr needed? *) writeProtected = 4; writeProtectedErr = LinLibc.EACCES; ioError = 5; (* same as LinLibc.EIO *) accessDenied = 6; accessDeniedErr = LinLibc.EACCES; sharingErr = LinLibc.EACCES; netAccessDeniedErr = LinLibc.EACCES; notEnoughMem = 80; notEnoughMemoryErr = LinLibc.ENOMEM; notEnoughDisk = 81; diskFullErr = LinLibc.EDQUOT; tooManyOpenFilesErr = LinLibc.EMFILE; noMoreFilesErr = 18; cancel = -8; retry = -9; TYPE FullName* = ARRAY pathLen OF CHAR; Locator* = POINTER TO RECORD (Files.Locator) path-: FullName; (* without trailing "/" *) maxLen-: INTEGER; (* maximum name length *) caseSens-: BOOLEAN; (* case sensitive file compares *) rootLen-: INTEGER (* for network version *) END; Buffer = POINTER TO RECORD dirty: BOOLEAN; org, len: INTEGER; data: ARRAY bufsize OF BYTE END; File = POINTER TO RECORD (Files.File) state: INTEGER; name: FullName; ref: LinLibc.PtrFILE; loc: Locator; swapper: INTEGER; (* index into file table / next buffer to swap *) len: INTEGER; bufs: ARRAY nofbufs OF Buffer; t: LONGINT (* time stamp of last file operation *) END; Reader = POINTER TO RECORD (Files.Reader) base: File; org, offset: INTEGER; buf: Buffer END; Writer = POINTER TO RECORD (Files.Writer) base: File; org, offset: INTEGER; buf: Buffer END; Directory = POINTER TO RECORD (Files.Directory) temp, startup: Locator END; Identifier = RECORD (Kernel.Identifier) name: FullName END; Searcher = RECORD (Kernel.Identifier) t0: INTEGER; f: File END; Counter = RECORD (Kernel.Identifier) count: INTEGER END; ShortName = ARRAY pathLen * 4 OF SHORTCHAR; Encoding = ARRAY 32 OF SHORTCHAR; VAR MapParamString*: PROCEDURE(in, p0, p1, p2: ARRAY OF CHAR; OUT out: ARRAY OF CHAR); dir: Directory; wildcard: Files.Type; startupDir: FullName; startupLen: INTEGER; res: INTEGER; e, d: Iconv.iconv_t; (* debugging functions *) PROCEDURE Msg (IN str: ARRAY OF CHAR); VAR ss: ARRAY 1024 OF SHORTCHAR; res, l: INTEGER; BEGIN ss := SHORT(str); l := LEN(ss$); ss[l] := 0AX; ss[l + 1] := 0X; res := LinLibc.printf(ss); res := LinLibc.fflush(0) END Msg; PROCEDURE Int (x: LONGINT); VAR j, k: INTEGER; ch: CHAR; a, s: ARRAY 32 OF CHAR; BEGIN IF x # MIN(LONGINT) THEN IF x < 0 THEN s[0] := "-"; k := 1; x := -x ELSE k := 0 END; j := 0; REPEAT a[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0 ELSE a := "8085774586302733229"; s[0] := "-"; k := 1; j := 0; WHILE a[j] # 0X DO INC(j) END END; ASSERT(k + j < LEN(s), 20); REPEAT DEC(j); ch := a[j]; s[k] := ch; INC(k) UNTIL j = 0; s[k] := 0X; Msg(s); END Int; (* end of debugging functions *) (* encoding translation *) PROCEDURE GetEnc (OUT enc: Encoding; OUT ok: BOOLEAN); VAR env: LinLibc.PtrSTR; i, j: INTEGER; PROCEDURE IsSLetter (c: SHORTCHAR): BOOLEAN; BEGIN RETURN (c >= 'a') & (c <= 'z') END IsSLetter; PROCEDURE IsBLetter (c: SHORTCHAR): BOOLEAN; BEGIN RETURN (c >= 'A') & (c <= 'Z') END IsBLetter; PROCEDURE IsValidEncChar (x: SHORTCHAR): BOOLEAN; BEGIN RETURN ((x >= 'A') & (x <= 'Z')) OR ((x >= '0') & (x <= '9')) OR (x = '-') OR (x = '_') OR ((x >= 'a') & (x <= 'z')) END IsValidEncChar; BEGIN env := LinLibc.getenv("LANG"); IF env # NIL THEN IF env$ = "C" THEN enc := "ASCII"; ok := TRUE ELSE IF IsSLetter(env[0]) & IsSLetter(env[1]) & (env[2] = '_') & IsBLetter(env[3]) & IsBLetter(env[4]) & (env[5] = '.') THEN i := 6; j := 0; WHILE IsValidEncChar(env[i]) & (j < LEN(enc) - 1) DO enc[j] := env[i]; INC(j); INC(i) END; IF (env[i] = 0X) & (j < LEN(enc)) THEN enc[j] := 0X; ok := TRUE ELSE ok := FALSE END ELSE ok := FALSE END END ELSE ok := FALSE END END GetEnc; PROCEDURE InitConv; VAR enc: Encoding; ok: BOOLEAN; BEGIN GetEnc(enc, ok); IF ok THEN IF Kernel.littleEndian THEN e := Iconv.iconv_open(enc, "UCS-2LE"); d := Iconv.iconv_open("UCS-2LE", enc) ELSE e := Iconv.iconv_open(enc, "UCS-2BE"); d := Iconv.iconv_open("UCS-2BE", enc) END ELSE e := -1; d := -1 END END InitConv; PROCEDURE CloseConv; VAR res: INTEGER; BEGIN IF e # -1 THEN res := Iconv.iconv_close(e); e := -1 END; IF d # -1 THEN res := Iconv.iconv_close(d); d := -1 END END CloseConv; PROCEDURE ResetCodec (c: Iconv.iconv_t): BOOLEAN; VAR res, fLen, tLen: Iconv.size_t; BEGIN ASSERT(c # -1, 20); fLen := 0; tLen := 0; res := Iconv.iconv(c, NIL, fLen, NIL, tLen); RETURN res # -1 END ResetCodec; PROCEDURE Short (IN f: FullName; OUT t: ShortName; OUT ok: BOOLEAN); VAR fR, fLen, tLen: INTEGER; from: Iconv.PtrLSTR; to: Iconv.PtrSTR; res: Iconv.size_t; BEGIN (* do not use encoder for basic set of chars *) fR := 0; WHILE (f[fR] >= ' ') & (f[fR] <= '~') DO t[fR] := SHORT(f[fR]); INC(fR) END; IF f[fR] = 0X THEN t[fR] := 0X; ok := TRUE ELSIF (e # -1) & ResetCodec(e) THEN from := f; to := t; fLen := LEN(f$) * SIZE(CHAR) (* 2 *); tLen := LEN(t) - 1; res := Iconv.iconv_encode(e, from, fLen, to, tLen); IF (res >= 0) & (fLen = 0) & (tLen >= 0) THEN to[0] := 0X; ok := TRUE ELSE t[0] := 0X; ok := FALSE END ELSE t[0] := 0X; ok := FALSE END END Short; PROCEDURE Long (IN f: ShortName; OUT t: FullName; OUT ok: BOOLEAN); VAR fR, fLen, tLen: INTEGER; from: Iconv.PtrSTR; to: Iconv.PtrLSTR; res: Iconv.size_t; BEGIN (* do not use decoder for basic set of chars *) fR := 0; WHILE (f[fR] >= ' ') & (f[fR] <= '~') & (fR < LEN(t) - 1) DO t[fR] := f[fR]; INC(fR) END; IF f[fR] = 0X THEN IF fR < LEN(t) THEN t[fR] := 0X; ok := TRUE ELSE t[0] := 0X; ok := FALSE (* f is too long *) END ELSIF (d # -1) & ResetCodec(d) THEN from := f; to := t; fLen := LEN(f$); tLen := (LEN(t) - 1) * SIZE(CHAR) (* 2 *); res := Iconv.iconv_decode(d, from, fLen, to, tLen); IF (res >= 0) & (fLen = 0) & (tLen >= 0) THEN to[0] := 0X; ok := TRUE ELSE t[0] := 0X; ok := FALSE END ELSE t[0] := 0X; ok := FALSE END END Long; (* end of encoding translation *) (* get error num from linux *) PROCEDURE LinLibc_errno (): INTEGER; VAR addr, errno: INTEGER; BEGIN addr := LinLibc.__errno_location(); SYSTEM.GET(addr, errno); RETURN errno END LinLibc_errno; PROCEDURE Error (n: INTEGER): INTEGER; VAR res: INTEGER; BEGIN IF n = ok THEN res := ok ELSIF n = invalidNameErr THEN res := invalidName ELSIF (n = fileNotFoundErr) OR (n = pathNotFoundErr) THEN res := notFound ELSIF (n = fileExistsErr) OR (n = alreadyExistsErr) THEN res := existsAlready ELSIF n = writeProtectedErr THEN res := writeProtected ELSIF (n = sharingErr) OR (n = accessDeniedErr) OR (n = netAccessDeniedErr) THEN res := accessDenied ELSIF n = notEnoughMemoryErr THEN res := notEnoughMem ELSIF (n = diskFullErr) OR (n = tooManyOpenFilesErr) THEN res := notEnoughDisk ELSE res := -n END; RETURN res END Error; PROCEDURE Diff (IN a, b: ARRAY OF CHAR; caseSens: BOOLEAN): INTEGER; VAR i: INTEGER; cha, chb: CHAR; BEGIN i := 0; REPEAT cha := a[i]; chb := b[i]; INC(i); IF cha # chb THEN IF ~caseSens THEN IF (cha >= "a") & ((cha <= "z") OR (cha >= 0E0X) & (cha <= 0FEX) & (cha # 0F7X)) THEN cha := CAP(cha) END; IF (chb >= "a") & ((chb <= "z") OR (chb >= 0E0X) & (chb <= 0FEX) & (chb # 0F7X)) THEN chb := CAP(chb) END END; IF cha = "\" THEN cha := "/" END; IF chb = "\" THEN chb := "/" END; IF cha # chb THEN RETURN ORD(cha) - ORD(chb) END END UNTIL cha = 0X; RETURN 0 END Diff; PROCEDURE Stat (IN fname: FullName; VAR buf: LinLibc.stat_t; OUT res: INTEGER); VAR s: ShortName; ok1: BOOLEAN; BEGIN Short(fname, s, ok1); res := LinLibc.stat(s, buf); (* Shiryaev A. V.: OpenBSD *) END Stat; PROCEDURE ModeToAttr (mode: SET; OUT attr: SET; OUT isDir: BOOLEAN); CONST read = 8; write = 7; execute = 6; file = 15; (* bits for permissions for the current user (see man chmod) *) BEGIN attr := {}; IF ~(write IN mode) THEN INCL(attr, Files.readOnly) END; isDir := ~(file IN mode) (* see "man 2 stat" for details *) END ModeToAttr; PROCEDURE NewLocator* (IN fname: ARRAY OF CHAR): Locator; VAR loc: Locator; i: INTEGER; BEGIN NEW(loc); loc.path := fname$; i := 0; WHILE loc.path[i] # 0X DO INC(i) END; IF (loc.path[i-1] = "/") OR (loc.path[i-1] = "\") THEN loc.path[i-1] := 0X END; loc.maxLen := LinLibc.NAME_MAX; loc.caseSens := TRUE; RETURN loc END NewLocator; PROCEDURE GetType (IN name: ARRAY OF CHAR; VAR type: Files.Type); VAR i, j: INTEGER; ch: CHAR; BEGIN i := 0; j := 0; WHILE name[i] # 0X DO INC(i) END; WHILE (i > 0) & (name[i] # ".") DO DEC(i) END; IF i > 0 THEN INC(i); ch := name[i]; WHILE (j < LEN(type) - 1) & (ch # 0X) DO IF (ch >= "A") & (ch <= "Z") THEN ch := CHR(ORD(ch) + (ORD("a") - ORD("A"))) END; type[j] := ch; INC(j); INC(i); ch := name[i] END END; type[j] := 0X END GetType; PROCEDURE Append (IN path, name: ARRAY OF CHAR; type: Files.Type; max: INTEGER; VAR res: ARRAY OF CHAR ); VAR i, j, n, m, dot: INTEGER; ch: CHAR; BEGIN i := 0; WHILE path[i] # 0X DO res[i] := path[i]; INC(i) END; IF path # "" THEN ASSERT((res[i-1] # "/") & (res[i-1] # "\"), 100); res[i] := "/"; INC(i) END; j := 0; ch := name[0]; n := 0; m := max; dot := -1; IF max = 12 THEN m := 8 END; WHILE (i < LEN(res) - 1) & (ch # 0X) DO IF (ch = "/") OR (ch = "\") THEN res[i] := ch; INC(i); n := 0; m := max; dot := -1; IF max = 12 THEN m := 8 END ELSIF (n < m) OR (ch = ".") & (n = 8) THEN res[i] := ch; INC(i); INC(n); IF ch = "." THEN dot := n; IF max = 12 THEN m := n + 3 END END END; INC(j); ch := name[j] END; IF (dot = -1) & (type # "") THEN IF max = 12 THEN m := n + 4 END; IF (n < m) & (i < LEN(res) - 1) THEN res[i] := "."; INC(i); INC(n); dot := n END END; IF n = dot THEN j := 0; WHILE (n < m) & (i < LEN(res) - 1) & (type[j] # 0X) DO res[i] := type[j]; INC(i); INC(j) END END; res[i] := 0X END Append; PROCEDURE CloseFileHandle (f: File; VAR res: INTEGER); BEGIN IF (f.ref = invalid) OR (LinLibc.fclose(f.ref) = 0) THEN res := ok (* !!! *) ELSE res := LinLibc_errno() END; f.ref := invalid END CloseFileHandle; PROCEDURE CloseFile (f: File; VAR res: INTEGER); VAR s: INTEGER; n: ShortName; ok1: BOOLEAN; BEGIN IF f.state = exclusive THEN f.Flush; res := LinLibc.fflush(f.ref) END; s := f.state; f.state := closed; CloseFileHandle (f, res); IF (s IN {temp, new, hidden}) & (f.name # "") THEN Short(f.name, n, ok1); res := LinLibc.remove(n) END END CloseFile; PROCEDURE (f: File) FINALIZE; VAR res: INTEGER; BEGIN IF f.state # closed THEN CloseFile(f, res) END END FINALIZE; PROCEDURE (VAR id: Identifier) Identified (): BOOLEAN; VAR f: File; BEGIN f := id.obj(File); RETURN (f.state IN {shared, exclusive}) & (Diff(f.name, id.name, f.loc.caseSens) = 0) END Identified; PROCEDURE ThisFile (IN name: FullName): File; VAR id: Identifier; p: ANYPTR; BEGIN id.typ := SYSTEM.TYP(File); id.name := name$; p := Kernel.ThisFinObj(id); IF p # NIL THEN RETURN p(File) ELSE RETURN NIL END END ThisFile; PROCEDURE (VAR s: Searcher) Identified (): BOOLEAN; VAR f: File; BEGIN f := s.obj(File); IF (f.ref # invalid) & ((s.f = NIL) OR (f.t < s.f.t)) THEN s.f := f END; RETURN FALSE END Identified; PROCEDURE SearchFileToClose; VAR s: Searcher; p: ANYPTR; (* res: LONGINT; *) BEGIN s.typ := SYSTEM.TYP(File); s.f := NIL; p := Kernel.ThisFinObj(s); IF s.f # NIL THEN res := LinLibc.fclose(s.f.ref); s.f.ref := invalid; IF res = 0 THEN res := LinLibc_errno(); HALT(100) END END END SearchFileToClose; PROCEDURE ExistingFile (VAR n: ShortName): BOOLEAN; VAR f: LinLibc.PtrFILE; ret: BOOLEAN; res: INTEGER; BEGIN f := LinLibc.fopen(n, "r"); IF f # LinLibc.NULL THEN res := LinLibc.fclose(f); ret := TRUE ELSE ret := FALSE END; RETURN ret END ExistingFile; PROCEDURE MoveFile (VAR old, new: ShortName; VAR res: INTEGER); (* as the WinApi.MoveFile *) BEGIN IF ExistingFile(new) THEN res := fileExistsErr ELSE IF LinLibc.rename(old, new) = 0 THEN res := ok ELSE res := LinLibc_errno(); END END END MoveFile; PROCEDURE NewFileRef (state: INTEGER; VAR name: FullName; VAR ref, res: INTEGER); VAR n: ShortName; ok1: BOOLEAN; BEGIN Short(name, n, ok1); IF state = create THEN (* Create should fail if file already exists *) IF ExistingFile(n) THEN ref := invalid; res := fileExistsErr ELSE ref := LinLibc.fopen(n, "w+"); IF ref = invalid THEN res := LinLibc_errno() ELSE res := ok END END ELSIF state = shared THEN ref := LinLibc.fopen(n, "r"); IF ref = invalid THEN res := LinLibc_errno() ELSE res := ok END ELSE ref := LinLibc.fopen(n, "r+"); IF ref = invalid THEN res := LinLibc_errno() ELSE res := ok END END END NewFileRef; PROCEDURE OpenFile (state: INTEGER; VAR name: FullName; VAR ref, res: INTEGER); BEGIN NewFileRef(state, name, ref, res); IF ref = invalid THEN IF res = tooManyOpenFilesErr THEN Kernel.Collect; NewFileRef(state, name, ref, res); IF ref = invalid THEN res := LinLibc_errno(); IF res = tooManyOpenFilesErr THEN SearchFileToClose; NewFileRef(state, name, ref, res); END ELSE res := ok END END ELSE res := ok END END OpenFile; PROCEDURE GetTempFileName (IN path: FullName; OUT name: FullName; num: INTEGER); VAR i: INTEGER; str: ARRAY 16 OF CHAR; BEGIN str := tempName; i := 7; WHILE i > 2 DO str[i] := CHR(num MOD 10 + ORD("0")); DEC(i); num := num DIV 10 END; Append(path, str, "", 8, name) END GetTempFileName; PROCEDURE CreateFile (f: File; VAR res: INTEGER); VAR num, n: INTEGER; BEGIN IF f.name = "" THEN num := LinLibc.clock(); n := 200; REPEAT GetTempFileName(f.loc.path, f.name, num); INC(num); DEC(n); OpenFile(create, f.name, f.ref, res) UNTIL (res # fileExistsErr) OR (n = 0) ELSE OpenFile(f.state, f.name, f.ref, res) END END CreateFile; PROCEDURE Delete (IN fname, path: FullName; VAR res: INTEGER); VAR num, n: INTEGER; f: File; new: FullName; attr: SET; fn, nn: ShortName; buf: LinLibc.stat_t; isDir: BOOLEAN; ok1: BOOLEAN; BEGIN ASSERT(fname # "", 100); f := ThisFile(fname); Short(fname, fn, ok1); IF f = NIL THEN IF LinLibc.remove(fn) = 0 THEN res := ok ELSE res := LinLibc.fflush(0); IF LinLibc.remove(fn) = 0 THEN res := ok ELSE res := LinLibc_errno() END END ELSE (* still in use => make it anonymous *) IF f.ref # invalid THEN res := LinLibc.fclose(f.ref); f.ref := invalid END; (* !!! *) Stat(f.name, buf, res); ModeToAttr(buf.st_mode, attr, isDir); IF (res = ok) & ~(Files.readOnly IN attr) THEN num := LinLibc.clock(); n := 200; REPEAT GetTempFileName(path, new, num); INC(num); DEC(n); Short(new, nn, ok1); MoveFile(fn, nn, res); UNTIL (res # fileExistsErr) OR (n = 0); IF res = ok THEN f.state := hidden; f.name := new$ END ELSE res := writeProtectedErr END END END Delete; PROCEDURE FlushBuffer (f: File; i: INTEGER); VAR buf: Buffer; res: INTEGER; BEGIN buf := f.bufs[i]; IF (buf # NIL) & buf.dirty THEN IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END; IF f.ref # invalid THEN res := LinLibc.fseek(f.ref, buf.org, LinLibc.SEEK_SET); IF LinLibc.fwrite(SYSTEM.ADR(buf.data), 1, buf.len, f.ref) < buf.len THEN res := LinLibc_errno(); HALT(101) END; res := LinLibc.fflush(f.ref); buf.dirty := FALSE; f.t := Kernel.Time() END END END FlushBuffer; (* File *) PROCEDURE (f: File) NewReader (old: Files.Reader): Files.Reader; VAR r: Reader; BEGIN (* portable *) ASSERT(f.state # closed, 20); IF (old # NIL) & (old IS Reader) THEN r := old(Reader) ELSE NEW(r) END; IF r.base # f THEN r.base := f; r.buf := NIL; r.SetPos(0) END; r.eof := FALSE; RETURN r END NewReader; PROCEDURE (f: File) NewWriter (old: Files.Writer): Files.Writer; VAR w: Writer; BEGIN (* portable *) ASSERT(f.state # closed, 20); ASSERT(f.state # shared, 21); IF (old # NIL) & (old IS Writer) THEN w := old(Writer) ELSE NEW(w) END; IF w.base # f THEN w.base := f; w.buf := NIL; w.SetPos(f.len) END; RETURN w END NewWriter; PROCEDURE (f: File) Length (): INTEGER; BEGIN (* portable *) RETURN f.len END Length; PROCEDURE (f: File) Flush; VAR i: INTEGER; BEGIN (* portable *) i := 0; WHILE i # nofbufs DO FlushBuffer(f, i); INC(i) END END Flush; PROCEDURE GetPath (IN fname: FullName; OUT path: FullName); VAR i: INTEGER; BEGIN path := fname$; i := LEN(path$); WHILE (i > 0) & (path[i] # "\") & (path[i] # "/") & (path[i-1] # ":") DO DEC(i) END; path[i] := 0X END GetPath; PROCEDURE CreateDir (VAR path: FullName; VAR res: INTEGER); VAR (*sec: KERNEL32.SecurityAttributes;*) p: FullName; s: ShortName; ok1: BOOLEAN; BEGIN ASSERT(path # "", 100); Short(path, s, ok1); res := LinLibc.mkdir(s, {0..MAX(SET)}); (* full rights are masked with the umask, is this correct? *) IF res # ok THEN res := LinLibc_errno(); IF (res = LinLibc.ENOTDIR) OR (res = LinLibc.ENOENT) THEN GetPath(path, p); CreateDir(p, res); (* recursive call *) IF res = ok THEN res := LinLibc.mkdir(s, {0..MAX(SET)}); (* full rights are masked with the umask, is this correct? *) IF res # ok THEN res := LinLibc_errno() END END END END END CreateDir; PROCEDURE CheckPath (VAR path: FullName; ask: BOOLEAN; VAR res: INTEGER); VAR s: ARRAY 300 OF CHAR; t: ARRAY 32 OF CHAR; BEGIN (*IF ask THEN IF MapParamString # NIL THEN MapParamString("#Host:CreateDir", path, "", "", s); MapParamString("#Host:MissingDirectory", "", "", "", t) ELSE s := path$; t := "Missing Directory" END; res := Kernel.MessageBox(t, s, {Kernel.mbOk, Kernel.mbCancel}) ELSE res := Kernel.mbOk END;*) (*IF res = Kernel.mbOk THEN*) CreateDir(path, res) (*ELSIF res = Kernel.mbCancel THEN res := cancel END*) END CheckPath; PROCEDURE CheckDelete (IN fname, path: FullName; ask: BOOLEAN; VAR res: INTEGER); VAR s: ARRAY 300 OF CHAR; t: ARRAY 16 OF CHAR; BEGIN REPEAT Delete(fname, path, res); IF (res = writeProtectedErr) OR (res = sharingErr) OR (res = accessDeniedErr) OR (res = netAccessDeniedErr) THEN (*IF ask THEN IF MapParamString # NIL THEN IF res = writeProtectedErr THEN MapParamString("#Host:ReplaceWriteProtected", fname, 0DX, "", s) ELSIF (res = accessDeniedErr) OR (res = netAccessDeniedErr) THEN MapParamString("#Host:ReplaceAccessDenied", fname, 0DX, "", s) ELSE MapParamString("#Host:ReplaceInUse", fname, 0DX, "", s) END; MapParamString("#Host:FileError", "", "", "", t) ELSE s := fname$; t := "File Error" END; res := Kernel.MessageBox(t, s, {Kernel.mbRetry, Kernel.mbCancel}); IF res = Kernel.mbCancel THEN res := cancel ELSIF res = Kernel.mbRetry THEN res := retry END ELSE*) res := cancel (*END*) ELSE res := ok END UNTIL res # retry END CheckDelete; PROCEDURE (f: File) Register (name: Files.Name; type: Files.Type; ask: BOOLEAN; OUT res: INTEGER); VAR b: INTEGER; fname: FullName; fn, nn: ShortName; ok1: BOOLEAN; BEGIN ASSERT(f.state = new, 20); ASSERT(name # "", 21); Append(f.loc.path, name, type, f.loc.maxLen, fname); CheckDelete(fname, f.loc.path, ask, res); ASSERT(res # 87, 100); IF res = ok THEN IF f.name = "" THEN f.name := fname$; OpenFile(create, f.name, f.ref, res); IF res = ok THEN f.state := exclusive; CloseFile(f, res); Short(f.name, fn, ok1); END ELSE f.state := exclusive; CloseFile(f, res); Short(f.name, fn, ok1); Short(fname, nn, ok1); MoveFile(fn, nn, res); IF res = ok THEN f.name := fname$; Short(f.name, fn, ok1); ELSE ASSERT(res # 87, 101); Short(f.name, fn, ok1); b := LinLibc.remove(fn); END END END; res := Error(res) END Register; PROCEDURE (f: File) Close; VAR res: INTEGER; BEGIN (* portable *) IF f.state # closed THEN (* IF f.state = exclusive THEN CloseFile(f, res) ELSE CloseFileHandle(f, res) END *) CloseFile(f, res) END END Close; (* Locator *) PROCEDURE (loc: Locator) This* (IN path: ARRAY OF CHAR): Locator; VAR new: Locator; i: INTEGER; BEGIN IF path = "" THEN NEW(new); new^ := loc^ ELSIF path[0] = "/" THEN (* absolute path *) new := NewLocator(path); new.rootLen := 0 ELSIF (path[0] = "\") OR (path[0] = "/") THEN IF (path[1] = "\") OR (path[1] = "/") THEN (* network path *) new := NewLocator(path); new.rootLen := 0 ELSE NEW(new); new^ := dir.startup^; new.res := invalidName; RETURN new END ELSE NEW(new); Append(loc.path, path, "", loc.maxLen, new.path); i := 0; WHILE new.path[i] # 0X DO INC(i) END; IF (new.path[i-1] = "/") OR (new.path[i-1] = "\") THEN new.path[i-1] := 0X END; new.maxLen := loc.maxLen; new.caseSens := loc.caseSens; new.rootLen := loc.rootLen END; new.res := ok; RETURN new END This; (* Reader *) PROCEDURE (r: Reader) Base (): Files.File; BEGIN (* portable *) RETURN r.base END Base; PROCEDURE (r: Reader) SetPos (pos: INTEGER); VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer; BEGIN f := r.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25); ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21); offset := pos MOD bufsize; org := pos - offset; i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END; IF i # nofbufs THEN buf := f.bufs[i]; IF buf = NIL THEN (* create new buffer *) NEW(buf); f.bufs[i] := buf; buf.org := -1 END ELSE (* choose an existing buffer *) f.swapper := (f.swapper + 1) MOD nofbufs; FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1 END; IF buf.org # org THEN IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END; count := buf.len; IF count > 0 THEN IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END; IF f.ref # invalid THEN IF LinLibc.fseek(f.ref, org, LinLibc.SEEK_SET) # 0 THEN res := LinLibc_errno(); HALT(101) END; IF LinLibc.fread(SYSTEM.ADR(buf.data), 1, count, f.ref) < count THEN res := LinLibc_errno(); HALT(102) END; f.t := Kernel.Time() END END; buf.org := org; buf.dirty := FALSE END; r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE (* 0<= r.org <= r.base.len *) (* 0 <= r.offset < bufsize *) (* 0 <= r.buf.len <= bufsize *) (* r.offset <= r.base.len *) (* r.offset <= r.buf.len *) END SetPos; PROCEDURE (r: Reader) Pos (): INTEGER; BEGIN (* portable *) ASSERT(r.base # NIL, 20); RETURN r.org + r.offset END Pos; PROCEDURE (r: Reader) ReadByte (OUT x: BYTE); BEGIN (* portable *) IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END; IF r.offset < r.buf.len THEN x := r.buf.data[r.offset]; INC(r.offset) ELSE x := 0; r.eof := TRUE END END ReadByte; PROCEDURE (r: Reader) ReadBytes (VAR x: ARRAY OF BYTE; beg, len: INTEGER); VAR from, to, count, restInBuf: INTEGER; BEGIN (* portable *) ASSERT(beg >= 0, 21); IF len > 0 THEN ASSERT(beg + len <= LEN(x), 23); WHILE len # 0 DO IF (r.org # r.buf.org) OR (r.offset >= bufsize) THEN r.SetPos(r.org + r.offset) END; restInBuf := r.buf.len - r.offset; IF restInBuf = 0 THEN r.eof := TRUE; RETURN ELSIF restInBuf <= len THEN count := restInBuf ELSE count := len END; from := SYSTEM.ADR(r.buf.data[r.offset]); to := SYSTEM.ADR(x) + beg; SYSTEM.MOVE(from, to, count); INC(r.offset, count); INC(beg, count); DEC(len, count) END; r.eof := FALSE ELSE ASSERT(len = 0, 22) END END ReadBytes; (* Writer *) PROCEDURE (w: Writer) Base (): Files.File; BEGIN (* portable *) RETURN w.base END Base; PROCEDURE (w: Writer) SetPos (pos: INTEGER); VAR f: File; org, offset, i, count, res: INTEGER; buf: Buffer; BEGIN f := w.base; ASSERT(f # NIL, 20); ASSERT(f.state # closed, 25); ASSERT(pos >= 0, 22); ASSERT(pos <= f.len, 21); offset := pos MOD bufsize; org := pos - offset; i := 0; WHILE (i # nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END; IF i # nofbufs THEN buf := f.bufs[i]; IF buf = NIL THEN (* create new buffer *) NEW(buf); f.bufs[i] := buf; buf.org := -1 END ELSE (* choose an existing buffer *) f.swapper := (f.swapper + 1) MOD nofbufs; FlushBuffer(f, f.swapper); buf := f.bufs[f.swapper]; buf.org := -1 END; IF buf.org # org THEN IF org + bufsize > f.len THEN buf.len := f.len - org ELSE buf.len := bufsize END; count := buf.len; IF count > 0 THEN IF f.ref = invalid THEN CreateFile(f, res) (* ASSERT(res = ok, 100) *) END; IF f.ref # invalid THEN IF LinLibc.fseek(f.ref, org, LinLibc.SEEK_SET) # 0 THEN res := LinLibc_errno(); HALT(101) END; IF LinLibc.fread(SYSTEM.ADR(buf.data), 1, count, f.ref) < count THEN res := LinLibc_errno(); HALT(102) END; f.t := Kernel.Time() END END; buf.org := org; buf.dirty := FALSE END; w.buf := buf; w.org := org; w.offset := offset (* 0<= w.org <= w.base.len *) (* 0 <= w.offset < bufsize *) (* 0 <= w.buf.len <= bufsize *) (* w.offset <= w.base.len *) (* w.offset <= w.buf.len *) END SetPos; PROCEDURE (w: Writer) Pos (): INTEGER; BEGIN (* portable *) ASSERT(w.base # NIL, 20); RETURN w.org + w.offset END Pos; PROCEDURE (w: Writer) WriteByte (x: BYTE); BEGIN (* portable *) ASSERT(w.base.state # closed, 25); IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END; w.buf.data[w.offset] := x; w.buf.dirty := TRUE; IF w.offset = w.buf.len THEN INC(w.buf.len); INC(w.base.len) END; INC(w.offset) END WriteByte; PROCEDURE (w: Writer) WriteBytes (IN x: ARRAY OF BYTE; beg, len: INTEGER); VAR from, to, count, restInBuf: INTEGER; BEGIN (* portable *) ASSERT(beg >= 0, 21); ASSERT(w.base.state # closed, 25); IF len > 0 THEN ASSERT(beg + len <= LEN(x), 23); WHILE len # 0 DO IF (w.org # w.buf.org) OR (w.offset >= bufsize) THEN w.SetPos(w.org + w.offset) END; restInBuf := bufsize - w.offset; IF restInBuf <= len THEN count := restInBuf ELSE count := len END; from := SYSTEM.ADR(x) + beg; to := SYSTEM.ADR(w.buf.data[w.offset]); SYSTEM.MOVE(from, to, count); INC(w.offset, count); INC(beg, count); DEC(len, count); IF w.offset > w.buf.len THEN INC(w.base.len, w.offset - w.buf.len); w.buf.len := w.offset END; w.buf.dirty := TRUE END ELSE ASSERT(len = 0, 22) END END WriteBytes; (* Directory *) PROCEDURE (d: Directory) This (IN path: ARRAY OF CHAR): Files.Locator; BEGIN RETURN d.startup.This(path) END This; PROCEDURE (d: Directory) New (loc: Files.Locator; ask: BOOLEAN): Files.File; VAR f: File; res: INTEGER; attr: SET; isDir: BOOLEAN; buf: LinLibc.stat_t; BEGIN ASSERT(loc # NIL, 20); f := NIL; res := ok; WITH loc: Locator DO IF loc.path # "" THEN Stat(loc.path, buf, res); IF res # ok THEN IF loc.res = 76 THEN CreateDir(loc.path, res) ELSE CheckPath(loc.path, ask, res) END ELSE ModeToAttr(buf.st_mode, attr, isDir); IF ~isDir THEN res := fileExistsErr END END END; IF res = ok THEN NEW(f); f.loc := loc; f.name := ""; f.state := new; f.swapper := -1; f.len := 0; f.ref := invalid END ELSE res := invalidNameErr END; loc.res := Error(res); RETURN f END New; PROCEDURE (d: Directory) Temp (): Files.File; VAR f: File; BEGIN NEW(f); f.loc := d.temp; f.name := ""; f.state := temp; f.swapper := -1; f.len := 0; f.ref := invalid; RETURN f END Temp; PROCEDURE GetShadowDir (loc: Locator; OUT dir: FullName); VAR i, j: INTEGER; BEGIN dir := startupDir$; i := startupLen; j := loc.rootLen; WHILE loc.path[j] # 0X DO dir[i] := loc.path[j]; INC(i); INC(j) END; dir[i] := 0X END GetShadowDir; PROCEDURE (d: Directory) Old (loc: Files.Locator; name: Files.Name; shrd: BOOLEAN): Files.File; VAR res: INTEGER; f: File; ref: LinLibc.PtrFILE; fname: FullName; type: Files.Type; s: BYTE; buf: LinLibc.stat_t; BEGIN ASSERT(loc # NIL, 20); ASSERT(name # "", 21); res := ok; f := NIL; WITH loc: Locator DO Append(loc.path, name, "", loc.maxLen, fname); f := ThisFile(fname); IF f # NIL THEN IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL ELSE loc.res := ok; RETURN f END END; IF shrd THEN s := shared ELSE s := exclusive END; OpenFile(s, fname, ref, res); IF ((res = fileNotFoundErr) OR (res = pathNotFoundErr)) & (loc.rootLen > 0) THEN GetShadowDir(loc, fname); Append(fname, name, "", loc.maxLen, fname); f := ThisFile(fname); IF f # NIL THEN IF ~shrd OR (f.state = exclusive) THEN loc.res := Error(sharingErr); RETURN NIL ELSE loc.res := ok; RETURN f END END; OpenFile(s, fname, ref, res) END; IF res = ok THEN NEW(f); f.loc := loc; f.swapper := -1; GetType(name, type); f.InitType(type); ASSERT(ref # invalid, 107); f.ref := ref; f.name := fname$; f.state := s; f.t := Kernel.Time(); Stat(f.name, buf, res); f.len := SHORT(buf.st_size); (* A. V. Shiryaev: OpenBSD *) res := LinLibc.fseek(ref, 0, LinLibc.SEEK_SET); END END; loc.res := Error(res); RETURN f END Old; PROCEDURE (d: Directory) Delete* (loc: Files.Locator; name: Files.Name); VAR res: INTEGER; fname: FullName; BEGIN ASSERT(loc # NIL, 20); WITH loc: Locator DO Append(loc.path, name, "", loc.maxLen, fname); Delete(fname, loc.path, res) ELSE res := invalidNameErr END; loc.res := Error(res) END Delete; PROCEDURE (d: Directory) Rename* (loc: Files.Locator; old, new: Files.Name; ask: BOOLEAN); VAR res, i: INTEGER; oldname, newname: FullName; f: File; on, nn, tn: ShortName; buf: LinLibc.stat_t; ok1: BOOLEAN; tName: FullName; BEGIN ASSERT(loc # NIL, 20); WITH loc: Locator DO Append(loc.path, old, "", loc.maxLen, oldname); Append(loc.path, new, "", loc.maxLen, newname); Short(oldname, on, ok1); Short(newname, nn, ok1); Stat(oldname, buf, res); IF res = ok THEN f := ThisFile(oldname); IF (f # NIL) & (f.ref # invalid) THEN res := LinLibc.fclose(f.ref); f.ref := invalid END; IF Diff(oldname, newname, loc.caseSens) # 0 THEN CheckDelete(newname, loc.path, ask, res); IF res = ok THEN IF LinLibc.rename(on, nn) = 0 THEN IF f # NIL THEN (* still in use => update file table *) f.name := newname$ END ELSE res := LinLibc_errno() END END ELSE (* destination is same file as source *) tName := oldname; i := LEN(tName$) - 1; REPEAT tName[i] := CHR(ORD(tName[i]) + 1); Short(tName, tn, ok1); MoveFile(on, tn, res); UNTIL (res # fileExistsErr) & (res # alreadyExistsErr) & (res # 87); IF res = ok THEN MoveFile(tn, nn, res) END END ELSE res := fileNotFoundErr END ELSE res := invalidNameErr END; loc.res := Error(res) END Rename; PROCEDURE (d: Directory) SameFile* (loc0: Files.Locator; name0: Files.Name; loc1: Files.Locator; name1: Files.Name ): BOOLEAN; VAR p0, p1: FullName; BEGIN ASSERT(loc0 # NIL, 20); ASSERT(loc1 # NIL, 21); WITH loc0: Locator DO Append(loc0.path, name0, "", loc0.maxLen, p0) END; WITH loc1: Locator DO Append(loc1.path, name1, "", loc1.maxLen, p1) END; RETURN Diff(p0, p1, loc0(Locator).caseSens) = 0 END SameFile; PROCEDURE (d: Directory) FileList* (loc: Files.Locator): Files.FileInfo; VAR diff, res: INTEGER; first, last, info: Files.FileInfo; s: FullName; ss, fname: ShortName; dirp: LinLibc.PtrDIR; dp: LinLibc.PtrDirent; buf: LinLibc.stat_t; tm: LinLibc.tm; isDir: BOOLEAN; attr: SET; ok1: BOOLEAN; dName: FullName; BEGIN ASSERT(loc # NIL, 20); first := NIL; last :=NIL; WITH loc: Locator DO Short(loc.path, ss, ok1); dirp := LinLibc.opendir(ss); IF dirp # LinLibc.NULL THEN dp := LinLibc.readdir(dirp); WHILE dp # NIL DO Long(dp.d_name$, dName, ok1); IF ok1 & (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dName$) < LEN(info.name)) THEN fname := ss + "/" + dp.d_name; res := LinLibc.stat(fname, buf); (* Shiryaev A. V.: OpenBSD *) ModeToAttr(buf.st_mode, attr, isDir); IF ~isDir THEN info := first; last := NIL; s := dName; WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END; NEW(info); info.name := dName$; GetType(info.name, info.type); info.length := SHORT(buf.st_size); (* A. V. Shiryaev: OpenBSD *) tm := LinLibc.localtime(buf.st_mtime); IF tm # NIL THEN info.modified.year := tm.tm_year + 1900; info.modified.month := tm.tm_mon + 1; info.modified.day := tm.tm_mday; info.modified.hour := tm.tm_hour; info.modified.minute := tm.tm_min; info.modified.second := tm.tm_sec END; info.attr := attr; IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END END END; dp := LinLibc.readdir(dirp) END; res := LinLibc.closedir(dirp) ELSE res := LinLibc_errno() END; (* check startup directory *) IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN GetShadowDir(loc, s); Short(s, ss, ok1); dirp := LinLibc.opendir(ss); IF dirp # LinLibc.NULL THEN dp := LinLibc.readdir(dirp); WHILE dp # NIL DO Long(dp.d_name$, dName, ok1); IF ok1 & (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dName$) < LEN(info.name)) THEN fname := ss + "/" + dp.d_name; res := LinLibc.stat(fname, buf); (* Shiryaev A. V.: OpenBSD *) ModeToAttr(buf.st_mode, attr, isDir); IF ~isDir THEN info := first; last := NIL; s := dName; IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END; WHILE (info # NIL) & (diff < 0) DO last := info; info := info.next; IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END END; IF (info = NIL) OR (diff # 0) THEN NEW(info); info.name := dName$; GetType(info.name, info.type); info.length := SHORT(buf.st_size); (* A. V. Shiryaev: OpenBSD *) tm := LinLibc.localtime(buf.st_mtime); IF tm # NIL THEN info.modified.year := tm.tm_year + 1900; info.modified.month := tm.tm_mon + 1; info.modified.day := tm.tm_mday; info.modified.hour := tm.tm_hour; info.modified.minute := tm.tm_min; info.modified.second := tm.tm_sec END; info.attr := attr; IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END END END END; dp := LinLibc.readdir(dirp) END; res := LinLibc.closedir(dirp) ELSE res := LinLibc_errno() END END; loc.res := Error(res) ELSE loc.res := invalidName END; RETURN first END FileList; PROCEDURE (d: Directory) LocList* (loc: Files.Locator): Files.LocInfo; VAR diff, res: INTEGER; first, last, info: Files.LocInfo; s: FullName; isDir: BOOLEAN; attr: SET; ss, fname: ShortName; dirp: LinLibc.PtrDIR; dp: LinLibc.PtrDirent; buf: LinLibc.stat_t; ok1: BOOLEAN; dName: FullName; BEGIN ASSERT(loc # NIL, 20); first := NIL; last :=NIL; WITH loc: Locator DO Short(loc.path, ss, ok1); dirp := LinLibc.opendir(ss); IF dirp # LinLibc.NULL THEN dp := LinLibc.readdir(dirp); WHILE dp # NIL DO Long(dp.d_name$, dName, ok1); IF ok1 & (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dName$) < LEN(info.name)) THEN fname := ss + "/" + dp.d_name; res := LinLibc.stat(fname, buf); (* Shiryaev A. V.: OpenBSD *) ModeToAttr(buf.st_mode, attr, isDir); IF isDir THEN info := first; last := NIL; s := dName; WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END; NEW(info); info.name := dName$; info.attr := attr; IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END END END; dp := LinLibc.readdir(dirp) END; res := LinLibc.closedir(dirp) ELSE res := LinLibc_errno() END; (* check startup directory *) IF (loc.rootLen > 0) & ((res = ok) OR (res = fileNotFoundErr) OR (res = pathNotFoundErr)) THEN GetShadowDir(loc, s); Short(s, ss, ok1); dirp := LinLibc.opendir(ss); IF dirp # LinLibc.NULL THEN dp := LinLibc.readdir(dirp); WHILE dp # NIL DO Long(dp.d_name$, dName, ok1); IF ok1 & (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dName$) < LEN(info.name)) THEN fname := ss + "/" + dp.d_name; res := LinLibc.stat(fname, buf); (* Shiryaev A. V.: OpenBSD *) ModeToAttr(buf.st_mode, attr, isDir); IF isDir THEN info := first; last := NIL; s := dName; IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END; WHILE (info # NIL) & (diff < 0) DO last := info; info := info.next; IF info # NIL THEN diff := Diff(info.name, s, loc.caseSens) END END; IF (info = NIL) OR (diff # 0) THEN NEW(info); info.name := dName$; info.attr := attr; IF last = NIL THEN info.next := first; first := info ELSE info.next := last.next; last.next := info END END END END; dp := LinLibc.readdir(dirp) END; res := LinLibc.closedir(dirp) ELSE res := LinLibc_errno() END END; loc.res := Error(res) ELSE loc.res := invalidName END; RETURN first END LocList; PROCEDURE (d: Directory) GetFileName (name: Files.Name; type: Files.Type; OUT filename: Files.Name); BEGIN Append("", name, type, LEN(filename), filename) END GetFileName; (** Miscellaneous **) PROCEDURE (VAR id: Counter) Identified (): BOOLEAN; VAR f: File; BEGIN f := id.obj(File); IF f.state # closed THEN INC(id.count) END; RETURN FALSE END Identified; PROCEDURE NofFiles* (): INTEGER; VAR p: ANYPTR; cnt: Counter; BEGIN cnt.typ := SYSTEM.TYP(File); cnt.count := 0; p := Kernel.ThisFinObj(cnt); RETURN cnt.count END NofFiles; PROCEDURE GetModDate* (f: Files.File; VAR year, month, day, hour, minute, second: INTEGER); VAR buf: LinLibc.stat_t; tm: LinLibc.tm; BEGIN ASSERT(f IS File, 20); Stat(f(File).name, buf, res); IF res = ok THEN tm := LinLibc.localtime(buf.st_mtime); IF tm # NIL THEN year := tm.tm_year + 1900; month := tm.tm_mon + 1; day := tm.tm_mday; hour := tm.tm_hour; minute := tm.tm_min; second := tm.tm_sec ELSE res := -1 END END; IF res # ok THEN year := 0; month := 0; day := 0; hour := 0; minute := 0; second := 0 END END GetModDate; PROCEDURE SetRootDir* (path: ARRAY OF CHAR); VAR i: INTEGER; BEGIN dir.startup := NewLocator(path); dir.startup.rootLen := 0; i := 0; WHILE startupDir[i] # 0X DO INC(i) END; startupLen := i END SetRootDir; (* PROCEDURE GetName (VAR p: ARRAY OF CHAR; VAR i: INTEGER; OUT name, opt: FullName); VAR ch, tch: CHAR; j: INTEGER; BEGIN j := 0; ch := p[i]; tch := " "; WHILE ch = " " DO INC(i); ch := p[i] END; IF (ch = "'") OR (ch = '"') THEN tch := ch; INC(i); ch := p[i] END; WHILE (ch >= " ") & (ch # tch) DO name[j] := ch; IF (ch >= "a") & (ch <= "z") OR (ch >= "à") & (ch <= "ö") OR (ch >= "ø") & (ch <= "þ") THEN ch := CAP(ch) ELSIF ch = "-" THEN ch := "/" END; opt[j] := ch; INC(j); INC(i); ch := p[i] END; IF ch > " " THEN INC(i); ch := p[i] END; WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := p[i] END; name[j] := 0X; opt[j] := 0X END GetName; PROCEDURE Init; VAR res, i, slp: INTEGER; path, opt: FullName; attr: SET; p: LinLibc.PtrSTR; str: ARRAY 256 OF CHAR; buf: LinLibc.stat_t; isDir: BOOLEAN; BEGIN (* TODO: Instead of using getcwd below to find the local path it would be better to use Kernel.bootinfo.argv[0]. But this only works if the PATH variable of the shell is not set to hold the BlackBox directory. In that case all directories in the PATH variable has to be searched for the blackbox executable: if (argv[0][0] == '/') s = argv[0] else { str = getenv( "PATH" ); len = strlen( str ); for ( i = 0, s = 0; i < len; i++ ) if ( str[i] == ':' ) { str[i] = '\0'; if ( checkpath( str + s, argv[0] ) ) break; else s = i + 1; } } *) wildcard := "*"; NEW(dir); str := Kernel.cmdLine$; i := 0; slp := -1; WHILE (str[i] # " ") & (str[i] # 0X) DO startupDir[i] := str[i]; IF str[i] = "/" THEN slp := i END; INC(i) END; startupDir[i] := 0X; IF slp < 0 THEN appName := startupDir; p := NIL; p := LinLibc.getcwd(p, 0); startupDir := p$; LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p)); i := 0; WHILE startupDir[i] # 0X DO INC(i) END; startupLen := i; ELSE i := slp + 1; WHILE startupDir[i] # 0X DO appName[i - slp - 1] := startupDir[i]; INC(i) END; startupDir[slp] := 0X; startupLen := slp; END; dir.startup := NewLocator(startupDir); dir.startup.rootLen := 0; (* p := NIL; p := LinLibc.getcwd(p, 0); startupDir := p$; LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p)); dir.startup := NewLocator(startupDir); dir.startup.rootLen := 0; i := 0; WHILE startupDir[i] # 0X DO INC(i) END; startupLen := i; str := Kernel.cmdLine$; *) (* i := 0; WHILE (str[i] # " ") & (str[i] # 0X) DO appName[i] := str[i]; INC(i) END; appName[i] := 0X; *) i := 0; res := 1; REPEAT GetName(str, i, path, opt); IF opt = "/USE" THEN GetName(str, i, path, opt); Stat(path, buf, res); IF res =ok THEN ModeToAttr(buf.st_mode, attr, isDir); IF isDir THEN res := ok ELSE res := invalidName END END END UNTIL (res = 0) OR (str[i] < " "); IF serverVersion & (res = 0) THEN i := 0; WHILE path[i] # 0X DO INC(i) END; IF (path[i-1] = "/") OR (path[i-1] = "\") THEN DEC(i); path[i] := 0X END; dir.startup := NewLocator(path); dir.startup.rootLen := SHORT(i) END; dir.temp := NewLocator(LinLibc.P_tmpdir); Files.SetDir(dir) END Init; *) PROCEDURE Init; CONST bbServerDir = "BB_PRIMARY_DIR"; bbWorkDir = "BB_SECONDARY_DIR"; VAR res: INTEGER; attr: SET; p: LinLibc.PtrSTR; buf: LinLibc.stat_t; isDir, def1: BOOLEAN; ok1: BOOLEAN; fname: FullName; BEGIN InitConv; wildcard := "*"; NEW(dir); p := LinLibc.getenv(bbServerDir); (* p = NIL -> undefined *) def1 := FALSE; IF p # NIL THEN Long(p$, fname, ok1); IF ok1 THEN Stat(fname, buf, res); IF res = ok THEN ModeToAttr(buf.st_mode, attr, isDir); def1 := isDir END END; IF ~def1 THEN Msg("HostFiles: Value of " + bbServerDir + " isn't directory, using cwd") END END; IF ~def1 THEN p := NIL; p := LinLibc.getcwd(p, 0); Long(p$, fname, ok1); IF ~ok1 THEN fname := "." END; LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p)) END; startupDir := fname; startupLen := LEN(startupDir$); dir.startup := NewLocator(startupDir); dir.startup.rootLen := 0; p := LinLibc.getenv(bbWorkDir); (* p = NIL -> undefined *) IF def1 & (p # NIL) THEN Long(p$, fname, ok1); IF ok1 THEN Stat(fname, buf, res); ok1 := res = ok; IF ok1 THEN ModeToAttr(buf.st_mode, attr, isDir); ok1 := isDir END END; IF ~serverVersion THEN (* - *) ELSIF ok1 THEN dir.startup := NewLocator(fname); dir.startup.rootLen := LEN(fname$) ELSE Msg("HostFiles: Value of " + bbWorkDir + " isn't directory, server configuration isn't enabled") END END; dir.temp := NewLocator(LinLibc.P_tmpdir); Files.SetDir(dir) END Init; BEGIN Init CLOSE CloseConv END HostFiles.