! Local file system processes. These processes interpret requests in standard ! internal message form, whether from an external-service manager or from a ! local process. The processes are responsible for performing directory and ! file system operations as necessary. %externalstring(47) copyright %alias "GDMR_(C)_F_LOCAL" = %c "Copyright (C) 1987, 1988 George D.M. Ross" ! To do: implement append-mode %option "-low-nonstandard-nocheck-nodiag-noline" !%option "-low-nonstandard" %constinteger processes = 4 %constinteger priority = 6 %constinteger process size = 30720 %constinteger attribute lookaside size = 64 %constinteger group query size = 16 %constinteger default initial allocation = 32 %constinteger file tokens = 48 %constinteger directory buffer size = 4096 %constinteger directory buffers = 6; ! <= 31 %constinteger directory token = 16_40000000 ! reserved: non-file-structured = 16_80000000 %constinteger world read access = 16_20000000 %include "Moose:Mouse.Inc" %include "GDMR_H:FSysAcc.Inc" %include "GDMR_H:FSys.Inc" %include "GDMR_H:Dir.Inc" %include "GDMR_H:Tree.Inc"; ! **Meantime** %include "GDMR_H:NFac.Inc" %include "GDMR_H:DateTime.Inc" %externalpredicatespec authority identify user(%integer token, %string(*)%name user) %externalpredicatespec authority local identify user(%integer token, %integername value) %externalpredicatespec authority local set user(%integer token, value) %constinteger NUL = 0 %constinteger infinity = 16_7FFFFFFF %constinteger change file = modify file mode ! append to file mode %systemroutinespec phex(%integer i) %systemroutinespec phex2(%integer i) %systemstring(31)%fnspec itos(%integer i, j) %systemintegerfnspec free store %systemintegerfnspec global heap get(%integer amount) %externalroutinespec directory initialise cache %externalroutinespec fsys initialise %externalroutinespec partition start prefetcher %externalroutinespec FS insert(%string(31) name, %integer value) %externalpredicatespec FS lookup(%string(31) what, %integername value) %externalroutinespec dump(%integer n, %bytename b) %ownrecord(semaphore fm) request semaphore = 0 %ownrecord(mailbox fm) request mailbox = 0 ! Diagnostic !! %routine xprintstring(%string(255) s) !! %integer i, ch !! %return %if s = "" !! %for i = 1, 1, length(s) %cycle !! ch = charno(s, i) !! %if ' ' <= ch <= '~' %start !! print symbol(ch) !! %else !! print symbol('<') !! write(ch, 0) !! print symbol('>') !! %finish !! %repeat !! %end !! %routine show path(%record(path fm)%name p) !! %while p ## nil %cycle !! print symbol('@'); phex(addr(p)) !! printstring(" -> "); phex(addr(p_next)) !! printstring(" v "); write(p_version, 0) !! printstring(" c "); xprintstring(p_key) !! newline !! p == p_next !! %repeat !! %end ! String comparison (case not significant). %integerfn compare(%string(*)%name a, b) %integer l, m, p, q, d %bytename aa, bb l = length(a); m = length(b) aa == charno(a, 1); bb == charno(b, 1) %while l > 0 %and m > 0 %cycle %if aa # bb %start ! Standardise case for comparison %if 'A' <= aa <= 'Z' %then p = aa - 'A' + 'a' %else p = aa %if 'A' <= bb <= 'Z' %then q = bb - 'A' + 'a' %else q = bb d = p - q %result = d %if d # 0 %finish l = l - 1; m = m - 1 aa == aa [1]; bb == bb [1] %repeat %result = length(a) - length(b) %end !*** Use something better than binary trees, as the data may well be sorted *** ! Username/ID mapping. This is an interim version, though the intention is ! that the call interface won't change much (at all). The current strategy is ! that the mapping is loaded from a file into a dual-key binary tree. The ! primary key is the username, converted to upper(?)-case -- duplicates of ! this key are not allowed. The secondary key is the user-ID -- duplicates ! are allowed. The remainder of each record consists of access information ! in the form expected by the file system. %ownstring(15) userID database = "$UserIDs" %recordformat userID mapping fm(%record(userID mapping fm)%name user l, user r, %record(userID mapping fm)%name ID l, ID r, %integer load stamp, %string(15) username, {15 meantime} %record(fsys access fm) a) ! BEWARE: the offset between and is ASSUMED below in ! . %ownrecord(userID mapping fm)%name userID root == nil %owninteger userID load stamp = 0 %ownrecord(semaphore fm) userID semaphore = 0 %ownrecord(fsys access fm) default access = 0 {} %routine print privileges(%integer mask) {} printstring(" RA") %if mask & readall privilege # 0 {} printstring(" \L") %if mask & no local privilege # 0 {} printstring(" Ad") %if mask & admin privilege # 0 {} printstring(" BA") %if mask & bootarea privilege # 0 {} printstring(" \R") %if mask & no remote privilege # 0 {} printstring(" BY") %if mask & bypass privilege # 0 {} %end {} %routine show tree by user(%record(userID mapping fm)%name x) {} %integer i {} %if x ## nil %start {} show tree by user(x_user l) {} printstring("User "); printstring(x_username) {} printstring(", ID "); write(x_a_user ID, 0) {} printstring(", privileges "); print privileges(x_a_privileges) {} printstring(", groups") {} %if x_a_groups = 0 %start {} printstring(" *none*") {} %else {} space %and write(x_a_group(i), 0) %for i = 1, 1, x_a_groups {} %finish {} newline {} show tree by user(x_user r) {} %finish {} %end {} %routine show tree by ID(%record(userID mapping fm)%name x) {} %if x ## nil %start {} show tree by ID(x_ID l) {} write(x_load stamp, 2) {} printstring(" user "); printstring(x_username) {} printstring(", ID "); write(x_a_user ID, 0) {} printstring(", privileges "); print privileges(x_a_privileges) {} newline {} show tree by ID(x_ID r) {} %finish {} %end %routine load userID database(%record(fsys access fm)%name access) %bytearray buffer(0 : 511) %integer token = 0, pos = 1, end = 0, got = 0, size, status, ID %integer sym, insert direction %record(user ID mapping fm)%name adding %string(255) username %integerfn open database %integer status, flags %string(255) text status = directory lookup one(nil, 0, 0, userID database, 0, ID, text) %result = status %if status # 0 %result = fsys open file(nil, ID, read file mode, read file mode, 0, token, size, flags) %end %integerfn next sym %integer status, n %if pos > end %start %signal 9 %if got >= size status = fsys read file block(nil, token, got >> 9, n, record(addr(buffer(0)))) %if status # 0 %start printstring("Read from userID database: ") write(status, 0); newline %signal 9 %finish got = got + n pos = 0; end = n - 1 %finish n = buffer(pos) pos = pos + 1 %result = n %end %routine close database %integer status %return %if token = 0 status = fsys close file(nil, token, 0) %if status # 0 %start printstring("Close userID database: ") write(status, 0); newline %finish %end %routine get decimal(%integername x) %integer sign sym = next sym %while sym <= ' ' %if sym = '-' %start sign = -1 sym = next sym %signal 4 %unless '0' <= sym <= '9' %else %if '0' <= sym <= '9' sign = 0 %else %signal 4 %finish x = 0 %while '0' <= sym <= '9' %cycle x = 10 * x + (sym - '0') sym = next sym %repeat x = -x %if sign < 0 %end %routine insert in tree(%record(userID mapping fm)%name x) %record(userID mapping fm)%name parent, it !! printstring("Insert in tree: user ") !! printstring(x_username) !! printstring(", ID "); write(x_a_user ID, 0) !! printstring(", priv "); write(x_a_privileges, 0) !! printstring(", groups "); write(x_a_groups, 0) !! newline x_user l == nil; x_user r == nil x_ID l == nil; x_ID r == nil %if userID root == nil %start !! printstring("Empty tree"); newline userID root == x %return %finish parent == nil; it == userID root %while it ## nil %cycle %if it_username = x_username %start !! printstring("Already there"); newline %if it_a_user ID # x_a_user ID %start printstring("Trying to change user ID for ") printstring(x_username); newline dispose(x) %return %finish it_load stamp = x_load stamp it_a = x_a dispose(x) %return %else %if x_username < it_username ! Smaller, go left !! printstring("Go left"); newline parent == it; it == it_user l %else ! Must be greater, go right !! printstring("Go right"); newline parent == it; it == it_user r %finish %repeat ! If we get here the user wasn't in the tree %if x_username < parent_username %then parent_user l == x %c %else parent_user r == x ! Now scan the tree by userID. We assume that the entry isn't ! already there, as unless there are duplicate userIDs we'll ! have already returned. it == userID root %while it ## nil %cycle %if x_a_userID < it_a_userID %start %if it_ID l == nil %then it_ID l == x %and %return %c %else it == it_ID l %else %if it_ID r == nil %then it_ID r == x %and %return %c %else it == it_ID r %finish %repeat %end %on 4, 9 %start %if event_event = 4 %start ! Dud format, skip the rest of the line printstring("Load userID database: event 4 with ") printstring(adding_username) newline -> next userID %else ! End of file -> close it %finish %finish userID load stamp = userID load stamp + 1 status = open database %if status # 0 %start ! Failed to open it, so we default to having elevated privileges {} printstring("No $UserIDs, status ") {} write(status, 0); newline default access_user ID = -1 default access_supervisor ID = 0 default access_privileges = admin privilege ! bootarea privilege %return %finish !! printstring("$UserIDs "); phex(ID) !! write(userID load stamp, 1); newline ! Make sure there's a "$System" pseudo-username defined with adequate ! access rights and privileges adding == new(adding); adding = 0 adding_username = "$System"; adding_a_userID = -1 adding_a_privileges = admin privilege ! bootarea privilege ! bypass privilege adding_load stamp = userID load stamp insert in tree(adding) next userID: sym = next sym %until sym = NL; ! NB the first line will be thrown away. %cycle ! First, skip leading spaces etc sym = next sym %until sym > ' ' %if sym = '!' %start ! If the line is a comment, throw it all away sym = next sym %until sym = NL %else adding == new(adding); adding = 0 ! Process the user info. Username first adding_username = "" %while sym > ' ' %cycle sym = sym - 'a' + 'A' %if 'a' <= sym <= 'z' adding_username = adding_username . to string(sym) sym = next sym %repeat get decimal(adding_a_userID) get decimal(adding_a_privileges) get decimal(adding_a_supervisor ID) adding_a_groups = 0 %cycle sym = next sym %while sym # NL %and sym <= ' ' %exit %if sym = NL adding_a_groups = adding_a_groups + 1 get decimal(adding_a_group(adding_a_groups)) %repeat adding_load stamp = userID load stamp insert in tree(adding) %finish %repeat close it: close database !! show tree by user(userID root) !! show tree by ID(userID root) %if access ## nil %start access_privileges = access_privileges ! admin privilege !<<<<<<<<<<<<<<<<<<<<<<< integer(addr(access) - 20) = userID load stamp %c %if access ## default access %finish default access_user ID = 1 default access_supervisor ID = 0 default access_privileges = 0 default access_groups = 0 %end %record(userID mapping fm)%map user access record(%string(127) username) %record(userID mapping fm)%name x %integer i %if username = "" %start !! printstring("Default requested"); newline %result == nil %finish %for i = 1, 1, length(username) %cycle charno(username, i) = charno(username, i) - 'a' + 'A' %c %if 'a' <= charno(username, i) <= 'z' %repeat !! printstring("Looking for "); printstring(username); newline x == userID root %while x ## nil %cycle %if x_load stamp >= userID load stamp %and x_username = username %start !! printstring("Found it: ID "); write(x_a_user ID, 0); newline %result == x %finish %if username > x_username %then x == x_user r %c %else x == x_user l %repeat !! printstring("Using default access"); newline %result == nil %end %record(fsys access fm)%map user access(%string(127) u) %record(userID mapping fm)%name x x == user access record(u) %result == default access %if x == nil %result == x_a %end %string(15)%fn username(%integer userID) %record(userID mapping fm)%name x !! newline !! show tree by ID(userID root) x == userID root %while x ## nil %cycle !! printstring("Compare "); write(userID, 0) !! printstring(" against "); write(x_a_user ID, 0); newline %result = x_username %c %if x_load stamp >= userID load stamp %and x_a_user ID = userID %if userID > x_a_user ID %then x == x_ID r %c %else x == x_ID l %repeat %result = itos(userID, 0) %end %string(127)%fn identify user token(%integer t) ! Could keep a cache here? %string(127) user %result = "*Identify user token failed*" %c %unless authority identify user(t, user) %result = user %end %record(fsys access fm)%map user access by token(%integer t) %string(127) user %record(userID mapping fm)%name m %integer x !! printstring("User access by token: "); phex(t); newline %result == default access %unless authority local identify user(t, x) %if x = 0 %start ! Undefined as yet !! printstring("Undefined, setting as "); phex(addr(m)); newline %result == default access %unless authority identify user(t, user) m == user access record(user) %unless authority local set user(t, addr(m)) %start; %finish %result == m_a %else ! Already defined !! printstring("Already defined as "); phex(x); newline m == record(x) %result == m_a %if m_load stamp >= userID load stamp %result == default access; ! Deleted? %finish %end ! Attributes lookaside list %ownrecord(attributes list fm)%name attributes lookaside list == nil %ownrecord(semaphore fm) attributes lookaside semaphore = 0 %record(attributes list fm)%map new attribute %record(attributes list fm)%name a semaphore wait(attributes lookaside semaphore) %if attributes lookaside list == nil %start a == record(global heap get(size of(attributes lookaside list))) %else a == attributes lookaside list attributes lookaside list == a_next %finish a_next == nil signal semaphore(attributes lookaside semaphore) %result == a %end %routine dispose attribute(%record(attributes list fm)%name a) semaphore wait(attributes lookaside semaphore) a_next == attributes lookaside list attributes lookaside list == a signal semaphore(attributes lookaside semaphore) %end ! File tokens (issued by us, incorporating lower-level ones) %recordformat file token fm(%integer fsys issued token, file ID, %record(fsys access fm)%name access) %ownrecord(file token fm)%array our file tokens(1 : file tokens) = 0(*) %ownrecord(semaphore fm) file token semaphore = 0 %record(file token fm)%map get new file token(%record(fsys access fm)%name a) %record(file token fm)%name t %integer i semaphore wait(file token semaphore) %for i = 1, 1, file tokens %cycle t == our file tokens(i) %if t_file ID = 0 %start ! Found a free one t_file ID = -1 t_access == a signal semaphore(file token semaphore) %result == t %finish %repeat signal semaphore(file token semaphore) %result == nil %end %routine validate file token(%record(fs message fm)%name m) %record(file token fm)%name t %integer i !! printstring("Validate file token: message at "); phex(addr(m)) !! printstring(", quoted token is "); phex(m_file token); newline %for i = 1, 1, file tokens %cycle %if m_file token = addr(our file tokens(i)) %start t == record(m_file token) %exit %if t_file ID = 0; ! Invalid m_error code = 0 !! printstring("Validated (slot "); write(i, 0) !! print symbol(')'); newline %return %finish %repeat !! printstring("Invalid token"); newline m_error code = -302; m_status = -3 m_textual response = "Invalid file token" %end ! Key list stuff !! %routine print key list(%record(key list fm)%name list) !! %while list ## nil %cycle !! printstring("@ "); phex(addr(list)) !! spaces(15 - length(list_key)); printstring(list_key) !! spaces(2); phex(list_value); newline !! list == list_next !! %repeat !! %end %routine dispose keylist(%record(key list fm)%name what) %record(key list fm)%name n %while what ## nil %cycle !! printstring("Disposing (key) "); phex(addr(what)); newline n == what_next dispose(what) what == n %repeat %end %routine copy key list(%record(key list fm)%name key list, %bytename to, %integer limit, %integername copied) %integer i copied = 0 %while key list ## nil %cycle !! printstring("@ "); phex(addr(key list)) !! printstring(" copy key list: """); printstring(key list_key) !! print symbol('"'); newline %for i = 1, 1, length(key list_key) %cycle limit = limit - 1 %return %if limit <= 0 to = charno(key list_key, i) to == to [1] copied = copied + 1 %repeat %if key list_value & directory flag # 0 %start limit = limit - 1 %return %if limit <= 0 to = NUL to == to [1] copied = copied + 1 %else %if key list_value & non ID flag # 0 limit = limit - 1 %return %if limit <= 0 %if key list_value = non ID flag %then to = 2 %else to = 1 to == to [1] copied = copied + 1 %finish limit = limit - 1 %return %if limit <= 0 to = NL to == to [1] copied = copied + 1 key list == key list_next %repeat !! write(copied, 0); printstring(" bytes copied"); newline %end ! Directory buffers %recordformat directory buffer fm(%integer ID, stamp, refcount, size, %record(fsys access fm)%name access, %bytearray x(1 : directory buffer size)) %ownrecord(directory buffer fm)%array directory buffer(0 : directory buffers) = 0(*) %ownrecord(semaphore fm) directory buffer semaphore = 0 %owninteger directory buffer stamp = 0 %routine release directory buffer(%integer which) %record(directory buffer fm)%name b which = which & (\ directory token) %if which > directory buffers %start printstring("F_Local: release dud directory buffer ") write(which, 0); newline %return %finish b == directory buffer(which) semaphore wait(directory buffer semaphore) b_refcount = b_refcount - 1 %if b_refcount < 0 %start printstring("Refcount going negative for directory buffer ") phex(b_ID); newline b_refcount = 0; ! Patch it up %finish signal semaphore(directory buffer semaphore) %end %record(directory buffer fm)%map map directory buffer(%integer token) token = token & (\ directory token) %result == nil %unless token <= directory buffers %result == directory buffer(token) %end %integerfn get directory contents(%record(fsys access fm)%name access, %integer request flags, %integer ID, %integername buffer token) %record(directory buffer fm)%name b %integer status, buffer = -1, flags, i, oldest = infinity %record(key list fm)%name key list !! printstring("Get directory contents: ID ") !! phex(ID); newline semaphore wait(directory buffer semaphore) %for i = 0, 1, directory buffers %cycle b == directory buffer(i) %if b_ID = ID %and (b_access == nil %or b_access == access) %start ! Same directory, and readable by all or our own buffer !! printstring("Found at "); write(i, 0) !! printstring(", access "); phex(addr(b_access)); newline b_refcount = b_refcount + 1 signal semaphore(directory buffer semaphore) buffer token = i ! directory token %result = 0 %else %if b_refcount = 0 %and b_stamp < oldest ! Current oldest (for re-use) oldest = b_stamp buffer = i %finish %repeat %if buffer < 0 %start ! None free signal semaphore(directory buffer semaphore) %result = -200 %finish !! printstring("Using oldest at "); write(buffer, 0); newline b == directory buffer(buffer) key list == directory contents(access, request flags, ID, status, flags) %if status # 0 %start b_ID = -1; b_stamp = 0 b_refcount = 0 signal semaphore(directory buffer semaphore) %result = status %finish !! printstring("Got directory contents for "); phex(ID) !! printstring(", flags "); phex(flags); newline directory buffer stamp = directory buffer stamp + 1 b_stamp = directory buffer stamp b_refcount = 1; b_ID = ID %if flags & world read access = 0 %start ! Not generally readable, so claim the buffer for ourselves b_access == access %else ! General access, make it freely available b_access == nil %finish copy key list(key list, b_x(1), directory buffer size, b_size) signal semaphore(directory buffer semaphore) dispose key list(key list) buffer token = buffer ! directory token %result = 0 %end %routine void directory buffers(%integer ID) %record(directory buffer fm)%name b %integer i !! printstring("Void directory buffers: "); phex(ID); newline semaphore wait(directory buffer semaphore) %for i = 0, 1, directory buffers %cycle b == directory buffer(i) %if b_ID = ID %start !! printstring("Hit at "); write(i, 0); newline b_ID = -1 b_stamp = 0 %finish %repeat signal semaphore(directory buffer semaphore) %end ! Error code interpretation. Many of these should never be seen by users: ! if they do it indicates a filestore bug somewhere.... Entries with a '$' ! in the text indicate that the pathname should be substituted in. %ownstring(31)%array SMD errors(11 : 16) = "SMD transfer size error", { -11 } "SMD off cylinder end", { -12 } "SMD seek failed", { -13 } "SMD read failed", { -14 } "SMD write failed", { -15 } "SMD verify failed" { -16 } %ownstring(31)%array fsys errors(100 : 121) = "FSys bugcheck", { -100 } "End of file", { -101 } "File $ header checksum error", { -102 } "Index file full", { -103 } "File table full", { -104 } "No such file as $", { -105 } "No authority w.r.t. $", { -106 } "Bad token", { -107 } "Invalid size", { -108 } "Bad operation", { -109 } "File header full", { -110 } "Not file structured", { -111 } "Partition ID error", { -112 } "Not implemented", { -113 } "Incompatible mode for $", { -114 } "Invalid block", { -115 } "No privilege", { -116 } "Partition full", { -117 } "Bad refcount increment", { -118 } "Non-zero refcount", { -119 } "Dud file index", { -120 } "Improperly closed file $" { -121 } %ownstring(31)%array partition errors(51 : 56) = "Partition ID error", { -51 } "Partition validity error", { -52 } "Partition block ID error", { -53 } "Partition protection violation",{ -54 } "Partition readin error", { -55 } "Buffer alignment error" { -56 } %ownstring(31)%array directory errors(200 : 208) = "No directory buffers", { -200, locally generated } "Dud path", { -201 } "$ not a directory", { -202 } "Dud component", { -203 } "Non-empty directory $", { -204 } "Versions not allowed for $", { -205 } "Version not found for $", { -206 } "Too many versions for $", { -207 } "No privilege" { -208 } %ownstring(31)%array tree tree errors(500 : 505) = "B-Tree checksum error", { -500 } "File or directory $ not found", { -501, really "Key not found" } "Duplicate file name $", { -502, really "Key..." } "Null file name", { -503, really "Key..." } "Filename size error", { -504, really "key..." } "B-tree bugcheck" { -505, should never happen } %ownstring(31)%array tree data errors(550 : 554) = "Too many data blocks", { -550 } "Data size error", { -551 } "Data block corrupt", { -552 } "Data site error", { -553 } "Deleted data" { -554 } %string(255)%fn copy error(%string(*)%name text, %record(fs message fm)%name m) %string(255) result = "" %record(path fm)%name p %integer n, i %bytename ch n = length(text); ch == charno(text, 1) %while n > 0 %cycle %if ch = '$' %start ! Copy the erroneous path (only as far as the failing ! component). p == m_filename; i = m_components translated %while p ## nil %and i >= 0 %cycle result = result . p_key p == p_next; i = i - 1 result = result . to string(0) %if p ## nil %repeat %else result = result . to string(ch) %finish n = n - 1; ch == ch [1] %repeat %result = result %end %routine set status(%record(fs message fm)%name m) %if m_error code >= 0 %start m_status = m_error code %else %if -121 <= m_error code <= -100 m_status = -1; ! Meantime m_textual response = copy error(fsys errors(-m_error code), m) %else %if -56 <= m_error code <= -51 m_status = -1; ! Meantime m_textual response = partition errors(-m_error code) %else %if -208 <= m_error code <= -200 m_status = -1; ! Meantime m_textual response = copy error(directory errors(-m_error code), m) %else %if -505 <= m_error code <= -500 m_status = -1; ! Meantime m_textual response = copy error(tree tree errors(-m_error code), m) %else %if -554 <= m_error code <= -550 m_status = -1; ! Meantime m_textual response = tree data errors(-m_error code) %else %if -16 <= m_error code <= -11 m_status = -1 m_textual response = SMD errors(-m_error code) %else m_status = -2; ! Meantime m_textual response = "Unknown error " . itos(m_error code, 0) %finish %end ! One action routine for each of the request (sub)types. %routine do reload UserID database(%record(fs message fm)%name m) %record(fsys access fm)%name access %string(255) user user = identify user token(m_access token) access == user access(user) %if access_privileges & admin privilege = 0 %start m_error code = -116; set status(m) %return %finish printstring(user); printstring(" reloading UserID database") newline load UserID database(access) m_error code = 0; m_status = 0 %end %routine do open file(%record(fs message fm)%name m) %record(fsys access fm)%name access %integer ID, previous ID = 0, parent ID, partition, n %record(file token fm)%name file token %record(directory buffer fm)%name db %record(path fm)%name last !! printstring("Do open file: mode "); phex2(m_mode) !! printstring(", compatible "); phex2(m_compatible mode) !! printstring(", flags "); phex(m_request flags); newline !! show path(m_filename) m_response flags = 0; m_byte count = 0; m_file token = 0; ! Provisionally access == user access by token(m_access token) m_error code = directory lookup(access, m_request flags, m_filename, m_components translated, previous ID, parent ID, m_textual response) %if m_error code = 0 %start ! File (or previous version) exists %if m_mode & change file # 0 %start ! Open for writing. Should we create a new one (unconditionally)? %if previous ID & directory flag # 0 %start ! Directories can't be written to in any case... !! printstring("Attempt to modify directory ") !! phex(previous ID); printstring(", access mode ") !! phex(m_mode); printstring(", flags ") !! phex(m_request flags); newline !! printstring("Change file flags: "); phex(change file) !! newline m_error code = -301; m_status = -1 m_textual response = "Invalid (open modify) operation on a directory" %return %finish -> do file create %if m_request flags & create flag # 0 %finish %if previous ID & directory flag # 0 %start !! printstring("Open directory "); phex(previous ID) !! printstring(" for reading"); newline file token == get new file token(access) %if file token == nil %start m_error code = -303; m_status = -3 m_textual response = "(F_Local) No free file token" %return %finish m_error code = get directory contents(access, m_request flags, previous ID, file token_fsys issued token) %if m_error code # 0 %start set status(m) file token_file ID = 0; ! Release it %return %finish db == map directory buffer(file token_fsys issued token) %if db == nil %start m_error code = -200 %else m_byte count = db_size m_response flags = directory token m_file token = addr(file token) %finish set status(m) %return %finish ! Open an existing file (non-directory) ID = previous ID do file open: file token == get new file token(access) %if file token == nil %start m_error code = -303; m_status = -3 m_textual response = "(F_Local) No free file token" %return %finish m_error code = fsys open file(access, ID, m_mode, m_compatible mode, m_request flags, file token_fsys issued token, m_byte count, m_response flags) %if m_error code # 0 %start file token_file ID = 0 set status(m) %return %finish !! printstring("Opened "); phex(ID) !! printstring(", size is "); write(m_byte count, 0); newline !! printstring("FSys issued token is ") !! write(file token_fsys issued token, 0); newline file token_file ID = ID m_status = 0 m_file token = addr(file token) %return %finish ! Lookup error / didn't exist / external translation %if m_error code > 0 %start ! External translation, dispose of it quickly ! (Nothing to do except set the status code.) m_status = m_error code %return %finish ! If we're only reading the file, or we haven't been asked to create ! it if it doesn't exist, then there's nothing more we can do. %if m_mode & change file = 0 %start ! Read only, so return error set status(m) %return %else %if m_request flags & (create flag ! create if flag) = 0 ! Writing, but we weren't asked to create it set status(m) %return %finish ! If we get here we must have been asked to create a file which either ! doesn't already exist, should be replaced by a new version, or had some ! problem with the path. We'll deal with the last case first since we ! have to look down the path component list to find the final component ! anyway. If the "components translated" count doesn't cover the whole ! path (less the final component), then we assume that it was a lookup ! error elsewhere. previous ID = parent ID; ! Inherit from parent directory do file create: n = m_components translated; last == m_filename %while last_next ## nil %cycle n = n - 1 set status(m) %and %return %if n < 0; ! Must have failed somewhere last == last_next %repeat previous ID = 0 %if m_request flags & no inherit flag # 0 !! printstring("About to do create: parent = "); phex(parent ID) !! printstring(", previous = "); phex(previous ID); newline m_error code = fsys create file(access, last_key, (parent ID & partition mask) %c >> partition shift, previous ID, m_request flags, default initial allocation, ID) set status(m) %and %return %if m_error code # 0 m_error code = directory insert ID(access, m_request flags, parent ID, last_key, ID) %if m_error code # 0 %start ! Insert failed, so we'll have to delete the file again n = fsys delete file(nil, ID, m_request flags) set status(m) %return %finish void directory buffers(parent ID) ! All OK, so do the open -> do file open %end %routine copy block(%integer bytes, %bytename from, to) %label U, B, L, R *tst.l D0; *ble R; ! Nothing to do *move.l A1, D1; *btst.l #0, D1 *bne U ! Destination is aligned. Assume source is, and copy wordwise. ! Assume also that destination buffer has some space at the end... D0 = (D0 - 1) // 4 L: *move.l (A0)+, (A1)+ *dbra D0, L R: %return U: ! Unaligned, hence bytewise, copy *subq.l #1, D0 B: *move.b (A0)+, (A1)+ *dbra D0, B %end %routine do read data(%record(fs message fm)%name m) %record(file token fm)%name t %record(directory buffer fm)%name db %integer start pos, size, blocks, buffer !! printstring("Do read data: offset "); write(m_byte offset, 0) !! printstring(", bytes: "); write(m_byte count, 0) !! printstring(", buffer: "); phex(addr(m_data buffer)); newline validate file token(m); %return %if m_error code < 0 t == record(m_file token) !! printstring("FSys issued token is "); write(t_fsys issued token, 0) !! newline %if t_fsys issued token & directory token = 0 %start start pos = m_byte offset >> 9; blocks = m_byte count >> 9 m_byte count = 0; buffer = addr(m_data buffer) %cycle m_error code = fsys read file block(t_access, t_fsys issued token, start pos, size, record(buffer)) !! printstring("FSys read status: "); write(m_error code, 0); newline set status(m) %and %return %if m_error code # 0 m_byte count = m_byte count + size start pos = start pos + 1; buffer = buffer + 512 blocks = blocks - 1 %repeat %until blocks <= 0 %or size < 512 {i.e. EOF} m_status = 0; m_error code = 0 %else !! printstring("Read directory: offset "); write(m_byte offset, 0) !! newline db == directory buffer(t_fsys issued token & (\ directory token)) start pos = m_byte offset + 1 size = db_size - start pos + 1 size = m_byte count %if size > m_byte count %if 0 < start pos <= db_size %start copy block(size, db_x(start pos), m_data buffer) m_byte count = size m_error code = 0; m_status = 0 %else m_error code = 0; m_status = 0 m_byte count = 0 %finish %finish %end %routine do write data(%record(fs message fm)%name m) %record(file token fm)%name t validate file token(m); %return %if m_error code < 0 t == record(m_file token) %if t_fsys issued token & directory token = 0 %start m_error code = fsys write file block(t_access, t_fsys issued token, m_byte offset >> 9, m_byte count, record(addr(m_data buffer))) set status(m) %else m_status = -1; m_error code = -301 m_textual response = "Invalid (write) operation on a directory" %finish %end %routine do close file(%record(fs message fm)%name m) %record(file token fm)%name t validate file token(m); %return %if m_error code < 0 t == record(m_file token) %if t_fsys issued token & directory token = 0 %start m_error code = fsys close file(t_access, t_fsys issued token, m_request flags) t_file ID = 0 set status(m) %else !! printstring("Close a ""directory"" file ") !! phex(t_fsys issued token); newline release directory buffer(t_fsys issued token) t_file ID = 0 m_error code = 0; m_status = 0 %finish %end %routine do truncate file(%record(fs message fm)%name m) %record(file token fm)%name t validate file token(m); %return %if m_error code < 0 t == record(m_file token) %if t_fsys issued token & directory token = 0 %start m_error code= fsys truncate open file(t_access, t_fsys issued token, m_byte count) set status(m) %else m_status = -1; m_error code = -301 m_textual response = "Invalid (truncate) operation on a directory" %finish %end %routine do make accessible(%record(fs message fm)%name m) %record(fsys access fm)%name access m_error code = -1; m_status = -3 m_textual response = "Subrequest (make accessible) not implemented yet" %end %routine do header(%record(fs message fm)%name m, %record(*)%name header) ! (Assumes that buffer is at least header-sized) %record(fsys access fm)%name access %integer file ID, penultimate ID access == user access by token(m_access token) m_error code = directory lookup(access, m_request flags, m_filename, m_components translated, file ID, penultimate ID, m_textual response) set status(m) %and %return %if m_error code # 0 m_error code = fsys read file header(access, file ID, m_request flags, header) set status(m) %end %routine do short form attributes(%record(fs message fm)%name m) %record(attributes list fm)%name owner, creator, oa, la, wa, mod, size %record(attributes list fm)%name extents, flags, x, y %record(fsys access fm)%name access %integer ID translation, parent ID, i %string(255) response, d, t %string(31)%fn access modes(%integer mask) %string(31) x = "" %result = "*none*" %if mask = 0 x = x . "\" %if mask & 16_40 # 0; ! Access denied x = x . "R" %if mask & 16_01 # 0 x = x . "M" %if mask & 16_02 # 0 x = x . "A" %if mask & 16_04 # 0 x = x . "X" %if mask & 16_08 # 0 x = x . "L" %if mask & 16_10 # 0 x = x . "C" %if mask & 16_20 # 0 x = x . "@" %if mask & 16_80 # 0; ! Admin privilege required %result = x %end %string(31)%fn flag values(%integer mask) %constinteger overlapping file = 16_0002 %constinteger improperly closed file = 16_0008 %constinteger backup required = 16_0100 %constinteger archive required = 16_0200 %string(31) x = "" x = x . "$" %if mask & backup required # 0 x = x . "&" %if mask & archive required # 0 x = x . "#" %if mask & improperly closed file # 0 x = x . "?" %if mask & overlapping file # 0 %result = x %end access == user access by token(m_access token) m_error code = directory lookup(access, m_request flags, m_filename, m_components translated, ID translation, parent ID, m_textual response) %if m_error code # 0 %start !! printstring("Lookup failed for path: ") !! write(m_error code, 0); newline !! show path(m_filename) set status(m) %return %finish owner == new attribute; owner_code = file owner attribute creator == new attribute; creator_code = file creator attribute owner_next == creator oa == new attribute; oa_code = owner access attribute creator_next == oa la == new attribute; la_code = local access attribute oa_next == la wa == new attribute; wa_code = world access attribute la_next == wa flags == new attribute; flags_code = file flags attribute wa_next == flags mod == new attribute; mod_code = date modified attribute flags_next == mod size == new attribute; size_code = file size attribute mod_next == size extents == new attribute; extents_code = file extents attribute size_next == extents x == extents %for i = 1, 1, group query size %cycle y == new attribute; y_code = group access attribute y_next == nil; x_next == y x == y %repeat m_error code = fsys obtain attributes(access, ID translation, m_request flags, owner) %if m_error code # 0 %start set status(m) %else %if owner_status = 0 %start response = username(owner_numeric) %else response = "?" . itos(owner_status, 0) %finish %if creator_status = 0 %start response = response . "," . username(creator_numeric) %c %if owner_status # 0 %or creator_numeric # owner_numeric %else response = response . ",?" . itos(creator_status, 0) %finish %if oa_status = 0 %start response = response . ":" . access modes(oa_numeric) %else response = response . ":?" . itos(oa_status, 0) %finish %if flags_status = 0 %start response = response . flag values(flags_numeric) %else response = response . "?" . itos(flags_status, 0) %finish x == extents_next; !<<<< Assumes nothing else has been put in between %while x ## nil %and x_status = 0 %cycle response = response . ";" . username(x_numeric2) . %c ":" . access modes(x_numeric) x == x_next %repeat %if m_request flags & non local flag = 0 %start %if la_status = 0 %start %if wa_status # 0 %or la_numeric # wa_numeric %start response = response . ";Local:" . access modes(la_numeric) %finish %else response = response . ";Local:?" . itos(la_status, 0) %finish %finish %if wa_status = 0 %start response = response . ";" . access modes(wa_numeric) %else response = response . ";?" . itos(wa_status, 0) %finish %if mod_status = 0 %start unpack date(mod_numeric, d, t) response = response . " " . d . " " . t %else response = response . " ?" . itos(mod_status, 0) %finish %if size_status = 0 %start response = response . " " . itos((size_numeric + 511) >> 9, 0) %else response = response . "?" . itos(size_status, 0) %finish %if extents_status = 0 %start response = response . "(" . itos(extents_numeric, 0) . ")" %else response = response . "(?" . itos(extents_status, 0) . ")" %finish m_textual data = response m_error code = 0; m_status = 0 %finish x == owner %while x ## nil %cycle y == x_next dispose attribute(x) x == y %repeat %end %routine do textual permit(%record(fs message fm)%name m) %record(fsys access fm)%name access, ua %record(attributes list fm)%name a head == nil, a last, a %integer ID translation, parent ID %integer pos, last pos, lim, mask, sym, x %string(255) user %predicate parse user(%integer separator required) user = ""; last pos = pos %while pos <= lim %cycle sym = charno(m_textual data, pos) & 127 pos = pos + 1 %if sym = ':' %start ! End of user, return %false %if user = ""; ! Null username, dud %true %else %if sym = ';' ! No separator, must be dud %false %else %if sym < ' ' %or sym = 127 ! Dud character %false %else sym = sym - 'a' + 'A' %if 'a' <= sym <= 'z' user = user . to string(sym) %if sym # ' '; ! Ignore white space %finish %repeat ! Dropped off the end, so there must be no separator. %false %if separator required # 0 %true %end %predicate parse protection mask = 0; last pos = pos %while pos <= lim %cycle sym = charno(m_textual data, pos) & 127 pos = pos + 1 %if sym = 'R' %or sym = 'r' %start mask = mask ! 16_01 %else %if sym = 'M' %or sym = 'm' mask = mask ! 16_02 %else %if sym = 'A' %or sym = 'a' mask = mask ! 16_04 %else %if sym = 'X' %or sym = 'x' mask = mask ! 16_08 %else %if sym = 'L' %or sym = 'l' mask = mask ! 16_10 %else %if sym = 'C' %or sym = 'c' mask = mask ! 16_20 %else %if sym = '\' mask = mask ! 16_40 %else %if sym = '@' mask = mask ! 16_80 %else %if sym = ';' ! End of protection field, return success %true %else %if sym # '.' ! Something unrecognised, return failure %false %finish %repeat ! Dropped off the end, so return OK %true %end %predicate valid numeric(%string(*)%name s, %integername n) %integer sign, sym, pos, lim !(redundant) %false %if s = "" lim = length(s) %if charno(s, 1) = '-' %start %false %if lim < 2 sign = -1 pos = 2 %else sign = 0 pos = 1 %finish n = 0 %while pos <= lim %cycle sym = charno(s, pos) %false %unless '0' <= sym <= '9' n = 10 * n + sym - '0' pos = pos + 1 %repeat n = -n %if sign < 0 %true %end access == user access by token(m_access token) m_error code = directory lookup(access, m_request flags, m_filename, m_components translated, ID translation, parent ID, m_textual response) %if m_error code # 0 %start !! printstring("Lookup failed for path: ") !! write(m_error code, 0); newline !! show path(m_filename) set status(m) %return %finish !! printstring("Do textual protection: ID ") !! phex(ID translation); printstring(", value """) !! printstring(m_textual data); print symbol('"'); newline %if charno(m_textual data, 1) = '!' %start ! Change ownership/supervisor %if access_privileges & admin privilege = 0 %start m_error code = -116; set status(m) %return %finish lim = length(m_textual data); -> return error %if lim < 2 %if charno(m_textual data, 2) # ':' %start ! There's an owner specified !! printstring("Change ownership"); newline pos = 2 -> return error %unless parse user(0) ua == user access(user) %if ua == default access %start ! Not found, so try it as a numeric specifier -> return error %unless valid numeric(user, x) a == new attribute; a_next == nil a_code = file owner attribute; a_numeric = x %else a == new attribute; a_next == nil a_code = file owner attribute; a_numeric = ua_user ID %finish a head == a; a last == a; ! Must be first in list %else ! No owner, skip ':' pos = 3 %finish ! Now try for a supervisor %if pos <= lim %start ! There's a new supervisor specified !! printstring("Change supervisor"); newline -> return error %unless parse user(0) ua == user access(user) %if ua == default access %start ! Not found, so try it as a numeric specifier -> return error %unless valid numeric(user, x) a == new attribute; a_next == nil a_code = file supervisor attribute; a_numeric = x %else a == new attribute; a_next == nil a_code = file supervisor attribute; a_numeric = ua_user ID %finish %if a head == nil %then a head == a %c %else a last_next == a a last == a %finish %else pos = 1; lim = length(m_textual data) pos = 2 %if charno(m_textual data, 1) = ';'; ! No owner %while pos <= lim %cycle %if parse user(1) %start ! A group protection -> return error %unless parse protection %if user = "LOCAL" %start a == new attribute; a_next == nil a_code = local access attribute; a_numeric = mask %if a head == nil %then a head == a %c %else a last_next == a a last == a %else ! A real group specified. Try for it as a username first ua == user access(user) %if ua == default access %start ! Not found, so try it as a numeric specifier -> return error %unless valid numeric(user, x) a == new attribute; a_next == nil a_code = group access attribute; a_numeric = mask a_numeric2 = x %else ! Found a corresponding user. Link it in. a == new attribute; a_next == nil a_code = group access attribute; a_numeric = mask a_numeric2 = ua_user ID %finish %if a head == nil %then a head == a %c %else a last_next == a a last == a %finish %else ! No user, could it be owner or world %if last pos = 1 %start ! Must be owner access !! printstring("Assume ""owner"""); newline !! user = "Owner" pos = last pos -> return error %unless parse protection a == new attribute; a_next == nil a_code = owner access attribute; a_numeric = mask %if a head == nil %then a head == a %c %else a last_next == a a last == a %else %if pos > lim ! Must be world access, back up and try again !! printstring("Assume ""world"""); newline !! user = "World" pos = last pos -> return error %unless parse protection a == new attribute; a_next == nil a_code = world access attribute; a_numeric = mask %if a head == nil %then a head == a %c %else a last_next == a a last == a %else ! Must be bogus !! printstring("Bogus"); newline -> return error %finish %finish !! printstring("User """); printstring(user) !! printstring(""", prot "); phex2(mask); newline %repeat %finish m_error code = fsys modify attributes(access, ID translation, m_request flags, a head) set status(m) -> dispose attributes return error: m_error code = -303; m_status = -1 m_textual response = "Invalid protection specified" dispose attributes: %while a head ## nil %cycle a == a head; a head == a head_next !! printstring("Dispose attribute: "); phex(addr(a)); newline dispose attribute(a) %repeat %end %routine do obtain attributes(%record(fs message fm)%name m, %integer type) %record(fsys access fm)%name access %integer ID translation, parent ID %if type # 0 %start m_error code = -1; m_status = -3 m_textual response = "Subrequest (obtain attributes by token) not implemented yet" %return %finish access == user access by token(m_access token) m_error code = directory lookup(access, m_request flags, m_filename, m_components translated, ID translation, parent ID, m_textual response) %if m_error code # 0 %start set status(m) %return %finish m_error code = fsys obtain attributes(access, ID translation, m_request flags, m_file attributes) set status(m) %end %routine do modify attributes(%record(fs message fm)%name m, %integer type) %record(fsys access fm)%name access %integer ID translation, parent ID %if type # 0 %start m_error code = -1; m_status = -3 m_textual response = "Subrequest (modify attributes by token) not implemented yet" %return %finish access == user access by token(m_access token) m_error code = directory lookup(access, m_request flags, m_filename, m_components translated, ID translation, parent ID, m_textual response) %if m_error code # 0 %start set status(m) %return %finish m_error code = fsys modify attributes(access, ID translation, m_request flags, m_file attributes) set status(m) %end !%routine do insert directory entry(%record(fs message fm)%name m) ! %record(fsys access fm)%name access ! m_error code = -1; m_status = -3 ! m_textual response = "Subrequest (insert directory entry) not implemented yet" !%end %routine do remove directory entry(%record(fs message fm)%name m) %record(fsys access fm)%name access %record(path fm)%name final %integer directory ID, file ID !! %integer i access == user access by token(m_access token) !! printstring("Do remove: ID "); write(access_user ID, 0) !! printstring(", groups ") !! space %and write(access_group(i), 0) %c !! %for i = 1, 1, access_groups; newline final == directory penultimate(access, m_request flags, m_filename, m_components translated, directory ID, m_textual response, m_error code) set status(m) %and %return %if m_error code # 0 m_error code = directory lookup one(access, m_request flags, directory ID, final_key, final_version, file ID, m_textual response) set status(m) %and %return %if m_error code < 0 %if file ID & directory flag # 0 %start ! Normally we don't allow deletion of a non-empty directory. ! If the caller has admin privilege, however, we skip the check if ! requested to do so. Note that if the caller hasn't got admin ! privilege then we ignore the flag and check anyway. %if m_request flags & zap full directory flag = 0 %c %or access_privileges & admin privilege = 0 %start m_error code = directory check empty(access, m_request flags, file ID) set status(m) %and %return %if m_error code < 0 %finish %finish m_error code = directory delete entry(access, m_request flags, directory ID, final_key, final_version) ! Delete is implied by refcount being decremented set status(m) void directory buffers(directory ID) ;! %if m_error code = 0 %end %routine do create new directory(%record(fs message fm)%name m) %record(fsys access fm)%name access %integer parent ID access == user access by token(m_access token) m_error code = create directory(access, m_request flags, m_filename, m_request specific, m_request flags & no inherit flag, m_components translated, parent ID, m_textual response) set status(m) void directory buffers(parent ID) ;! %if m_error code = 0 %end %routine do enquire nth directory entry(%record(fs message fm)%name m) %record(fsys access fm)%name access %record(directory buffer fm)%name db %integer d, ID, parent ID, i, n access == user access by token(m_access token) m_error code = directory lookup(access, m_request flags, m_filename, m_components translated, ID, parent ID, m_textual response) set status(m) %and %return %if m_error code # 0 m_error code = get directory contents(access, m_request flags, ID, d) set status(m) %and %return %if m_error code # 0 db == directory buffer(d) ! Got the directory, now find the m_request specificth entry n = m_request specific - 1; i = 1 m_textual data = "" %while n > 0 %cycle %if i > db_size %start release directory buffer(d) m_status = 0; m_error code = 0 %return %finish n = n - 1 %if db_x(i) = NL i = i + 1 %repeat i = i + 1 %if db_x(i) = NL ! We're now pointing at the start of the entry ! (or off the end of the directory) %while i <= db_size %and db_x(i) # NL %cycle m_textual data = m_textual data . to string(db_x(i)) i = i + 1 %repeat release directory buffer(d) m_status = 0; m_error code = 0 %end %routine do insert textual translation(%record(fs message fm)%name m) %record(fsys access fm)%name access %record(path fm)%name final %integer directory ID access == user access by token(m_access token) final == directory penultimate(access, m_request flags, m_filename, m_components translated, directory ID, m_textual response, m_error code) set status(m) %and %return %if m_error code # 0 m_error code = directory insert textual(access, m_request flags, directory ID, final_key, m_mode, m_textual data) set status(m) void directory buffers(directory ID) ;! %if m_error code = 0 %end %routine do insert ID(%record(fs message fm)%name m) %record(fsys access fm)%name access %record(path fm)%name final %integer directory ID access == user access by token(m_access token) final == directory penultimate(access, m_request flags, m_filename, m_components translated, directory ID, m_textual response, m_error code) set status(m) %and %return %if m_error code # 0 m_error code = directory insert ID(access, m_request flags, directory ID, final_key, m_request specific) set status(m) void directory buffers(directory ID) ;! %if m_error code = 0 %end %routine do rename file(%record(fs message fm)%name m) %record(fsys access fm)%name access %record(path fm)%name last f, last t %integer directory ID f, directory ID t, ID translation %string(255) textual translation access == user access by token(m_access token) last f == directory penultimate(access, m_request flags, m_filename, m_components translated, directory ID f, m_textual response, m_error code) %if m_error code # 0 %start m_error code = -302 %if m_error code > 0; ! Dud component (translation) set status(m) %return %finish last t == directory penultimate(access, m_request flags, m_filename2, m_components translated 2, directory ID t, m_textual response, m_error code) %if m_error code # 0 %start m_error code = -302 %if m_error code > 0; ! Dud component (translation) set status(m) %return %finish ! Both have translated successfully to a non-external directory %if last t_version # 0 %start m_error code = -206; ! No versions allowed <<<<<<< set status(m) %return %finish m_error code = directory lookup one(access, m_request flags, directory ID f, last f_key, last f_version, ID translation, textual translation) %if m_error code # 0 %start m_error code = -302 %if m_error code > 0; ! Dud component (translation) set status(m) %return %finish m_error code = directory insert ID(access, m_request flags, directory ID t, last t_key, ID translation) %if m_error code # 0 %start set status(m) %return %finish void directory buffers(directory ID t) %if directory ID f = directory ID t %c %and compare(last f_key, last t_key) = 0 %start ! BEWARE: we've been asked to rename a file to the same name as it ! formerly had. Because we do renames as (insert, delete), this ! means that the version to be deleted has been shuffled down one. ! To compensate, we adjust it on the fly... last f_version = last f_version - 1 %finish m_error code = directory delete entry(access, m_request flags, directory ID f, last f_key, last f_version) set status(m) void directory buffers(directory ID f) ;! %if m_error code = 0 %end !%routine do copy file(%record(fs message fm)%name m) ! m_error code = -1; m_status = -3 ! m_textual response = "Subrequest (copy file) not implemented yet" !%end !%routine do exchange files(%record(fs message fm)%name m) ! m_error code = -1; m_status = -3 ! m_textual response = "Subrequest (exchange files) not implemented yet" !%end %routine do translate redirections(%record(fs message fm)%name m) %record(fsys access fm)%name access %record(path fm)%name final %integer directory ID !! printstring("Do translate redirections: ") !! phex(m_request flags); newline !! show path(m_filename) access == user access by token(m_access token) final == directory penultimate(access, m_request flags, m_filename, m_components translated, directory ID, m_textual response, m_error code) !! printstring("Status "); write(m_error code, 0); newline %if m_error code = 0 %start !! printstring("Directory ID "); phex(directory ID); newline %if m_request flags = 0 %start ! We've to translate the whole path, so look up the final ! component (non-zero means only translate to penultimate). set status(m) %and %return %if m_error code # 0 m_error code = directory lookup one(access, m_request flags, directory ID, final_key, final_version, m_file token, m_textual response) %else m_file token = directory ID %finish %finish set status(m) %end !%routine do generate unique name(%record(fs message fm)%name m) ! m_error code = -1; m_status = -3 ! m_textual response = "Subrequest (unique name) not implemented yet" !%end ! !%routine do timestamp enquiry(%record(fs message fm)%name m) ! m_error code = -1; m_status = -3 ! m_textual response = "Subrequest (timestamp enquiry) not implemented yet" !%end ! Main code of local file system process. Loop, reading the mailbox and ! calling the appropriate action routine. %owninteger which = 0 %ownrecord(semaphore fm) which sem = 0 %routine local filesystem process %record(fs message fm)%name m %ownrecord(semaphore fm) disaster = 0 %record(poa fm)%name P %switch standard(-1 : last standard request) %switch specific(-1 : last local request) %integer i, L set, L clear !%on 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 %start ! ! Last-chance disaster-trap ! P == POA ! printstring("F_Local: unexpected event "); write(P_event, 0) ! space; write(P_event sub, 0); space; phex(P_event extra) ! space; printstring(P_event message) ! printstring(" at or about PC "); phex(P_event PC) ! newline ! %for i = 0, 1, 15 %cycle ! phex(P_event r(i)); space ! newline %if i & 7 = 7 ! %repeat ! semaphore wait(disaster) !%finish open input(2, ":N"); select input(2) open output(2, ":T"); select output(2) setup semaphore(disaster) !%if POA_heap_level = 1 %start ! !! printstring("F_Local: Heap level 1 -- marking...."); newline ! mark !%finish !! %unless FS lookup("FS__FSYS_TABLES", i) %start !! printstring("No FSys tables?"); newline !! %finish semaphore wait(which sem) L set = 16_100 << which which = which + 1 signal semaphore(which sem) L clear = \ L set %cycle !! printstring("Waiting for message to "); phex(addr(request mailbox)) !! newline m == receive message(request mailbox) !L! lights or A(L set) !! printstring("Local filesystem request: code "); phex(m_request) !! printstring(", reply box "); phex(addr(m_system header_reply)) !! printstring(", sema "); phex(addr(m_system header_reply_semaphore)) !! newline %if m_request & filesystem mask = 0 %start i = m_request & request mask -> standard(i) %if 0 <= i <= last standard request %else %if m_request & filesystem mask = local request i = m_request & request mask -> specific (i) %if 0 <= i <= last local request %else ! A request code for someone else %if m_request & interpret filename # 0 %start do interpret filename: m_error code = directory lookup( %c user access by token(m_access token), m_request flags, m_filename, m_components translated, m_file token, i, m_textual response) %if m_error code = 0 %start ! Succeeded, so it must really have been meant for us?? m_error code = -1; m_status = -1 m_textual response = "Wrong filesystem for request" %else ! Failed (as expected), so return error/redirector set status(m) %finish %else m_error code = -1; m_status = -1 m_textual response = "Wrong filesystem for request" %finish -> send reply %finish ! We fall through here for standard/specific codes which we don't ! (yet?) know about. No request codes for other filesystems should ! ever reach this far. m_error code= -1; m_status = -1 m_textual response = "Unknown request code" -> send reply standard(interpret filename request & request mask): do translate redirections(m) -> send reply standard(open file request & request mask): do open file(m) -> send reply standard(close file request & request mask): do close file(m) -> send reply standard(read data request & request mask): do read data(m) -> send reply standard(write data request & request mask): do write data(m) -> send reply standard(truncate file request & request mask): do truncate file(m) -> send reply standard(make accessible request & request mask): do make accessible(m) -> send reply standard(create directory request & request mask): m_request specific = -1 specific(local create directory request & request mask): do create new directory(m) -> send reply standard(remove file request & request mask): do remove directory entry(m) -> send reply standard(rename file request & request mask): do rename file(m) -> send reply standard(textual file attributes request & request mask): do short form attributes(m) -> send reply standard(textual permit file request & request mask): do textual permit(m) -> send reply specific(local insert textual translation request & request mask): do insert textual translation(m) -> send reply specific(local get file header request & request mask): do header(m, record(addr(m_data buffer))) -> send reply specific(local obtain attributes request & request mask): do obtain attributes(m, 0) -> send reply specific(local modify attributes request & request mask): do modify attributes(m, 0) -> send reply specific(local reload admin data request & request mask): do reload userID database(m) -> send reply specific(local enquire nth entry request & request mask): do enquire nth directory entry(m) -> send reply specific(local insert ID request & request mask): do insert ID(m) -> send reply standard(*): specific(*): -> do interpret filename %if m_request & interpret filename # 0 unimplemented request: m_error code= -1; m_status = -1 m_textual response = "Unimplemented request code" send reply: !! printstring("Replying to "); phex(addr(m_system header_reply)) !! printstring(", sema "); phex(addr(m_system header_reply_semaphore)) !! printstring(", status "); write(m_status, 0) !! printstring(", error code "); write(m_error code, 0) !! printstring(", text """); printstring(m_textual response) !! print symbol('"'); newline m_followup mailbox == request mailbox send message(m, m_system header_reply, nil) !L! lights and A(L clear) %repeat %end %begin %record(process fm)%name p %integer i %label x open input(3, ":T"); select input(3) open output(3, ":T"); select output(3) setup semaphore(request semaphore) setup mailbox(request mailbox, request semaphore) setup semaphore(directory buffer semaphore) signal semaphore(directory buffer semaphore) setup semaphore(file token semaphore) signal semaphore(file token semaphore) setup semaphore(attributes lookaside semaphore) signal semaphore(attributes lookaside semaphore) FS insert(local file system mailbox, addr(request mailbox)) directory initialise cache partition start prefetcher fsys initialise load userID database(nil) setup semaphore(which sem) signal semaphore(which sem) !! printstring("Starting "); write(processes, 0) !! printstring(" local file system processes"); newline %for i = 1, 1, processes - 1 %cycle p == create process(process size, addr(x), priority, nil) !! printstring("F_local process "); write(i, 0) !! printstring(" PCB at "); phex(addr(p)) !! printstring(", POA at "); phex(addr(p_poa)) !! printstring(", heap level "); write(p_poa_heap_level, 0); newline %repeat set priority(nil, priority) !! p == current process !! printstring("F_local process "); write(processes, 0) !! printstring(" PCB at "); phex(addr(p)) !! printstring(", POA at "); phex(addr(p_poa)) !! printstring(", heap level "); write(p_poa_heap_level, 0); newline {} printstring("F_Local: "); write(free store, 0) {} printstring(" free"); newline ! Fall through to form one of the processes.... x: local filesystem process ! Never returns... %end %of %program