-- file: FTPServerMail.mesa
-- Edited by: HGM July 28, 1980 9:13 PM
-- Copyright Xerox Corporation 1979, 1980
DIRECTORY
FTPDefs,
FTPPrivateDefs,
String USING [AppendChar, AppendDecimal, AppendLongNumber],
Storage USING [Node, Free, FreeString];
FTPServerMail: PROGRAM
-- import list
IMPORTS String, Storage, FTPDefs, FTPPrivateDefs
-- export list
EXPORTS FTPPrivateDefs
-- share list
SHARES FTPDefs, FTPPrivateDefs =
BEGIN OPEN FTPDefs, FTPPrivateDefs;
-- **********************! Constants !***********************
ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];
-- **********************! Module Presence Test Procedure !***********************
ServerMailLoaded: PUBLIC PROCEDURE =
BEGIN
-- report in
ftpsystem.serverMailLoaded ← TRUE;
END;
-- **********************! Mail Commands !***********************
PTFStoreMail: PUBLIC PROCEDURE [ftpserver: FTPServer] =
BEGIN OPEN ftpserver, ftpserver.ftplistener;
-- PutMailboxException procedure
PutMailboxException: PROCEDURE [
number: CARDINAL, recipientError: RecipientError] =
BEGIN
-- local constants
message: STRING = [maxStringLength];
-- construct error message
String.AppendDecimal[message, number];
String.AppendChar[message, mailboxExceptionIndexTerminator];
IF ftpsystem.accessoriesLoaded THEN
VerbalizeRecipientError[recipientError, message];
-- send mailbox exception command
PutCommand[
ftper, markMailboxException, RecipientErrorToExceptionCode[
recipientError]];
-- send error message
PutString[ftper, message];
END;
-- local variables
headLocalMailbox, headRemoteMailbox: Mailbox ← NIL;
mailbox: Mailbox;
number: CARDINAL ← 0;
atLeastOneValidRecipient: BOOLEAN ← FALSE;
-- intercept errors
BEGIN
ENABLE
UNWIND =>
BEGIN
DequeueMailboxes[@headLocalMailbox];
DequeueMailboxes[@headRemoteMailbox];
END;
-- receive distribution list and EOC
DO
-- receive property list
GetPropertyList[
ftper, propertyList !
FTPError => IF ftpError = protocolParameterListMissing THEN EXIT];
-- enqueue local/remote mailbox
EnqueueMailbox[@headLocalMailbox, propertyList, number ← number + 1];
ENDLOOP;
GetEOC[ftper];
-- reject unsupported forwarding requests
IF headRemoteMailbox # NIL THEN
IF forwardingProvided THEN atLeastOneValidRecipient ← TRUE
ELSE
FOR mailbox ← headRemoteMailbox, mailbox.nextMailbox UNTIL mailbox = NIL
DO PutMailboxException[mailbox.number, noForwardingProvided]; ENDLOOP;
-- reject undefined local mailboxes
IF headLocalMailbox # NIL THEN
BEGIN
-- locate mailboxes
mailPrimitives.LocateMailboxes[mailSystem, headLocalMailbox];
-- issue necessary mailbox exceptions
FOR mailbox ← headLocalMailbox, mailbox.nextMailbox UNTIL mailbox = NIL DO
IF mailbox.located THEN atLeastOneValidRecipient ← TRUE
ELSE PutMailboxException[mailbox.number, noSuchMailbox];
ENDLOOP;
END;
-- send preliminary approval of distribution list
IF atLeastOneValidRecipient THEN PutCommandAndEOC[ftper, markYes, 0]
ELSE Abort[noValidRecipients];
-- stage message text
GetSpecificCommand[ftper, markHereIsFile];
mailPrimitives.StageMessage[mailSystem, ReceiveBlock, ftper];
GetYesAndEOC[ftper];
-- deliver message to local mailboxes
IF headLocalMailbox # NIL THEN
BEGIN
-- deliver message
mailPrimitives.DeliverMessage[mailSystem, headLocalMailbox];
-- issue necessary mailbox exceptions
FOR mailbox ← headLocalMailbox, mailbox.nextMailbox UNTIL mailbox = NIL DO
IF mailbox.located AND ~mailbox.delivered THEN
PutMailboxException[mailbox.number, unspecifiedError];
ENDLOOP;
END;
-- forward message to remote mailboxes
IF headRemoteMailbox # NIL THEN
BEGIN
-- forward message
mailPrimitives.ForwardMessage[mailSystem, headRemoteMailbox];
-- issue necessary mailbox exceptions
FOR mailbox ← headRemoteMailbox, mailbox.nextMailbox UNTIL mailbox = NIL DO
IF ~mailbox.delivered THEN
PutMailboxException[mailbox.number, unspecifiedError];
ENDLOOP;
END;
-- send Yes and EOC
PutCommandAndEOC[ftper, markYes, 0];
-- dequeue distribution list
DequeueMailboxes[@headLocalMailbox];
DequeueMailboxes[@headRemoteMailbox];
END; -- enable
END;
PTFRetrieveMail: PUBLIC PROCEDURE [ftpserver: FTPServer] =
BEGIN OPEN ftpserver, ftpserver.ftplistener;
-- NextMessage procedure
NextMessage: PROCEDURE [messageInfo: MessageInfo] =
BEGIN OPEN messageInfo;
-- next message
IF byteCount # 0 THEN
BEGIN
-- send message information
PutCommand[ftper, markHereIsPropertyList, 0];
PutMessageInfo[messageInfo];
-- signal transmission of text
PutCommand[ftper, markHereIsFile, 0];
END
-- no more messages
ELSE
BEGIN
-- send Yes and EOC
PutCommandAndEOC[ftper, markYes, 0];
-- receive OK to flush mailbox
GetSpecificCommand[ftper, markFlushMailbox];
GetEOC[ftper];
END;
END;
-- PutMessageInfo procedure
PutMessageInfo: PROCEDURE [messageInfo: MessageInfo] =
BEGIN OPEN messageInfo;
-- local constants
messageLength: STRING = [maxStringLength];
boolean: STRING = [maxStringLength];
-- reset property list
ResetPropertyList[propertyList];
-- encode byte count
String.AppendLongNumber[messageLength, byteCount, 10];
WriteProperty[propertyList, length, messageLength];
-- encode delivery date
WriteProperty[propertyList, dateReceived, deliveryDate];
-- encode opened and deleted
EncodeBooleanProperty[opened, boolean];
WriteProperty[propertyList, opened, boolean];
EncodeBooleanProperty[deleted, boolean];
WriteProperty[propertyList, deleted, boolean];
-- send property list
PutPropertyList[ftper, propertyList];
END;
-- local variables
mailbox: Mailbox ← NIL;
-- receive property list and EOC
GetPropertyList[ftper, propertyList];
GetEOC[ftper];
-- inspect credentials
IF propertyList[userName] # NIL THEN
mailPrimitives.InspectCredentials[
mailSystem, primary, propertyList[userName], propertyList[userPassword]];
IF propertyList[connectName] # NIL THEN
mailPrimitives.InspectCredentials[
mailSystem, secondary, propertyList[connectName], propertyList[
connectPassword]];
-- enqueue mailbox
EnqueueMailbox[@mailbox, propertyList, 1];
BEGIN
ENABLE UNWIND => DequeueMailboxes[@mailbox];
-- locate local mailbox
mailPrimitives.LocateMailboxes[mailSystem, mailbox];
IF ~mailbox.located THEN Abort[noSuchMailbox];
-- retrieve messages
mailPrimitives.RetrieveMessages[
mailSystem, mailbox, NextMessage, SendBlock, ftper];
PutCommandAndEOC[ftper, markYes, 0];
-- dequeue mailbox
END; -- enable
DequeueMailboxes[@mailbox];
END;
-- **********************! Mailbox Primitives !***********************
EnqueueMailbox: PROCEDURE [
headMailbox: POINTER TO Mailbox, propertyList: PropertyList,
number: CARDINAL] =
BEGIN
-- Note: Assumes nextMailbox=NIL; updates headMailbox↑ if NIL.
-- local variables
mailbox, tailMailbox: Mailbox;
-- create mailbox
mailbox ← CreateMailbox[propertyList, number];
-- queue is empty: make mailbox the head
IF headMailbox↑ = NIL THEN headMailbox↑ ← mailbox
-- queue is not empty: append mailbox to it
ELSE
BEGIN
FOR tailMailbox ← headMailbox↑, tailMailbox.nextMailbox UNTIL
tailMailbox.nextMailbox = NIL DO ENDLOOP;
tailMailbox.nextMailbox ← mailbox;
END;
END;
DequeueMailboxes: PROCEDURE [headMailbox: POINTER TO Mailbox] =
BEGIN
-- Note: Resets headMailbox↑ to NIL.
-- local variables
mailbox, nextMailbox: Mailbox;
-- destroy each mailbox
FOR mailbox ← headMailbox↑, nextMailbox UNTIL mailbox = NIL DO
nextMailbox ← mailbox.nextMailbox; DestroyMailbox[mailbox]; ENDLOOP;
-- reset queue
headMailbox↑ ← NIL;
END;
CreateMailbox: PROCEDURE [propertyList: PropertyList, number: CARDINAL]
RETURNS [mailbox: Mailbox] =
BEGIN
-- Note: Initializes nextMailbox to NIL;
-- removes mailbox property from property list.
-- allocate and initialize mailbox object
mailbox ← Storage.Node[SIZE[MailboxObject]];
mailbox↑ ← MailboxObject[
number: number, mailbox: propertyList[mailbox], location: NIL,
located: FALSE, delivered: FALSE, nextMailbox: NIL];
-- remove mailbox, host, and dms name from property list
-- Note: WriteProperty was circumvented above.
propertyList[mailbox] ← NIL;
END;
DestroyMailbox: PROCEDURE [mailbox: Mailbox] =
BEGIN
-- release mailbox if any
IF mailbox.mailbox # NIL THEN Storage.FreeString[mailbox.mailbox];
-- release location if any
IF mailbox.location # NIL THEN Storage.FreeString[mailbox.location];
-- release mailbox object
Storage.Free[mailbox];
END;
-- **********************! Main Program !***********************
-- no operation
END. -- of FTPServerMail