-- Grapevine: FTP server using VMDefs --
-- [Indigo]<Grapevine>MS>FTPServer.mesa
-- Randy Gobbel 22-May-81 13:50:58 --
-- Andrew Birrell 5-Mar-82 8:54:25 --
-- Mark Johnson May 28, 1981 2:09 PM --
DIRECTORY
AltoFile USING[ CloseDirectory, DEfile, DirHandle, DVPtr, Enumerate,
OpenDirectory, sysDirFP ],
BodyDefs USING[ maxRNameLength, RName ],
FTPDefs,
LogDefs USING[ WriteLogEntry ],
NameInfoDefs USING[ Authenticate, AuthenticateInfo, IsMemberClosure,
Membership ],
PolicyDefs USING [CheckOperation, EndOperation],
PupDefs USING[ AppendMyName, ParsePupAddressConstant, PupAddress ],
Storage USING[ Free, String ],
String USING[ AppendChar, AppendNumber,
AppendString, EquivalentStrings ],
Time USING[ Append, Packed, Unpack ],
TimeExtraDefs USING[ PackedTimeFromString ],
VMDefs USING[ AbandonFile, CantOpen, CantReadBackingStore,
CantWriteBackingStore, CloseFile, DestroyFile,
Error, FileHandle, FileTime, GetFileLength, GetFileTimes,
MarkStart, OpenFile, Page, pageSize, Position,
ReadPage, Release, SetCreationTime, SetFileLength,
UsePage, WaitFile ],
VMSpecial USING[ OpenAltoFileFromFP, QuickAndDirtyAltoRename ];
FTPServer: PROGRAM
IMPORTS AltoFile, FTPDefs, LogDefs, NameInfoDefs, PolicyDefs, PupDefs,
Storage, String, Time, TimeExtraDefs, VMDefs, VMSpecial =
BEGIN
WhoIsHe: SIGNAL RETURNS[ net, host: [0..256) ] = CODE;
--communication between LogAction and Backstop --
LogAction: PROC[user: BodyDefs.RName, file: STRING,
action: { read, write, rename, delete }] =
BEGIN
log: STRING = [128];
String.AppendString[log, "FTP server: "L];
BEGIN
net, host: [0..256);
[net, host] ← SIGNAL WhoIsHe;
String.AppendNumber[log, net, 8];
String.AppendChar[log, '#];
String.AppendNumber[log, host, 8];
END;
String.AppendChar[log, ' ];
String.AppendString[log, user];
String.AppendString[log, SELECT action FROM
read => " reading "L,
write => " writing "L,
rename => " renaming "L,
delete => " deleting "L
ENDCASE => ERROR];
String.AppendString[log, file];
LogDefs.WriteLogEntry[log];
END;
MyCreate: PROC[bufferSize: CARDINAL]
RETURNS[fileSystem: FTPDefs.FileSystem] =
BEGIN
real: BodyDefs.RName = Storage.String[BodyDefs.maxRNameLength];
RETURN[LOOPHOLE[real]];
END;
MyDestroy: PROC[ fileSystem: FTPDefs.FileSystem ] =
{ Storage.Free[fileSystem] };
MyDecompose: PROC[ fileSystem: FTPDefs.FileSystem,
absoluteFilename: STRING,
virtualFilename: FTPDefs.VirtualFilename ] =
BEGIN
virtualFilename.device.length ← 0;
virtualFilename.directory.length ← 0;
virtualFilename.name.length ← 0;
String.AppendString[virtualFilename.name, absoluteFilename];
virtualFilename.version.length ← 0;
END;
MyCompose: PROC[ fileSystem: FTPDefs.FileSystem,
absoluteFilename: STRING,
virtualFilename: FTPDefs.VirtualFilename ] =
BEGIN
IF virtualFilename.device.length = 0
AND virtualFilename.directory.length = 0
AND virtualFilename.name.length = 0
AND virtualFilename.version.length = 0
THEN NULL -- that's what the spec says! --
ELSE BEGIN
absoluteFilename.length ← 0;
String.AppendString[absoluteFilename, virtualFilename.name];
END;
END;
DefaultReg: PROC[name: BodyDefs.RName] =
BEGIN
default: STRING = ".pa"L;
FOR i: CARDINAL DECREASING IN [0..name.length)
DO IF name[i] = '. THEN EXIT;
REPEAT
FINISHED =>
IF name.length + default.length <= name.maxlength
THEN String.AppendString[name, default];
ENDLOOP;
END;
MyInspectCredentials: PROC[ fileSystem: FTPDefs.FileSystem,
status: FTPDefs.Status,
user, password: STRING ] =
BEGIN
real: BodyDefs.RName = LOOPHOLE[fileSystem];
IF status = primary
THEN BEGIN
outcome: NameInfoDefs.AuthenticateInfo;
IF user = NIL OR user.length > BodyDefs.maxRNameLength
THEN { real.length ← 0; outcome ← notFound }
ELSE BEGIN
IF password = NIL THEN outcome ← badPwd
ELSE BEGIN
real.length ← 0; String.AppendString[real, user];
DefaultReg[real];
outcome ← NameInfoDefs.Authenticate[real, password];
END;
END;
IF outcome # individual
THEN BEGIN
error: FTPDefs.FtpError = SELECT outcome FROM
notFound, group => noSuchPrimaryUser,
badPwd => incorrectPrimaryPassword,
allDown => unidentifiedTransientError,
ENDCASE => ERROR;
string: STRING = SELECT outcome FROM
notFound => "Incorrect registry or user name"L,
group => "Can't login as a group"L,
badPwd => "Incorrect password"L,
allDown => "Can't reach any authentication server",
ENDCASE => ERROR;
real.length ← 0;
ERROR FTPDefs.FTPError[error, string];
END;
END;
END;
CheckAccess: PROC[ user: BodyDefs.RName, why: {list, read, write},
file: STRING ] =
BEGIN
info: NameInfoDefs.Membership;
IF user = NIL OR user.length = 0
THEN ERROR FTPDefs.FTPError[credentialsMissing,
"No valid user/password given"L];
IF why # list AND String.EquivalentStrings[file, "Heap.data"L]
THEN FTPDefs.FTPError[requestedAccessDenied,
"'Heap.data' is private!"L];
IF why # read AND String.EquivalentStrings[file, "GV.log"L]
THEN info ← NameInfoDefs.IsMemberClosure["LogReaders↑.ms"L, user];
IF info # yes
THEN info ← NameInfoDefs.IsMemberClosure["Transport↑.ms"L, user];
SELECT info FROM
yes => NULL;
no, notGroup =>
ERROR FTPDefs.FTPError[requestedAccessDenied,
"You're not allowed access to this server"L];
allDown =>
ERROR FTPDefs.FTPError[requestedAccessDenied,
"Can't contact access control server"L];
ENDCASE => ERROR;
END;
OpenVMFile: PROC[file: STRING,
action: {read, write, delete, enumerate}]
RETURNS[handle: VMDefs.FileHandle] =
BEGIN
ENABLE VMDefs.CantOpen => SELECT reason FROM
notFound =>
ERROR FTPDefs.FTPError[noSuchFile, "File does not exist"L];
alreadyExists =>
ERROR FTPDefs.FTPError[fileAlreadyExists, "File already exists"L];
accessDenied =>
ERROR FTPDefs.FTPError[requestedAccessDenied,
"File not available at present"L];
illegalFileName =>
ERROR FTPDefs.FTPError[illegalFilename,
"Illegal file title"L];
ENDCASE =>
ERROR FTPDefs.FTPError[unidentifiedPermanentError,
"Unidentified ""CantOpen"" from VM"L];
handle ← VMDefs.OpenFile[
options: SELECT action FROM
read, enumerate => oldReadOnly,
write => oldOrNew,
delete => old,
ENDCASE => ERROR,
name: file, cacheFraction: 2 ];
END;
GetInfo: PROC[handle: VMDefs.FileHandle, info: FTPDefs.FileInfo] =
BEGIN
IF info = NIL THEN RETURN;
BEGIN
length: VMDefs.Position = VMDefs.GetFileLength[handle];
info.byteCount ← LONG[length.page] * 2*VMDefs.pageSize + length.byte;
END;
info.fileType ← binary;
info.byteSize ← 8;
BEGIN
Append: PROC[s: STRING, t: Time.Packed] =
BEGIN
IF s # NIL
THEN { s.length ← 0; Time.Append[s, Time.Unpack[t], TRUE] };
END;
create, write, read: Time.Packed;
[create: LOOPHOLE[create, VMDefs.FileTime],
read: LOOPHOLE[read, VMDefs.FileTime],
write: LOOPHOLE[write, VMDefs.FileTime]] ← VMDefs.GetFileTimes[handle];
Append[info.creationDate, create];
Append[info.writeDate, write];
Append[info.readDate, read];
END;
END;
MyEnumerateFiles: PROC[ fileSystem: FTPDefs.FileSystem,
files: STRING, intent: FTPDefs.EnumerateFilesIntent,
processFile: PROC[UNSPECIFIED,STRING,FTPDefs.FileInfo],
processFileData: UNSPECIFIED ] =
BEGIN
real: BodyDefs.RName = LOOPHOLE[fileSystem];
creation: STRING = [22]; -- 31-Oct-83 25:61:61 BST --
write: STRING = [22]; -- 1234567890123456789012 --
read: STRING = [22];
fileInfoObject: FTPDefs.FileInfoObject ← [
fileType: binary, byteSize: 8, byteCount: 0,
creationDate: creation, writeDate: write, readDate: read,
author: NIL ];
SingleFile: PROC[entry: AltoFile.DVPtr, name: STRING] RETURNS[BOOLEAN] =
BEGIN
IF entry.type = AltoFile.DEfile
THEN BEGIN
handle: VMDefs.FileHandle = VMSpecial.OpenAltoFileFromFP[
[entry.fp.serial,entry.fp.leaderDA],FALSE,0];
GetInfo[handle, @fileInfoObject];
VMDefs.AbandonFile[handle];
processFile[processFileData, name, @fileInfoObject];
END;
RETURN[FALSE]
END;
CheckAccess[real, list, files];
IF intent = enumeration AND files.length = 1 AND files[0] = '*
THEN BEGIN
h: AltoFile.DirHandle = AltoFile.OpenDirectory[AltoFile.sysDirFP];
[] ← AltoFile.Enumerate[h, SingleFile ! UNWIND =>
AltoFile.CloseDirectory[h] ];
AltoFile.CloseDirectory[h];
END
ELSE BEGIN
IF intent = enumeration
THEN BEGIN
handle: VMDefs.FileHandle = OpenVMFile[files, enumerate];
GetInfo[handle, @fileInfoObject];
VMDefs.CloseFile[handle];
END;
processFile[processFileData, files, @fileInfoObject];
END;
END;
MyOpenFile: PROC[ fileSystem: FTPDefs.FileSystem,
file: STRING, mode: FTPDefs.Mode, fileTypePlease: BOOLEAN,
info: FTPDefs.FileInfo ]
RETURNS[ fileHandle: FTPDefs.FileHandle,
fileType: FTPDefs.FileType] =
BEGIN
real: BodyDefs.RName = LOOPHOLE[fileSystem];
SELECT mode FROM
read =>
BEGIN
handle: VMDefs.FileHandle;
CheckAccess[real, read, file];
handle ← OpenVMFile[file, read];
LogAction[real, file, read];
GetInfo[handle, info];
fileType ← binary;
fileHandle ← LOOPHOLE[handle];
END;
write =>
BEGIN
CheckAccess[real, write, file];
fileHandle ← LOOPHOLE[ OpenVMFile[file, write] ];
LogAction[real, file, write];
IF info # NIL AND info.creationDate # NIL
AND info.creationDate.length > 0
THEN VMDefs.SetCreationTime[file: LOOPHOLE[fileHandle],
create: TimeExtraDefs.PackedTimeFromString[info.creationDate]
];
END;
ENDCASE =>
ERROR FTPDefs.FTPError[requestedAccessDenied,
"Unexpected access mode"L];
END;
MyReadFile: PROC[fileSystem: FTPDefs.FileSystem,
fileHandle: FTPDefs.FileHandle,
sendBlock: PROC[UNSPECIFIED,POINTER,CARDINAL],
sendBlockData: UNSPECIFIED ] =
BEGIN
handle: VMDefs.FileHandle = LOOPHOLE[fileHandle];
length: VMDefs.Position = VMDefs.GetFileLength[handle];
FOR p: CARDINAL IN [0..length.page) --complete pages--
DO page: VMDefs.Page = VMDefs.ReadPage[ [handle,p], 2 ];
sendBlock[sendBlockData, page, 2*VMDefs.pageSize !
UNWIND => VMDefs.Release[page] ];
VMDefs.Release[page];
ENDLOOP;
IF length.byte > 0
THEN --partial page--
BEGIN
page: VMDefs.Page = VMDefs.ReadPage[ [handle, length.page], 0 ];
sendBlock[sendBlockData, page, length.byte !
UNWIND => VMDefs.Release[page] ];
VMDefs.Release[page];
END;
END;
MyWriteFile: PROC[fileSystem: FTPDefs.FileSystem,
fileHandle: FTPDefs.FileHandle,
receiveBlock: PROC[UNSPECIFIED,POINTER,CARDINAL]
RETURNS[CARDINAL],
receiveBlockData: UNSPECIFIED ] =
BEGIN
handle: VMDefs.FileHandle = LOOPHOLE[fileHandle];
pos: VMDefs.Position ← [0,0];
page: VMDefs.Page ← VMDefs.UsePage[ [handle, pos.page] ];
DO ENABLE UNWIND => IF page # NIL THEN VMDefs.Release[page];
amount: CARDINAL = receiveBlock[receiveBlockData, page+(pos.byte/2),
VMDefs.pageSize-(pos.byte/2) ];
IF amount = 0 THEN EXIT;
pos.byte ← pos.byte + amount;
IF amount MOD 2 # 0
THEN BEGIN
temp: UNSPECIFIED;
IF receiveBlock[receiveBlockData, @temp, SIZE[UNSPECIFIED]] = 0
THEN EXIT
ELSE ERROR FTPDefs.FTPError[requestedAccessDenied,
"Odd-byte block boundary not implemented"L];
END;
IF pos.byte >= 2 * VMDefs.pageSize
THEN BEGIN
IF pos.byte > 2 * VMDefs.pageSize THEN ERROR;
VMDefs.MarkStart[page];
VMDefs.Release[page]; page ← NIL;
pos.page ← pos.page+1; pos.byte ← 0;
page ← VMDefs.UsePage[ [handle, pos.page] ];
END;
ENDLOOP;
IF pos.byte > 0 THEN VMDefs.MarkStart[page];
VMDefs.Release[page];
VMDefs.WaitFile[handle];
VMDefs.SetFileLength[handle, pos];
END;
MyCloseFile: PROC[fileSystem: FTPDefs.FileSystem,
fileHandle: FTPDefs.FileHandle,
aborted: BOOLEAN ] =
BEGIN
VMDefs.CloseFile[LOOPHOLE[fileHandle]];
END;
MyDeleteFile: PROC[fileSystem: FTPDefs.FileSystem, file: STRING] =
BEGIN
real: BodyDefs.RName = LOOPHOLE[fileSystem];
handle: VMDefs.FileHandle;
CheckAccess[real, write, file];
handle ← OpenVMFile[file, delete];
LogAction[real, file, delete];
VMDefs.DestroyFile[handle];
END;
MyRenameFile: PROC[fileSystem: FTPDefs.FileSystem,
currentFile, newFile: STRING] =
BEGIN
real: BodyDefs.RName = LOOPHOLE[fileSystem];
CheckAccess[real, write, newFile];
CheckAccess[real, read, currentFile];
LogAction[real, currentFile, rename];
IF NOT VMSpecial.QuickAndDirtyAltoRename[old: currentFile, new: newFile]
THEN ERROR FTPDefs.FTPError[requestedAccessDenied,
"source of rename doesn't exist or destination already exists"L];
END;
-- Backstop and Filter for listeners --
Backstop: FTPDefs.BackstopServer ←
BEGIN
addr: PupDefs.PupAddress;
IF NOT PupDefs.ParsePupAddressConstant[ @addr, originOfRequest ]
THEN BEGIN addr.net ← [0]; addr.host ← [0]; END;
localInsignia.length ← 0;
String.AppendString[localInsignia, "Grapevine FTP server on host "L];
PupDefs.AppendMyName[localInsignia];
server[ !
FTPDefs.FTPError => SELECT ftpError FROM
IN FTPDefs.CommunicationError,
IN FTPDefs.ProtocolError => CONTINUE;
IN FTPDefs.UnidentifiedError => CONTINUE;
ENDCASE => RESUME;
WhoIsHe => RESUME[addr.net, addr.host];
VMDefs.Error => SELECT reason FROM
io =>
ERROR FTPDefs.FTPError[fileDataError,
"Unrecoverable i/o error"L];
resources =>
ERROR FTPDefs.FTPError[noRoomForFile,
"Backing store full"L];
ENDCASE =>
ERROR FTPDefs.FTPError[unidentifiedPermanentError,
"Unidentified ""VMDefs.Error"""L];
VMDefs.CantWriteBackingStore =>
ERROR FTPDefs.FTPError[fileDataError,
"Can't write page to backing store"L];
VMDefs.CantReadBackingStore =>
ERROR FTPDefs.FTPError[fileDataError,
"Can't read page from backing store"L];
];
PolicyDefs.EndOperation[FTP];
END;
Filter: PROC[from: STRING, purpose: FTPDefs.Purpose] =
BEGIN
IF NOT PolicyDefs.CheckOperation[FTP]
THEN BEGIN
LogDefs.WriteLogEntry["Rejected FTP connection"L];
ERROR FTPDefs.RejectThisConnection["Server full"L];
END;
END;
-- Initialization --
myFilePrimitives: FTPDefs.FilePrimitivesObject ← [
CreateFileSystem: MyCreate,
DestroyFileSystem: MyDestroy,
DecomposeFilename: MyDecompose,
ComposeFilename: MyCompose,
InspectCredentials: MyInspectCredentials,
EnumerateFiles: MyEnumerateFiles,
OpenFile: MyOpenFile,
ReadFile: MyReadFile,
WriteFile: MyWriteFile,
CloseFile: MyCloseFile,
DeleteFile: MyDeleteFile,
RenameFile: MyRenameFile
];
FTPDefs.FTPInitialize[];
FTPDefs.FTPCatchUnidentifiedErrors[FALSE];
[] ← FTPDefs.FTPCreateListener[
--purpose-- files,
--file system-- @myFilePrimitives,
--mail system-- NIL,
--comm system-- FTPDefs.PupCommunicationPrimitives[],
--backstop-- @Backstop,
--backstopData-- 0,
--filter-- Filter];
END.