-- file: FTPServerMail.mesa
-- Edited by Mark Johnson: 19-May-81 13:24:24
-- Edited by Andrew Birrell: 18-Jan-82 10:25:37
-- Edited by: HGM March 6, 1979 4:05 PM
-- Edited by: JEW October 31, 1978 3:28 PM
DIRECTORY
BodyDefs USING[ maxRNameLength ],
FTPDefs: FROM "FTPDefs",
FTPPrivateDefs: FROM "FTPPrivateDefs",
SendDefs USING[ AddRecipient, AddToItem, Create, Destroy,
CheckValidity, Handle, Send, SendFromClient,
StartSendInfo, StartText ],
String USING [AppendChar, AppendDecimal, AppendLongNumber],
Storage USING [Node, Free, FreeString];
FTPServerMail: PROGRAM
-- import list
IMPORTS SendDefs, 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
sender: STRING;
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;
EarlyAbort: PROC[why: SendDefs.StartSendInfo] =
BEGIN
DO GetPropertyList[ftper, propertyList ! FTPError =>
IF ftpError = protocolParameterListMissing THEN EXIT];
ENDLOOP;
SELECT why FROM
badPwd =>
AbortWithExplanation[unidentifiedPermanentError,
"Incorrect sender password"L];
badSender, badReturnTo =>
AbortWithExplanation[unidentifiedPermanentError,
SELECT TRUE FROM
sender = NIL => "Sender name missing"L,
sender.length > BodyDefs.maxRNameLength =>
"Sender name too long"L,
ENDCASE => "Sender name not valid"L];
ENDCASE => ERROR -- allDown, ok --;
END;
-- local variables
gvHandle: SendDefs.Handle = SendDefs.Create[];
-- intercept errors
BEGIN ENABLE UNWIND => SendDefs.Destroy[gvHandle];
-- start message; first property list must have sender --
recipients: CARDINAL ← 0;
-- BEWARE: assumes representation of MailSystemObject --
mailInfo: POINTER TO RECORD[ net, host: [0..256)] = LOOPHOLE[mailSystem];
GetPropertyList[ftper, propertyList]; --must be present--
sender ← propertyList[sender];
IF sender = NIL THEN EarlyAbort[badSender];
IF sender.length > BodyDefs.maxRNameLength THEN EarlyAbort[badSender];
BEGIN
sendInfo: SendDefs.StartSendInfo =
SendDefs.SendFromClient[handle: gvHandle,
fromNet:mailInfo.net, fromHost:mailInfo.host,
senderKey: [0,0,0,0],
sender: sender, returnTo: sender,
validate: TRUE];
IF sendInfo # ok THEN EarlyAbort[sendInfo];
END;
-- receive distribution list and EOC
DO
-- enqueue for recipient
SendDefs.AddRecipient[gvHandle, propertyList[mailbox]];
recipients ← recipients + 1;
-- receive next property list
GetPropertyList[ftper, propertyList ! FTPError =>
IF ftpError = protocolParameterListMissing THEN EXIT];
ENDLOOP;
GetEOC[ftper];
-- reject undefined recipients
BEGIN
Notify: PROCEDURE[number: CARDINAL, recipient: STRING] =
BEGIN
recipients ← recipients - 1;
PutMailboxException[number, noSuchMailbox];
END;
[] ← SendDefs.CheckValidity[gvHandle, Notify];
END;
-- send preliminary approval of distribution list
IF recipients # 0 THEN PutCommandAndEOC[ftper, markYes, 0]
ELSE Abort[noValidRecipients];
-- accept message text
GetSpecificCommand[ftper, markHereIsFile];
StageMessage[gvHandle, ReceiveBlock, ftper];
GetYesAndEOC[ftper];
-- deliver message
SendDefs.Send[gvHandle];
-- send Yes and EOC
PutCommandAndEOC[ftper, markYes, 0];
-- tidy up
SendDefs.Destroy[gvHandle];
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
mailbox ← CreateMailbox[propertyList, 1];
BEGIN ENABLE UNWIND => DestroyMailbox[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];
-- destroy mailbox
END; -- enable
DestroyMailbox[mailbox];
END;
-- **********************! Mailbox Primitives !***********************
StageMessage: PROCEDURE[ gvHandle: SendDefs.Handle,
receiveBlock: PROCEDURE[UNSPECIFIED,POINTER,CARDINAL]RETURNS[CARDINAL],
receiveBlockData: UNSPECIFIED ] =
BEGIN
length: CARDINAL = 65;
prevOdd: BOOLEAN ← FALSE;
buffer: POINTER = Storage.Node[length];
SendDefs.StartText[gvHandle];
DO BEGIN
ENABLE UNWIND => Storage.Free[buffer];
count: CARDINAL = receiveBlock[receiveBlockData,buffer,length];
IF count = 0 THEN EXIT;
IF prevOdd
THEN ERROR FTPDefs.FTPError[requestedAccessDenied,
"Odd-byte block boundary not implemented"L];
SendDefs.AddToItem[gvHandle, DESCRIPTOR[buffer, count] ];
IF count MOD 2 # 0 THEN prevOdd ← TRUE;
END;
ENDLOOP;
Storage.Free[buffer];
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