-- Copyright (C) 1981, 1982, 1983, 1984 by Xerox Corporation. All rights reserved.
-- Grapevine: FTP server using VMDefs --
-- [Juniper]<DMS>MS>FTPServer.mesa
-- HGM, 21-May-85 21:02:00
-- Randy Gobbel 9-Jul-82 13:48:05 --
-- Andrew Birrell 17-Mar-81 14:46:23 --
-- Mark Johnson 21-Jan-82 15:34:28 --
-- Brenda Hankins 23-Aug-84 11:03:21 change TimeExtraDefs to TimeExtra
DIRECTORY
BodyDefs USING [maxRNameLength, RName],
FTPDefs,
LogDefs USING [WriteLogEntry],
MFile USING [EnumerateDirectory, EnumerateProc, maxNameLength],
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],
TimeExtra 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 [QuickAndDirtyAltoRename];
FTPServer: PROGRAM
IMPORTS
FTPDefs, LogDefs, MFile, NameInfoDefs, PolicyDefs, PupDefs, Storage, String,
Time, TimeExtra, 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 ← no;
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 = list OR 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: MFile.EnumerateProc =
BEGIN
shortName: STRING = [MFile.maxNameLength];
handle: VMDefs.FileHandle;
String.AppendString[shortName, name];
handle ← VMDefs.OpenFile[name: shortName];
GetInfo[handle, @fileInfoObject];
VMDefs.AbandonFile[handle];
processFile[processFileData, shortName, @fileInfoObject];
RETURN[FALSE]
END;
CheckAccess[real, list, files];
IF intent = enumeration AND files.length = 1 AND files[0] = '* THEN
MFile.EnumerateDirectory["*"L, SingleFile, filesOnly]
ELSE
BEGIN
IF intent = enumeration THEN
BEGIN
handle: VMDefs.FileHandle = OpenVMFile[files, enumerate];
GetInfo[handle, @fileInfoObject];
VMDefs.AbandonFile[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: TimeExtra.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.