-- GateFTPServer.mesa, Edit: HGM March 20, 1981 6:39 PM
-- Please don't forget to update the herald....
DIRECTORY
Process USING [Detach],
Runtime USING [IsBound],
Storage USING [CopyString, Free, FreeString, FreeStringNil, Node],
String USING [
AppendChar, AppendString, AppendDecimal, AppendNumber, EquivalentString,
InvalidNumber, StringToOctal, SubString, SubStringDescriptor],
Time USING [AppendCurrent],
CmFile USING [Close, GetNextToken, NextItem, OpenSection],
Event USING [Item, Reason, AddNotifier],
Put USING [Line],
Tool USING [Create, MakeSWsProc, MakeMsgSW],
ToolWindow USING [TransitionProcType],
Window USING [Handle],
File USING [Capability, nullCapability],
George USING [DeleteFileFromDisk, LookupExistingFile, NameToCapability],
Indirect USING [GetParmFileName],
Lock USING [LockDiskAndWait, UnlockDisk],
Password USING [Check, Encrypted, Status, ValidMemberOfGroup],
GateDefs USING [GetVersionText],
Slosh USING [
AddProcs, Arrived, Check, CopyFile, Failed, RecvStatus, RejectThisTrash,
Release, Why],
FTPDefs,
StatsDefs USING [StatCounterIndex, StatIncr, StatsStringToIndex],
PupDefs;
GateFTPServer: MONITOR
IMPORTS
Process, Runtime, Storage, String, Time, -- Mesa/Pilot
CmFile, Event, Put, Tool, -- Tools
George, Indirect, Lock, Password, GateDefs, Slosh, StatsDefs, FTPDefs,
PupDefs =
BEGIN OPEN FTPDefs;
herald: STRING = "Gateway FTP Server of March 20, 1981";
ftplistener: FTPListener;
jimsFilePrimitives: FilePrimitives = SomeFilePrimitives[];
myFilePrimitives: FilePrimitivesObject ←
[CreateFileSystem: jimsFilePrimitives.CreateFileSystem,
DestroyFileSystem: jimsFilePrimitives.DestroyFileSystem,
DecomposeFilename: jimsFilePrimitives.DecomposeFilename,
ComposeFilename: jimsFilePrimitives.ComposeFilename,
InspectCredentials: InspectCredentials,
EnumerateFiles: jimsFilePrimitives.EnumerateFiles, OpenFile: OpenFile,
CloseFile: CloseFile, DeleteFile: DeleteFile, RenameFile: RenameFile,
ReadFile: jimsFilePrimitives.ReadFile,
WriteFile: jimsFilePrimitives.WriteFile];
defaultRegistry: STRING ← NIL;
myGroup: STRING ← NIL;
firstPassword: POINTER TO PasswordBlock ← NIL;
PasswordBlock: TYPE = RECORD [
next: POINTER TO PasswordBlock, user: STRING, encrypted: Password.Encrypted];
maxServers: CARDINAL = 2;
servers: CARDINAL ← 0;
scratchFileNumber: CARDINAL ← 0;
tool, msg: Window.Handle ← NIL;
eventItem: Event.Item ← [eventMask: 177777B, eventProc: Broom];
useCount: CARDINAL ← 0;
pleaseStop, running: BOOLEAN ← FALSE;
filesReceived: StatsDefs.StatCounterIndex = StatsDefs.StatsStringToIndex[
"Files Received by FTP Server"];
filesSent: StatsDefs.StatCounterIndex = StatsDefs.StatsStringToIndex[
"Files Sent by FTP Server"];
FTPServerOn: PUBLIC ENTRY PROCEDURE =
BEGIN
IF (useCount ← useCount + 1) = 1 THEN BEGIN running ← TRUE; Starter[]; END;
UpdatePicture[];
END;
Starter: PROCEDURE =
BEGIN
backstopServer: BackstopServer ← MyBackstopServer;
pleaseStop ← FALSE;
Announce["Starting "L, herald];
Findparameters[];
FTPInitialize[];
FTPSetBufferSize[1]; -- saves memory
FTPCatchUnidentifiedErrors[FALSE]; -- Krock for GetUserAddress
ftplistener ← FTPCreateListener[
files, @myFilePrimitives, NIL, PupCommunicationPrimitives[],
@backstopServer, NIL, RejectExtras];
END;
Findparameters: PROCEDURE =
BEGIN
parmFileName: STRING ← NIL;
sectionName: STRING = "FTPServer"L;
token, arg: STRING ← NIL;
IF Runtime.IsBound[Indirect.GetParmFileName] THEN
parmFileName ← Indirect.GetParmFileName[];
IF parmFileName = NIL THEN parmFileName ← "FTPServer.txt"L;
myGroup ← Storage.CopyString[parmFileName];
FOR i: CARDINAL DECREASING IN [0..myGroup.length) DO
IF myGroup[i] = '. THEN myGroup.length ← i; ENDLOOP;
BEGIN
builtin: ARRAY [0..8) OF WORD =
[172427B, 11553B, 61543B, 113154B, 161500B, 47164B, 173546B, 120250B];
firstPassword ← Storage.Node[SIZE[PasswordBlock]];
firstPassword↑ ← [NIL, Storage.CopyString["Magic"L], LOOPHOLE[builtin]];
END;
IF ~CmFile.OpenSection[parmFileName, sectionName] THEN RETURN;
DO
[token, arg] ← CmFile.NextItem[];
SELECT TRUE FROM
token = NIL => EXIT;
token.length > 0 AND token[0] = '; => LOOP;
String.EquivalentString[token, "My Group"L] =>
BEGIN
Storage.FreeString[myGroup];
myGroup ← arg;
arg ← NIL;
Message["My Group for FTP passwords is "L, myGroup];
END;
String.EquivalentString[token, "Default Registry"L] =>
BEGIN
Storage.FreeString[defaultRegistry];
defaultRegistry ← arg;
arg ← NIL;
Message["The Default Registry for FTP passwords is "L, defaultRegistry];
END;
String.EquivalentString[token, "Password"L] =>
BEGIN
user: STRING = [50];
pwd: STRING = [8*8];
e: Password.Encrypted;
p: POINTER ← @e;
ss: String.SubStringDescriptor;
temp: POINTER TO PasswordBlock;
IF arg # NIL THEN ss ← [base: arg, offset: 0, length: arg.length];
[] ← CmFile.GetNextToken[@ss, user];
FOR i: CARDINAL IN [0..SIZE[Password.Encrypted]) DO
(p + i)↑ ← GetOctal[@ss]; ENDLOOP;
FOR i: CARDINAL IN [0..SIZE[Password.Encrypted]) DO
IF i # 0 THEN String.AppendChar[pwd, ' ];
String.AppendNumber[pwd, (p + i)↑, 8];
ENDLOOP;
temp ← Storage.Node[SIZE[PasswordBlock]];
temp↑ ← [firstPassword, Storage.CopyString[user], e];
firstPassword ← temp;
Message["FTP's Password for "L, user, " is "L, pwd];
END;
ENDCASE => BEGIN Message["Unknown keyword: "L, token]; END;
Storage.FreeString[token];
Storage.FreeString[arg];
ENDLOOP;
CmFile.Close[parmFileName];
END;
GetOctal: PROCEDURE [ss: String.SubString] RETURNS [CARDINAL] =
BEGIN
token: STRING = [100];
BEGIN
ENABLE String.InvalidNumber => Message["Octal number expected."L, token];
IF ~CmFile.GetNextToken[ss, token] THEN SIGNAL String.InvalidNumber;
RETURN[String.StringToOctal[token]];
END;
END;
Forgetparameters: PROCEDURE =
BEGIN
UNTIL firstPassword = NIL DO
temp: POINTER TO PasswordBlock ← firstPassword;
firstPassword ← firstPassword.next;
Storage.FreeString[temp.user];
Storage.Free[temp];
ENDLOOP;
defaultRegistry ← Storage.FreeStringNil[defaultRegistry];
myGroup ← Storage.FreeStringNil[myGroup];
END;
FTPServerOff: PUBLIC ENTRY PROCEDURE =
BEGIN
IF useCount # 0 AND (useCount ← useCount - 1) = 0 THEN
BEGIN running ← FALSE; Stopper[]; END;
END;
StopperLocked: ENTRY PROCEDURE = INLINE { Stopper[] };
Stopper: INTERNAL PROCEDURE =
BEGIN
pause: CONDITION;
pleaseStop ← TRUE;
UNTIL servers = 0 DO WAIT pause; ENDLOOP;
FTPFinalize[];
FTPDestroyListener[ftplistener, FALSE];
Forgetparameters[];
Announce["Killed "L, herald];
END;
UpdatePicture: PROCEDURE = BEGIN END;
RejectExtras: PROCEDURE [who: STRING, what: Purpose] =
BEGIN
IF pleaseStop THEN
ERROR FTPDefs.RejectThisConnection["Sorry, we are trying to go away"];
IF servers = maxServers THEN
ERROR FTPDefs.RejectThisConnection["Sorry, we are full now"];
servers ← servers + 1;
END;
-- krock that should be in the interface
GetUserAddress: SIGNAL RETURNS [STRING] = CODE;
GetUserName: SIGNAL RETURNS [STRING] = CODE;
SetPasswordOK: SIGNAL [code: FTPDefs.FtpError, user, reason: STRING] = CODE;
CheckPassword: SIGNAL [what: STRING] = CODE;
MyBackstopServer: PUBLIC PROCEDURE [
backstopServerData: UNSPECIFIED, purpose: SingularPurpose,
originOfRequest, localInsignia: STRING, server: PROCEDURE] =
BEGIN
him: PupDefs.PupAddress ← [, , [0, 0]];
userAddress: STRING = [40];
userName: STRING ← Storage.CopyString["??"L];
rejectReason: STRING ← Storage.CopyString["??"L];
why: FTPDefs.FtpError ← credentialsMissing;
IF ~PupDefs.ParsePupAddressConstant[@him, originOfRequest] THEN ERROR;
PupDefs.AppendHostName[userAddress, him];
Announce["Creating FTP server for "L, userAddress];
String.AppendString[localInsignia, " on "L];
String.AppendString[localInsignia,GateDefs.GetVersionText[]];
server[
! GetUserAddress => RESUME [userAddress];
GetUserName => RESUME [userName];
SetPasswordOK =>
BEGIN
IF userName # NIL THEN Storage.FreeString[userName];
userName ← Storage.CopyString[user];
IF reason#NIL THEN
BEGIN
IF rejectReason # NIL THEN Storage.FreeString[rejectReason];
rejectReason ← Storage.CopyString[reason];
END;
why ← code;
RESUME;
END;
CheckPassword =>
BEGIN
IF why#ok THEN
BEGIN
AnnounceReject[what, userName, userAddress, rejectReason];
FTPDefs.FTPError[why, rejectReason];
END;
RESUME;
END;
UNWIND =>
BEGIN
Announce["Aborting FTP server for "L, userAddress];
servers ← servers - 1;
END;
FTPError =>
BEGIN
SELECT ftpError FROM
IN CommunicationError, IN ProtocolError => CONTINUE;
IN UnidentifiedError => NULL;
ENDCASE => RESUME;
END];
Storage.FreeString[userName];
Announce["Killing FTP server for "L, userAddress];
servers ← servers - 1;
END;
InspectCredentials: PROCEDURE [
fileSystem: FileSystem, status: Status, user, password: STRING] =
BEGIN
IF user=NIL OR password=NIL THEN
BEGIN
SetPasswordOK[credentialsMissing, user, "Name or Password missing"L];
RETURN;
END;
-- check passwords from parameter file
FOR finger: POINTER TO PasswordBlock ← firstPassword, finger.next UNTIL finger
= NIL DO
IF String.EquivalentString[finger.user, user] THEN
BEGIN
matched: BOOLEAN ← Password.Check[password, finger.encrypted];
IF matched THEN SetPasswordOK[ok, user, "OK"L]
ELSE
SetPasswordOK[incorrectPrimaryPassword, user, "Password rejected by info from parameter file"L];
RETURN;
END;
ENDLOOP;
-- try Grapevine if that fails
IF myGroup = NIL THEN
SetPasswordOK[requestedAccessDenied, user, "Don't know our Grapevine group"L]
ELSE
BEGIN
person: STRING ← MaybeAppend[user, defaultRegistry];
machine: STRING ← MaybeAppend[myGroup, "internet"L];
status: Password.Status;
status ← Password.ValidMemberOfGroup[person, password, machine];
SELECT status FROM
yes => SetPasswordOK[ok, person, NIL];
nil => SetPasswordOK[credentialsMissing, person, "Confusion about NIL"L];
allDown => SetPasswordOK[requestedAccessDenied, person, "All Grapevine servers appear to be down"L];
notFound => SetPasswordOK[noSuchPrimaryUser, person, "Grapevine doesn't like your name"L];
badPwd => SetPasswordOK[incorrectPrimaryPassword, person, "Grapevine doesn't like your password"L];
group => SetPasswordOK[credentialsMissing, person, "Grapevine thinks you are a group"L];
no => SetPasswordOK[requestedAccessDenied, person, "You are not in the appropiate group"L];
notGroup => SetPasswordOK[requestedAccessDenied, person, "Grapevine doesn't recognize this machine's group"L];
error => SetPasswordOK[requestedAccessDenied, person, "Error from GrapevineUser package"L];
ENDCASE => ERROR;
Storage.FreeString[machine];
Storage.FreeString[person];
END;
END;
MaybeAppend: PROCEDURE [string, tail: STRING] RETURNS [new: STRING] =
BEGIN
IF tail = NIL THEN RETURN[Storage.CopyString[string]];
FOR i: CARDINAL IN [0..string.length) DO
IF string[i] = '. THEN RETURN[Storage.CopyString[string]]; ENDLOOP;
new ← Storage.CopyString[string, 1 + tail.length];
String.AppendChar[new, '.];
String.AppendString[new, tail];
END;
-- There are 3 interesting cases for OpenFile+CloseFile
-- 1) read: oldFile#NIL, scratchFile=NIL, write=FALSE
-- 2) write: oldFile#NIL, scratchFile#NIL, write=TRUE
-- 3) new: oldFile=NIL, scratchFile#NIL, write=TRUE
-- New is like write except the copyover is avoided
-- We should only see modes read and write
OpenFile: PROCEDURE [
fileSystem: FileSystem, file: STRING, mode: Mode, fileTypePlease: BOOLEAN,
info: FileInfo] RETURNS [fileHandle: FileHandle, fileType: FileType] =
BEGIN
write: BOOLEAN ←
SELECT mode FROM read => FALSE, write => TRUE, ENDCASE => ERROR;
scratchName: STRING = [20];
oldFile, scratchFile: File.Capability ← File.nullCapability;
IF write THEN
BEGIN OPEN String;
CheckPassword["store"L];
IF String.EquivalentString[file, "Gateway.image"L] THEN
file ← "NewGateway.image"L;
AppendString[scratchName, "FTP-scratch"L];
AppendDecimal[scratchName, (scratchFileNumber ← scratchFileNumber + 1)];
AppendChar[scratchName, '$];
END;
-- No Read protection
BEGIN
oldFile ← George.LookupExistingFile[file];
[fileHandle, fileType] ← jimsFilePrimitives.OpenFile[
fileSystem,
IF write AND oldFile # File.nullCapability THEN scratchName ELSE file, mode,
fileTypePlease, info];
IF write THEN
scratchFile ← George.NameToCapability[
IF oldFile = File.nullCapability THEN file ELSE scratchName, 100];
END;
AssignSlot[file, scratchName, oldFile, scratchFile, write, fileHandle];
Lock.LockDiskAndWait[file, IF write THEN write ELSE read];
IF write THEN AnnounceOp["Receiving "L, file, " from "L]
ELSE AnnounceOp["Sending "L, file, " to "L];
END;
CloseFile: PROCEDURE [
fileSystem: FileSystem, fileHandle: FileHandle, aborted: BOOLEAN] =
BEGIN
oldFile, scratchFile: File.Capability;
fileName: STRING;
trouble, rejected, write: BOOLEAN ← FALSE;
slot: Slot ← FindSlot[fileHandle];
oldFile ← slot.oldFile;
write ← slot.write;
scratchFile ← slot.scratchFile;
fileName ← slot.oldName;
IF aborted THEN scratchFile ← File.nullCapability; -- Jim deletes the file
MarkSlotClosed[slot];
jimsFilePrimitives.CloseFile[fileSystem, fileHandle, aborted];
IF ~aborted AND write THEN
BEGIN
Slosh.Check[fileName, scratchFile ! Slosh.RejectThisTrash => GOTO Rejected];
IF oldFile = File.nullCapability THEN
BEGIN -- new, don't delete the scratch file because it is the real thing
Slosh.Arrived[fileName, scratchFile];
scratchFile ← File.nullCapability;
END
ELSE
BEGIN
Slosh.Release[fileName, oldFile];
trouble ← ~CopyFile[oldFile, scratchFile];
-- Delete the scratch copy before calling Arrived to avoid having a third copy on the disk if the BootServer decides to reformat it.
George.DeleteFileFromDisk[scratchFile];
scratchFile ← File.nullCapability;
IF ~trouble THEN Slosh.Arrived[fileName, oldFile]
ELSE Slosh.Failed[fileName, oldFile]
END;
EXITS Rejected => rejected ← TRUE;
END;
IF scratchFile # File.nullCapability THEN
George.DeleteFileFromDisk[scratchFile];
Lock.UnlockDisk[fileName];
FreeSlot[slot];
BEGIN
ENABLE UNWIND => Storage.FreeString[fileName];
IF aborted AND write THEN
AnnounceOp["Trouble writing "L, fileName, " for "L];
IF rejected THEN AnnounceOp["Rejecting"L, fileName, " from "L];
IF rejected THEN FTPError[fileDataError, "New file rejected"L];
IF trouble THEN
AnnounceOp[
"Disk filled up while copying into "L, fileName, " for "L];
IF trouble THEN FTPError[noRoomForFile, "Disk filled up during copyover"L];
END;
StatsDefs.StatIncr[IF write THEN filesReceived ELSE filesSent];
Storage.FreeString[fileName];
END;
DeleteFile: PROCEDURE [fileSystem: FileSystem, file: STRING] =
BEGIN
CheckPassword["delete"L];
AnnounceOp["Deleting "L, file, " for "L];
jimsFilePrimitives.DeleteFile[
fileSystem, file !
UNWIND => AnnounceOp["Failed deleting"L, file, " for "L]];
END;
RenameFile: PROCEDURE [fileSystem: FileSystem, currentFile, newFile: STRING] =
BEGIN
CheckPassword["rename"L];
AnnounceRename[currentFile, newFile];
jimsFilePrimitives.RenameFile[
fileSystem, currentFile, newFile !
UNWIND =>
AnnounceOp["Failed renaming"L, currentFile, " for "L]];
END;
CopyFile: PROCEDURE [to, from: File.Capability] RETURNS [ok: BOOLEAN] =
BEGIN RETURN[Slosh.CopyFile[to: to, from: from] = statusStoreOk]; END;
Announce: PROCEDURE [one, two: STRING] =
BEGIN OPEN String;
text: STRING = [200];
Time.AppendCurrent[text];
AppendString[text, " "L];
AppendString[text, one];
AppendString[text, two];
AppendChar[text, '.];
LogString[text];
END;
AnnounceOp: PROCEDURE [what, file, noise: STRING ← NIL] =
BEGIN OPEN String;
text: STRING = [200];
Time.AppendCurrent[text];
AppendString[text, " "L];
AppendString[text, what];
AppendString[text, file];
AppendString[text, noise];
AppendString[text, GetUserName[]];
AppendString[text, " on "L];
AppendString[text, GetUserAddress[]];
AppendChar[text, '.];
LogString[text];
END;
AnnounceReject: PROCEDURE [what, who, where, why: STRING] =
BEGIN OPEN String;
text: STRING = [200];
Time.AppendCurrent[text];
AppendString[text, " Rejecting attempt to "L];
AppendString[text, what];
AppendString[text, " a file by "L];
AppendString[text, who];
AppendString[text, " on "L];
AppendString[text, where];
AppendString[text, " because "L];
AppendString[text, why];
AppendChar[text, '.];
LogString[text];
END;
AnnounceRename: PROCEDURE [old, new: STRING] =
BEGIN OPEN String;
text: STRING = [100];
AppendString[text, old];
AppendString[text, " to be "L];
AppendString[text, new];
AnnounceOp["Renaming "L, text, " for "L];
END;
Message: PROCEDURE [one, two, three, four: STRING ← NIL] =
BEGIN
text: STRING = [100];
String.AppendString[text, one];
IF two # NIL THEN String.AppendString[text, two];
IF three # NIL THEN String.AppendString[text, three];
IF four # NIL THEN String.AppendString[text, four];
String.AppendChar[text, '.];
LogString[text];
END;
MessageDecimal: PROCEDURE [one: STRING, two: UNSPECIFIED, three: STRING] =
BEGIN
text: STRING = [100];
String.AppendString[text, one];
String.AppendDecimal[text, two];
String.AppendString[text, three];
String.AppendChar[text, '.];
LogString[text];
END;
LogString: PROCEDURE [text: STRING] =
BEGIN IF msg # NIL THEN Put.Line[msg, text]; Put.Line[NIL, text]; END;
MakeSWs: Tool.MakeSWsProc =
BEGIN msg ← Tool.MakeMsgSW[window: window, lines: 5]; END;
ClientTransition: ToolWindow.TransitionProcType =
BEGIN IF new = inactive THEN msg ← NIL; END;
Checker: PROCEDURE [
why: Slosh.Why, fileName: STRING, file: File.Capability] =
BEGIN
parmFileName: STRING ← NIL;
IF why # arrived THEN RETURN;
IF Runtime.IsBound[Indirect.GetParmFileName] THEN
parmFileName ← Indirect.GetParmFileName[];
IF parmFileName = NIL THEN parmFileName ← "FTPServer.txt"L;
IF running AND String.EquivalentString[parmFileName, fileName] THEN
BEGIN
ForkRestarter: ENTRY PROCEDURE =
BEGIN
IF restarting THEN RETURN;
restarting ← TRUE;
AnnounceOp[
"FTPServer restarting because a new version of "L, parmFileName,
" arrived from "L];
Process.Detach[FORK Restart[]];
END;
ForkRestarter[];
END;
END;
restarting: BOOLEAN ← FALSE;
Restart: ENTRY PROCEDURE =
BEGIN
Stopper[];
restarting ← FALSE;
Starter[];
END;
Broom: PROCEDURE [why: Event.Reason] =
BEGIN
SELECT why FROM
makeImage, makeCheck, stopMesa => IF running THEN StopperLocked[];
startImage, restartCheck, continueCheck => IF running THEN Starter[];
ENDCASE => NULL;
END;
-- File cooridination things
SlotSize: TYPE = [0..2*maxServers); -- rename uses 2 at once
Slot: TYPE = POINTER TO SlotObject;
SlotObject: TYPE = RECORD [
oldName, scratchName: STRING,
oldFile, scratchFile: File.Capability,
write: BOOLEAN,
handle: UNSPECIFIED];
slots: ARRAY SlotSize OF SlotObject ← ALL[
[NIL, NIL, File.nullCapability, File.nullCapability, FALSE, NIL]];
-- An empty slot is indicated by oldName=NIL
AssignSlot: ENTRY PROCEDURE [
fileName, scratchName: STRING, oldFile, scratchFile: File.Capability,
write: BOOLEAN, fileHandle: UNSPECIFIED] =
BEGIN
slot: Slot;
FOR s: SlotSize IN SlotSize DO
IF slots[s].oldName = NIL THEN BEGIN slot ← @slots[s]; EXIT; END;
REPEAT FINISHED => ERROR;
ENDLOOP;
slot↑ ←
[Storage.CopyString[fileName], Storage.CopyString[scratchName], oldFile,
scratchFile, write, fileHandle];
END;
FindSlot: ENTRY PROCEDURE [fileHandle: UNSPECIFIED]
RETURNS [slot: Slot] =
BEGIN
FOR s: SlotSize IN SlotSize DO
IF slots[s].handle = fileHandle THEN RETURN[@slots[s]];
REPEAT FINISHED => ERROR;
ENDLOOP;
END;
-- This is atomic so it doesn't need to be an ENTRY
MarkSlotClosed: PROCEDURE [slot: Slot] = INLINE BEGIN slot.handle ← NIL; END;
FreeSlot: ENTRY PROCEDURE [slot: Slot] =
BEGIN
-- Caller must free oldName
Storage.FreeString[slot.scratchName];
slot.oldName ← NIL;
END;
-- Initialization
tool ← Tool.Create[
name: herald, makeSWsProc: MakeSWs, clientTransition: ClientTransition];
Event.AddNotifier[@eventItem];
Slosh.AddProcs[Checker];
FTPServerOn[];
END.