-- FTPSysMail.mesa, Edit: HGM July 28, 1980 10:32 PM
-- Copyright Xerox Corporation 1979, 1980
DIRECTORY
FTPDefs,
FTPPrivateDefs,
Ascii USING [CR],
Inline USING [LowHalf],
String USING [
AppendChar, AppendLongNumber, EquivalentString, StringToLongNumber],
Storage USING [Node, Free, CopyString],
Time USING [AppendCurrent];
FTPSysMail: PROGRAM
IMPORTS Inline, String, Storage, Time, FTPDefs, FTPPrivateDefs
EXPORTS FTPDefs
SHARES FTPDefs, FTPPrivateDefs =
BEGIN OPEN FTPDefs, FTPPrivateDefs;
-- **********************! Types !***********************
-- mail system state information
SysMailSystem: TYPE = POINTER TO SysMailSystemObject;
SysMailSystemObject: TYPE = RECORD [
filePrimitives: FilePrimitives,
fileSystem: FileSystem,
directoryFileHandle, stagingFileHandle: FileHandle,
messageLength: LONG INTEGER];
-- **********************! Constants !***********************
mailboxTerminator: CHARACTER = '@;
fileTerminator: CHARACTER = Ascii.CR;
dateAndTimeTerminator: CHARACTER = ';;
messageLengthTerminator: CHARACTER = Ascii.CR;
ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];
mailPrimitivesObject: MailPrimitivesObject ←
[CreateMailSystem: CreateMailSystem, DestroyMailSystem: DestroyMailSystem,
InspectCredentials: InspectCredentials, LocateMailboxes: LocateMailboxes,
StageMessage: StageMessage, DeliverMessage: DeliverMessage,
ForwardMessage: ForwardMessage, RetrieveMessages: RetrieveMessages];
-- **********************! Variables !***********************
useCount: CARDINAL ← 0;
mailboxQueueObject: QueueObject;
-- **********************! Mail Foothold Procedure !***********************
-- Note: This mail system is constructed atop the client's file system.
-- Besides a scratch file in which the text of incoming messages is staged,
-- and a semi-permanent mailbox file for each legal mail recipient,
-- the following prefabricated, permanent file giving mailbox->filename correspondences
-- is employed: FTPSysMail-Directory.Bravo
SysMailPrimitives, SomeMailPrimitives: PUBLIC PROCEDURE
RETURNS [mailPrimitives: MailPrimitives] =
BEGIN
-- return mail primitives
mailPrimitives ← @mailPrimitivesObject;
END;
-- **********************! Mail Primitives !***********************
CreateMailSystem: PROCEDURE [
filePrimitives: FilePrimitives, bufferSize: CARDINAL]
RETURNS [mailSystem: MailSystem, forwardingProvided: BOOLEAN] =
BEGIN
-- Note: bufferSize expressed in pages; zero implies default.
-- local constants
stagingFile: STRING = [maxStringLength];
-- local variables
sysMailSystem: SysMailSystem;
-- verify presence of file primitives
IF filePrimitives = NIL THEN Abort[filePrimitivesNotSpecified];
-- allocate and initialize mail system object
sysMailSystem ← Storage.Node[SIZE[SysMailSystemObject]];
sysMailSystem↑ ← SysMailSystemObject[
filePrimitives: filePrimitives, fileSystem: NIL, directoryFileHandle: NIL,
stagingFileHandle: NIL, messageLength:];
mailSystem ← LOOPHOLE[sysMailSystem];
-- initialize mailbox queue
IF (useCount ← useCount + 1) = 1 THEN
InitializeQueue[@mailboxQueueObject, String.EquivalentString];
-- create file system
BEGIN OPEN sysMailSystem;
ENABLE UNWIND => DestroyMailSystem[mailSystem];
fileSystem ← filePrimitives.CreateFileSystem[bufferSize];
-- open mailbox directory file for read
[directoryFileHandle, ] ← filePrimitives.OpenFile[
fileSystem, "FTPSysMail-Directory.Bravo"L, read, FALSE, NIL];
-- open staging file for writeThenRead
-- Note: stagingFile.length=0, requesting creation of scratch file.
[stagingFileHandle, ] ← filePrimitives.OpenFile[
fileSystem, stagingFile, writeThenRead, FALSE, NIL];
-- decline to forward messages
forwardingProvided ← FALSE;
END; -- enable
END;
DestroyMailSystem: PROCEDURE [mailSystem: MailSystem] =
BEGIN
-- local constants
sysMailSystem: SysMailSystem = LOOPHOLE[mailSystem];
-- close staging file
-- Note: aborted=TRUE, requesting deletion of scratch file.
BEGIN OPEN sysMailSystem;
IF stagingFileHandle # NIL THEN
filePrimitives.CloseFile[fileSystem, stagingFileHandle, TRUE];
-- close mailbox directory file
IF directoryFileHandle # NIL THEN
filePrimitives.CloseFile[fileSystem, directoryFileHandle, FALSE];
-- destroy file system
IF fileSystem # NIL THEN filePrimitives.DestroyFileSystem[fileSystem];
-- finalize mailbox queue
IF (useCount ← useCount - 1) = 0 THEN FinalizeQueue[@mailboxQueueObject];
-- release mail system object
Storage.Free[sysMailSystem];
END; -- open
END;
InspectCredentials: PROCEDURE [
mailSystem: MailSystem, status: Status, user, password: STRING] =
BEGIN
-- no operation
END;
LocateMailboxes: PROCEDURE [mailSystem: MailSystem, localMailboxList: Mailbox] =
BEGIN
-- Note: Skips mailboxes showing located=TRUE; allocates location from the heap.
-- EnumerateMailboxes appendage
NoteMailbox: PROCEDURE [definedMailbox, file: STRING] =
BEGIN
-- search mailbox list for defined mailbox
FOR localMailboxList ← localMailboxListHead, localMailboxList.nextMailbox
UNTIL localMailboxList = NIL DO
OPEN localMailboxList;
IF ~located AND String.EquivalentString[mailbox, definedMailbox] THEN
BEGIN
location ← Storage.CopyString[file];
located ← String.EquivalentString[mailbox, definedMailbox];
END;
ENDLOOP;
END;
-- local constants
sysMailSystem: SysMailSystem = LOOPHOLE[mailSystem];
localMailboxListHead: Mailbox = localMailboxList;
-- enumerate defined mailboxes
EnumerateMailboxes[sysMailSystem, NoteMailbox];
END;
StageMessage: PROCEDURE [
mailSystem: MailSystem,
receiveBlock: PROCEDURE [UNSPECIFIED, POINTER, CARDINAL] RETURNS [CARDINAL],
receiveBlockData: UNSPECIFIED] =
BEGIN
-- Note: Records messageLength.
-- ReceiveBlock procedure
ReceiveBlock: PROCEDURE [
unused: UNSPECIFIED, destination: POINTER, maxWordCount: CARDINAL]
RETURNS [actualByteCount: CARDINAL] =
BEGIN OPEN sysMailSystem;
-- receive block
actualByteCount ← receiveBlock[receiveBlockData, destination, maxWordCount];
-- increment message length
messageLength ← messageLength + actualByteCount;
END;
-- local constants
sysMailSystem: SysMailSystem = LOOPHOLE[mailSystem];
-- stage message
BEGIN OPEN sysMailSystem;
messageLength ← 0;
filePrimitives.WriteFile[fileSystem, stagingFileHandle, ReceiveBlock, NIL];
END; -- open
END;
DeliverMessage: PROCEDURE [mailSystem: MailSystem, localMailboxList: Mailbox] =
BEGIN
-- Note: Assumes message text staged;
-- skips mailboxes showing located=FALSE or delivered=TRUE;
-- suppresses errors raised in individual delivery attempts.
-- local constants
sysMailSystem: SysMailSystem = LOOPHOLE[mailSystem];
localMailboxListHead: Mailbox = localMailboxList;
textualDateAndTime: STRING = [maxStringLength];
textualMessageLength: STRING = [maxStringLength];
-- note date and time and message length
BEGIN OPEN sysMailSystem;
Time.AppendCurrent[textualDateAndTime];
String.AppendLongNumber[textualMessageLength, messageLength, 10];
-- deliver message
FOR localMailboxList ← localMailboxListHead, localMailboxList.nextMailbox
UNTIL localMailboxList = NIL DO
OPEN localMailboxList;
IF located AND ~delivered THEN
BEGIN
ENABLE FTPError => CONTINUE;
DeliverMessageToMailbox[
sysMailSystem, textualDateAndTime, textualMessageLength, location];
delivered ← TRUE;
END;
ENDLOOP;
END; -- open
END;
ForwardMessage: PROCEDURE [mailSystem: MailSystem, remoteMailboxList: Mailbox] =
BEGIN
-- Note: Assumes message text staged;
-- skips mailboxes showing delivered=TRUE;
-- suppresses errors raised in individual forwarding attempts.
-- not implemented
END;
RetrieveMessages: PROCEDURE [
mailSystem: MailSystem, localMailbox: Mailbox,
processMessage: PROCEDURE [MessageInfo],
sendBlock: PROCEDURE [UNSPECIFIED, POINTER, CARDINAL],
sendBlockData: UNSPECIFIED] =
BEGIN OPEN localMailbox;
-- Note: Assumes localMailbox is of length 1 showing located=TRUE;
-- invocation of processMessage with byteCount=0 signifies end of file and
-- precedes flushing of mailbox; assumes date and time and message lengths
-- are free of the delimiters:
-- dateAndTimeTerminator and messageLengthTerminator.
-- ReadMessages procedure
ReadMessages: PROCEDURE =
BEGIN OPEN sysMailSystem;
-- SendBlock procedure
SendBlock: PROCEDURE [
unused: UNSPECIFIED, source: POINTER, byteCount: CARDINAL] =
BEGIN
-- local variables
bytePointerObject: BytePointerObject ← [source, FALSE, byteCount];
character: CHARACTER;
wordObject: WordObject;
-- check for premature end-of-file
IF byteCount = 0 AND
(string # textualDateAndTime OR string.length # 0 OR
messageInfoObject.byteCount # 0) THEN Abort[unexpectedEndOfFile];
-- consume source data
UNTIL bytePointerObject.count = 0 DO
SELECT TRUE FROM
(messageInfoObject.byteCount = 0) =>
SELECT character ← LOOPHOLE[LoadByte[@bytePointerObject]] FROM
dateAndTimeTerminator => string ← textualMessageLength;
messageLengthTerminator =>
BEGIN
messageInfoObject.byteCount ← String.StringToLongNumber[
textualMessageLength, 10];
processMessage[@messageInfoObject];
textualDateAndTime.length ← textualMessageLength.length ← 0;
string ← textualDateAndTime;
END;
ENDCASE => String.AppendChar[string, character];
(messageInfoObject.byteCount > 0 AND bytePointerObject.offset) =>
BEGIN
wordObject.lhByte ← LoadByte[@bytePointerObject];
sendBlock[sendBlockData, @wordObject, 1];
messageInfoObject.byteCount ← messageInfoObject.byteCount - 1;
END;
ENDCASE =>
BEGIN
byteCount ← MIN[
bytePointerObject.count,
IF messageInfoObject.byteCount > LAST[CARDINAL] THEN LAST[
CARDINAL] ELSE Inline.LowHalf[messageInfoObject.byteCount]];
sendBlock[sendBlockData, bytePointerObject.address, byteCount];
AdvanceBytePointer[@bytePointerObject, byteCount];
messageInfoObject.byteCount ←
messageInfoObject.byteCount - byteCount;
END;
ENDLOOP;
END;
-- local constants
textualDateAndTime: STRING = [maxStringLength];
textualMessageLength: STRING = [maxStringLength];
-- local variables
fileHandle: FileHandle ← NIL;
string: STRING ← textualDateAndTime;
messageInfoObject: MessageInfoObject ←
[byteCount: 0, deliveryDate: textualDateAndTime, opened: FALSE,
deleted: FALSE];
-- open mailbox file for readThenWrite
[fileHandle, ] ← filePrimitives.OpenFile[
fileSystem, location, readThenWrite, FALSE, NIL !
FTPError => IF ftpError = noSuchFile THEN CONTINUE];
IF fileHandle = NIL THEN
BEGIN processMessage[@messageInfoObject]; RETURN; END;
BEGIN
ENABLE UNWIND => filePrimitives.CloseFile[fileSystem, fileHandle, FALSE];
-- read messages: date and time, message length, and text
filePrimitives.ReadFile[fileSystem, fileHandle, SendBlock, NIL];
-- signal end of file
processMessage[@messageInfoObject];
-- close mailbox file
-- Note: aborted=TRUE, requesting deletion of file.
END; -- enable
filePrimitives.CloseFile[fileSystem, fileHandle, TRUE];
END;
-- local constants
sysMailSystem: SysMailSystem = LOOPHOLE[mailSystem];
-- retrieve messages
ManipulateMailbox[location, ReadMessages];
END;
-- **********************! Mailbox Primitives !***********************
EnumerateMailboxes: PROCEDURE [
sysMailSystem: SysMailSystem, processMailbox: PROCEDURE [STRING, STRING]] =
BEGIN OPEN sysMailSystem;
-- Note: Assumes mailbox names and filenames are free of the delimiters:
-- mailboxTerminator and fileTerminator.
-- SendBlock procedure
SendBlock: PROCEDURE [
unused: UNSPECIFIED, source: POINTER, byteCount: CARDINAL] =
BEGIN
-- local variables
bytePointerObject: BytePointerObject ← [source, FALSE, byteCount];
character: CHARACTER;
-- check for premature end of file
IF byteCount = 0 AND (string = file OR string.length # 0) THEN
Abort[unexpectedEndOfFile];
-- consume source data
UNTIL bytePointerObject.count = 0 DO
SELECT character ← LOOPHOLE[LoadByte[@bytePointerObject]] FROM
mailboxTerminator => string ← file;
fileTerminator =>
BEGIN
processMailbox[mailbox, file];
mailbox.length ← file.length ← 0;
string ← mailbox;
END;
ENDCASE => String.AppendChar[string, character];
ENDLOOP;
END;
-- local constants
mailbox: STRING = [maxStringLength];
file: STRING = [maxStringLength];
-- local variables
string: STRING ← mailbox;
-- enumerate mailboxes
filePrimitives.ReadFile[fileSystem, directoryFileHandle, SendBlock, NIL];
END;
DeliverMessageToMailbox: PROCEDURE [
sysMailSystem: SysMailSystem,
textualDateAndTime, textualMessageLength, file: STRING] =
BEGIN OPEN sysMailSystem;
-- Note: Assumes text of message in staging file;
-- assumes date and time and message length are free of the delimiters:
-- dateAndTimeTerminator and messageLengthTerminator.
-- WriteMessage procedure
WriteMessage: PROCEDURE =
BEGIN
-- ReceiveBlock Procedure
ReceiveBlock: PROCEDURE [
unused: UNSPECIFIED, destination: POINTER, maxWordCount: CARDINAL]
RETURNS [actualByteCount: CARDINAL] =
BEGIN
-- local variables
bytePointerObject: BytePointerObject ←
[destination, FALSE, bytesPerWord*maxWordCount];
character: CHARACTER;
-- produce destination data
UNTIL bytePointerObject.count = 0 OR endOfHeader DO
SELECT TRUE FROM
(index < string.length) =>
BEGIN character ← string[index]; index ← index + 1; END;
(string = textualDateAndTime) =>
BEGIN
character ← dateAndTimeTerminator;
string ← textualMessageLength;
index ← 0;
END;
ENDCASE =>
BEGIN character ← messageLengthTerminator; endOfHeader ← TRUE; END;
StoreByte[@bytePointerObject, LOOPHOLE[character]];
ENDLOOP;
-- compute actual byte count for caller
actualByteCount ← bytesPerWord*maxWordCount - bytePointerObject.count;
END;
-- local variables
fileHandle: FileHandle;
string: STRING ← textualDateAndTime;
index: CARDINAL ← 0;
endOfHeader: BOOLEAN ← FALSE;
-- open file for append
[fileHandle, ] ← filePrimitives.OpenFile[
fileSystem, file, append, FALSE, NIL];
BEGIN
ENABLE UNWIND => filePrimitives.CloseFile[fileSystem, fileHandle, TRUE];
-- write message: date and time, message length, and text
filePrimitives.WriteFile[fileSystem, fileHandle, ReceiveBlock, NIL];
ForkTransferPair[
fileSystem, filePrimitives.ReadFile, stagingFileHandle,
filePrimitives.WriteFile, fileHandle];
-- close file
END; -- enable
filePrimitives.CloseFile[fileSystem, fileHandle, FALSE];
END;
-- deliver message to mailbox
ManipulateMailbox[file, WriteMessage];
END;
ManipulateMailbox: PROCEDURE [file: STRING, procedure: PROCEDURE] =
BEGIN
-- local variables
mailboxQueueElement: Element ← NIL;
-- enqueue mailbox element
mailboxQueueElement ← EnQueue[@mailboxQueueObject, NIL, file];
BEGIN
ENABLE
UNWIND =>
BEGIN
IF mailboxQueueElement.locked THEN
UnlockQueue[@mailboxQueueObject, mailboxQueueElement];
IF mailboxQueueElement # NIL THEN
DeQueue[@mailboxQueueObject, mailboxQueueElement];
END;
-- lock file
LockQueue[@mailboxQueueObject, mailboxQueueElement, TRUE];
-- dispatch caller
procedure[];
-- unlock file
UnlockQueue[@mailboxQueueObject, mailboxQueueElement];
-- dequeue mailbox element
END; -- enable
DeQueue[@mailboxQueueObject, mailboxQueueElement];
END;
StoreByte: PUBLIC PROCEDURE [dstBytePointer: BytePointer, byte: Byte] =
BEGIN
-- Note: Doesn't check for byte pointer exhaustion.
-- local constants
dBP: BytePointer = dstBytePointer;
dWord: Word = dBP.address;
-- store byte
IF dBP.offset THEN dWord.rhByte ← byte ELSE dWord.lhByte ← byte;
-- advance address and offset
IF ~(dBP.offset ← ~dBP.offset) THEN dBP.address ← dBP.address + 1;
-- decrement byte count
dBP.count ← dBP.count - 1;
END;
LoadByte: PUBLIC PROCEDURE [srcBytePointer: BytePointer] RETURNS [byte: Byte] =
BEGIN
-- Note: Doesn't check for byte pointer exhaustion.
-- local constants
sBP: BytePointer = srcBytePointer;
sWord: Word = sBP.address;
-- load byte
byte ← IF sBP.offset THEN sWord.rhByte ELSE sWord.lhByte;
-- advance address and offset
IF ~(sBP.offset ← ~sBP.offset) THEN sBP.address ← sBP.address + 1;
-- decrement byte count
sBP.count ← sBP.count - 1;
END;
-- **********************! Main Program !***********************
-- no operation
END. -- of FTPSysMail