!%option "-nonstandard-low-nocheck-nodiag-noline-nostack"
option "-nonstandard-low"
constinteger processes = 1
constinteger priority = 6
constinteger file tokens = 32
constinteger max roots = 32
constinteger T Read File = 1
constinteger T Modify File = 2
constinteger T Create File = 3
constinteger T Dir Listing = 4
include "b:Moose:Mouse.Inc"
include "GDMR_H:FSysAcc.Inc"
include "GDMR_H:FacMess.Inc"
include "nfsd:udpint.inc"
include "nfsd:nfs.inc"
include "nfsd:mount.inc"
include "nfsd:errors.inc"
externalpredicatespec FS lookup(string (31) what, integername value)
constinteger change file = modify file mode ! append to file mode
conststring (1) SNL = "
"
recordformat path fm(record (path fm)name next,
integer version, string (*)name key,
string (255) text)
systemroutinespec phex(integer i)
systemroutinespec phex2(integer i)
systemstring (31)fnspec itos(integer i, j)
systemintegerfnspec free store
externalroutinespec FS insert(string (31) name, integer value)
externalroutinespec dump(integer n, bytename b)
ownrecord (semaphore fm) request semaphore = 0
ownrecord (mailbox fm) request mailbox = 0
! Diagnostic
{} 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 "); printstring(p_key)
{} newline
{} p == p_next
{} repeat
{} end
{} 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 copy block(integer n, bytename from, to)
D0 = D0 - 1
L: *move.b (A0)+, (A1)+
*dbra D0, L
end
! File tokens (issued by us, incorporating lower-level ones)
recordformat file token fm(record (mailbox fm)name followup mailbox,
record (UDPStreamfm) UDP stream,
record (fhandlefm) fhandle,
string (15) domain,
string (15) user,
integer size,
integer mode,
record (dirptrfm) dirptr)
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 (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_followup mailbox == nil start
! Found a free one
t_followup mailbox == request mailbox
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
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_followup mailbox == nil; ! Invalid
m_error code = 0
return
finish
repeat
m_error code = -302; m_status = -3
m_error text = "Invalid file token"
end
routine zap (record (file token fm)name t)
t=0
end
recordformat rootfm (string (31) host,
string (127) path,
record (fhandlefm) fhandle,
integer blocksize)
ownrecord (rootfm)array roots (1:maxroots) =0(*)
owninteger last root = 0
integerfn get file handle (string (31) host, string (127) path,
record (fhandlefm)name fhandle)
record (rootfm)name root
record (UDPstreamfm) c
integer i, x, status
for i = 1, 1, last root cycle
root == roots(i)
if root_host = host and root_path = path start
fhandle = root_fhandle
result = 0
finish
repeat
{} Printstring("Mounting ".path." on ".host);newline
c_uid = -1; c_gid = -1
x = connect to mnt (host, status, c)
result = status if status # 0
x = mnt mnt (c, status, path, fhandle)
x = udp close stream (c)
result = status if status # 0
last root = last root + 1
root == roots(lastroot)
root_host = host; root_path = path; root_fhandle = fhandle
result = 0
end
integerfn lookup file (record (udpstreamfm)name c, string (127) filename,
record (fhandlefm) did, record (fhandlefm)name fid,
integername size)
integer x, status
record (diropargsfm) dir
record (diropresfm) res
dir_fhandle = did
dir_filename = filename
x = NFS lookup (c, status, dir, res)
result = status if status # 0
fid = res_fhandle
size = res_fattr_size
result = 0
end
integerfn create file (record (udpstreamfm)name c, string (127) filename,
record (fhandlefm) did, record (fhandlefm)name fid)
integer x, status
record (diropresfm) res
record (diropargsfm) dir
record (sattrfm) sattr=0
dir_fhandle = did
dir_filename = filename
sattr_mode = 8_0100777
sattr_uid = c_uid; sattr_gid = c_gid
sattr_size = 1
x = NFS Create (c, status, dir, sattr, res)
result = status if status # 0
fid = res_fhandle
result = 0
end
! Error code interpretation
routine set status(record (fs message fm)name m)
if m_error code = 0 start
m_status = 0
else
m_status = -2; ! Meantime
m_error text = "Unknown error " . itos(m_error code, 0)
finish
end
! One action routine for each of the request (sub)types.
routine do open file(record (fs message fm)name m)
record (file token fm)name file token
record (UDPStreamfm)name c
integer mode, x, status
record (pathfm)name p
record (fhandlefm) fhandle, dhandle
string (31) host
string (127) root
integerfn guddle (record (dirptrfm)name d)
record (direntfm)name f
integer siz = 0
f == d_root
while f ## nil cycle
siz = siz + length(f_filename)+1
f == f_next
repeat
result = siz
end
!! printstring("Do open file: mode "); phex2(m_access mode)
!! printstring(", compatible "); phex2(m_compatible mode)
!! printstring(", flags "); phex(m_request flags); newline
!! show path(m_filename)
m_response flags = 0; m_bytes = 0; m_file token = 0; ! Provisionally
if m_access mode & change file = 0 start
! open for reading only
mode = T Read File
else
if m_request flags & create flag = 0 then mode = T Modify File c
else mode = T Create File
finish
p == m_filename; host = p_key
file token == get new file token
if file token == NIL start
m_error code = -1; m_status = -1
m_error text = "(NFS) No free file token"
return
finish
c == file token_UDP stream
p == p_next
root = p_key
x = get file handle (host, root, dhandle)
if x # 0 start
zap (file token)
m_error code = -1; m_status = -1
m_error text = "(NFS) Failed to mount root ".root
finish
c_uid = 38; c_gid = 20 {*** should get these from m_access ***}
x = connect to nfs (host, c)
p == p_next
while p ## nil cycle
if p_key = "" start
mode = T Dir Listing
x = NFS Read Dir (c, status, dhandle, filetoken_dirptr)
file token_size = guddle (filetoken_dirptr)
if status # 0 start
x = udp close stream (c)
zap (file token)
m_error code = -1; m_status = -1
m_error text = "Failed to read directory"
return
finish
else
if mode = T Create File and p_next == NIL start
x = create file (c, p_key, dhandle, fhandle)
if x # 0 start
x = udp close stream (c)
zap (file token)
m_error code = -1; m_status = -1
m_error text = "Failed to create file"
return
finish
exit
else
x = lookup file (c, p_key, dhandle, fhandle, file token_size)
if x # 0 start
x = udp close stream (c)
zap (file token)
m_error code = -1; m_status = -1
m_error text = "Failed to open file"
return
finish
dhandle = fhandle
finish
finish
p == p_next
repeat
file token_fhandle = fhandle
file token_mode = mode
m_file token = addr(file token)
m_bytes = file token_size
m_response flags = 0
m_error code = 0; m_status = 0
end
routine do read data(record (fs message fm)name m)
record (file token fm)name t
record (fattrfm) fattr
integer n, cnt, status, x, ad, sad
record (direntfm)name f, dead
routine plant (string (127) s, integername ad)
integer i
for i = 1, 1, length (s) cycle
byteinteger(ad) = charno(s,i)
ad = ad + 1
repeat
byteinteger (ad) = nl
ad = ad + 1
end
validate file token(m); return if m_error code < 0
t == record(m_file token)
Printstring ("Read "); write(m_bytes,0); printstring(" bytes from ")
write(m_block,0);printstring (" to "); phex(addr(m_buffer));newline
if t_mode = T Read File or t_mode = T Modify File start
x = NFS Read (t_udp stream,
status,t_fhandle,m_block<<9,512,addr(m_buffer),cnt,fattr)
if status # 0 start
m_error code = -1; m_status = -1
printstring("NFS Read = ")
write(status,0);newline
m_error text = "(NFS) Failure while reading"
else
m_bytes = cnt
m_error code = 0; m_status = 0
finish
elseif t_mode = T Dir Listing
m_bytes = 0; ad = addr(m_buffer) ; sad = ad
f == t_dirptr_root
while f ## NIL cycle
plant (f_filename,ad)
dead == f
f == f_next
dispose (dead)
repeat
m_bytes = ad - sad
t_dirptr_root == NIL
m_error code = 0; m_status = 0
else
m_error code = -1; m_status = -1
m_error text = "(NFS) can't write to read-only file"
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)
end
routine do close file(record (fs message fm)name m)
record (file token fm)name t
integer x
validate file token(m); return if m_error code < 0
t == record(m_file token)
x = udp close stream (t_udp stream)
zap (t)
end
routine do truncate file(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "Subrequest (truncate file) not implemented yet"
end
routine do make accessible(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "Subrequest (make accessible) not implemented yet"
end
routine do obtain attributes(record (fs message fm)name m, integer type)
m_error code = -1; m_status = -3
m_error text = "Subrequest (obtain attributes) not implemented yet"
end
routine do short form attributes(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "Subrequest (short form attributes) not implemented yet"
end
routine do modify attributes(record (fs message fm)name m, integer type)
m_error code = -1; m_status = -3
m_error text = "Subrequest (modify attributes) not implemented yet"
end
routine do list directory contents(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "Subrequest (list directory contents) not implemented yet"
end
routine do insert directory entry(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "Subrequest (insert directory entry) not implemented yet"
end
routine do remove directory entry(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "Subrequest (remove directory entry) not implemented yet"
end
routine do create new directory(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "Subrequest (create new directory) not implemented yet"
end
routine do rename file(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "Subrequest (rename file) not implemented yet"
end
routine do copy file(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "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_error text = "Subrequest (exchange files) not implemented yet"
end
routine do delete file(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "Subrequest (delete file) not implemented yet"
end
routine do generate unique name(record (fs message fm)name m)
m_error code = -1; m_status = -3
m_error text = "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_error text = "Subrequest (timestamp enquiry) not implemented yet"
end
! Request code demultiplexing routines, one for each of the major request
! codes. These just switch on the subcodes....
routine data access(record (fs message fm)name m)
if m_subcode = open file subcode start
do open file(m)
else if m_subcode = read data subcode
do read data(m)
else if m_subcode = write data subcode
do write data(m)
else if m_subcode = close file subcode
do close file(m)
else if m_subcode = truncate file subcode
do truncate file(m)
else if m_subcode = make accessible subcode
do make accessible(m)
else
m_error code = -1; m_status = -1
m_error text = "Subrequest not recognised"
finish
end
routine file attributes access(record (fs message fm)name m)
if m_subcode = obtain attributes subcode start
do obtain attributes(m, 0)
else if m_subcode = obtain attributes token subcode
do obtain attributes(m, 1)
else if m_subcode = short form attributes subcode
do short form attributes(m)
else if m_subcode = modify attributes subcode
do modify attributes(m, 0)
else if m_subcode = modify attributes token subcode
do modify attributes(m, 1)
else
m_error code = -1; m_status = -1
m_error text = "Subrequest not recognised"
finish
end
routine directory access(record (fs message fm)name m)
if m_subcode = list directory contents subcode start
do list directory contents(m)
else if m_subcode = insert directory entry subcode
do insert directory entry(m)
else if m_subcode = remove directory entry subcode
do remove directory entry(m)
else if m_subcode = create new directory subcode
do create new directory(m)
else
m_error code = -1; m_status = -1
m_error text = "Subrequest not recognised"
finish
end
routine miscellaneous file operation(record (fs message fm)name m)
if m_subcode = rename file subcode start
do rename file(m)
else if m_subcode = copy file subcode
do copy file(m)
else if m_subcode = exchange files subcode
do exchange files(m)
else if m_subcode = delete file subcode
do delete file(m)
else if m_subcode = translate redirections subcode
! Null operation, since we don't know about redirections.
! Just return success, and nothing translated.
m_status = 0; m_error code = 0
m_components translated = 0
else
m_error code = -1; m_status = -1
m_error text = "Subrequest not recognised"
finish
end
routine miscellaneous other operation(record (fs message fm)name m)
if m_subcode = generate unique name subcode start
do generate unique name(m)
else if m_subcode = timestamp enquiry subcode
do timestamp enquiry(m)
else
m_error code = -1; m_status = -1
m_error text = "Subrequest not recognised"
finish
end
!%routine nonstandard operation(%record(fs message fm)%name m)
! %if m_subcode = 0 %start
! do filestore logon(m)
! %else %if m_subcode = 1
! do filestore logoff(m)
! %else %if m_subcode = 2
! do filestore quote(m)
! %else
! m_error code = -1; m_status = -1
! m_error text = "Subrequest (nonstandard) not recognised"
! %finish
!%end
! Main code of local file system process. Loop, reading the mailbox and
! calling a code-demultiplexing routine to interpret the subcodes as
! appropriate.
routine local filesystem process
record (fs message fm)name m
ownrecord (semaphore fm) disaster = 0
record (poa fm)name P
integer i
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("NFSP: 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)
mark if POA_heap_level = 1
cycle
!! printstring("Waiting for message to "); phex(addr(request mailbox))
!! newline
m == receive message(request mailbox)
!! printstring("Code is "); write(m_code, 0); newline
if m_code = data access code start
data access(m)
else if m_code = file attributes access code
file attributes access(m)
else if m_code = directory access code
directory access(m)
else if m_code = miscellaneous file operation code
miscellaneous file operation(m)
else if m_code = miscellaneous other operation code
miscellaneous other operation(m)
! %else %if m_code = 128
! nonstandard operation(m)
else
m_error code= -1; m_status = -1
m_error text = "Unknown request code"
finish
!! printstring("Replying, status "); write(m_status, 0)
!! printstring(", error code "); write(m_error code, 0)
!! printstring(", text """); printstring(m_error text)
!! print symbol('"'); newline
send message(m, m_system part_reply, nil)
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(file token semaphore)
signal semaphore(file token semaphore)
FS insert(NFS file system mailbox, addr(request mailbox))
{} printstring("Starting "); write(processes, 0)
{} printstring(" NFS process"); newline
! p == create process(10240, addr(x), priority, nil) %for i = 1, 1, processes - 1
set priority(nil, priority)
{} printstring("NFSP: "); write(free store, 0)
{} printstring(" free"); newline
! Fall through to form one of the processes....
x: local filesystem process
! Never returns...
end of program