12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445 |
- MODULE HostFiles;
- (* THIS IS TEXT COPY OF Files.odc *)
- (* DO NOT EDIT *)
- (*
- A. V. Shiryaev, 2012.10: filenames encoding translation implemented
- *)
- IMPORT SYSTEM, Kernel, Files, LinLibc, Codecs := EncCodecs;
- 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;
-
- 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: Codecs.Encoder;
-
- (* 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: Codecs.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 CheckEncoder;
- VAR enc: Codecs.Encoding; ok: BOOLEAN;
- BEGIN
- IF (e = NIL) & (Codecs.dir # NIL) THEN
- GetEnc(enc, ok);
- IF ok THEN e := Codecs.dir.NewEncoder(enc) (* !!! *)
- END
- END
- END CheckEncoder;
- PROCEDURE Short (IN f: FullName; OUT t: ShortName; OUT ok: BOOLEAN);
- VAR fR, fLen, tW: INTEGER;
- 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
- ELSE CheckEncoder;
- IF e # NIL THEN
- fR := 0; fLen := LEN(f$); tW := 0;
- e.Encode(f, fR, fLen, t, tW);
- IF fLen = 0 THEN t[tW] := 0X; ok := TRUE
- ELSE t[0] := 0X; ok := FALSE
- END
- ELSE (* continue, ASCII *)
- WHILE (f[fR] > 0X) & (f[fR] < 80X) DO t[fR] := SHORT(f[fR]); INC(fR) END;
- IF f[fR] = 0X THEN t[fR] := 0X; ok := TRUE
- ELSE t[0] := 0X; ok := FALSE
- END
- END
- END
- END Short;
- (* 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;
- 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 *)
- tn := on$; i := LEN(tn$) - 1;
- REPEAT
- tn[i] := SHORT(CHR(ORD(tn[i]) + 1));
- 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;
- 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
- IF (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dp.d_name$) < 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 := dp.d_name$;
- WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
- NEW(info);
- info.name := dp.d_name$;
- 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
- IF (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dp.d_name$) < 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 := dp.d_name$;
- 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 := dp.d_name$;
- 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;
- 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
- IF (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dp.d_name$) < 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 := dp.d_name$;
- WHILE (info # NIL) & (Diff(info.name, s, loc.caseSens) < 0) DO last := info; info := info.next END;
- NEW(info);
- info.name := dp.d_name$;
- 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
- IF (dp.d_name # ".") & (dp.d_name # "..") & (LEN(dp.d_name$) < 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 := dp.d_name$;
- 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 := dp.d_name$;
- 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;
- BEGIN
- wildcard := "*"; NEW(dir);
- p := LinLibc.getenv(bbServerDir); (* p = NIL -> undefined *)
- def1 := p # NIL;
- IF def1 THEN
- Stat(p$, buf, res);
- IF res = ok THEN
- ModeToAttr(buf.st_mode, attr, isDir);
- IF isDir THEN res := ok ELSE res := invalidName END
- END;
- def1 := res = ok;
- IF def1 THEN
- startupDir := p$; startupLen := LEN(startupDir$)
- ELSE
- Msg("HostFiles: Value of " + bbServerDir + " isn't directory, using cwd")
- END
- END;
- IF ~def1 THEN
- p := NIL;
- p := LinLibc.getcwd(p, 0);
- startupDir := p$; startupLen := LEN(startupDir$);
- LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p))
- END;
- dir.startup := NewLocator(startupDir);
- dir.startup.rootLen := 0;
- p := LinLibc.getenv(bbWorkDir); (* p = NIL -> undefined *)
- IF def1 & (p # NIL) THEN
- Stat(p$, buf, res);
- IF res = ok THEN
- ModeToAttr(buf.st_mode, attr, isDir);
- IF isDir THEN res := ok ELSE res := invalidName END
- END;
- IF ~serverVersion THEN
- (* - *)
- ELSIF res = ok THEN
- dir.startup := NewLocator(p$); dir.startup.rootLen := LEN(p$)
- 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
- END HostFiles.
|