-- Copyright (C) 1981, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.
-- CreateMail.mesa, HGM, 15-Sep-85 7:40:54
-- Transport Mechanism Mail Server - Create mail from user --
-- Randy Gobbel 19-May-81 21:21:39 --
-- Andrew Birrell 1-Apr-81 14:54:01 --
-- Mike Schroeder 25-Jan-83 16:18:46 --
DIRECTORY
BodyDefs USING [
ItemHeader, ItemLength, ItemType, maxRNameLength, Password, RName, RNameSize,
Timestamp],
Heap USING [systemZone],
HeapDefs USING [
GetWriterOffset, HeapAbandonWrite, HeapEndRead, HeapEndWrite, HeapReadData,
HeapReadRName, HeapStartRead, HeapStartWrite, HeapWriteData, HeapWriteRName,
ObjectNumber, ObjectOffset, ReaderHandle, ReadRList, SetWriterOffset,
WriterHandle],
LogDefs USING [WriteChar, WriteLogEntry],
NameInfoDefs USING [Close, Enumerate, IsMemberDirect],
ProtocolDefs USING [AppendTimestamp, MakeKey],
PupDefs USING [PupAddress, PupNameLookup, PupPackageMake],
SendDefs USING [ExpandInfo, StartSendInfo],
SiteCacheDefs USING [FindMBXSite, RecipientInfo, ValidateRName],
SLDefs USING [SLHeader, SLWrite],
String USING [AppendDecimal, AppendLongDecimal, AppendString],
Time USING [Current];
CreateMail: MONITOR LOCKS handle USING handle: Handle
IMPORTS
BodyDefs, Heap, HeapDefs, LogDefs, NameInfoDefs, PupDefs, ProtocolDefs,
SiteCacheDefs, SLDefs, String, Time
EXPORTS SendDefs =
BEGIN
RNameFromString: PROCEDURE [s: LONG STRING] RETURNS [BOOLEAN] =
BEGIN RETURN[IF s.length > BodyDefs.maxRNameLength THEN FALSE ELSE TRUE] END;
LogStart: PROCEDURE [handle: Handle, sender: LONG STRING] =
BEGIN
log: LONG STRING ← Heap.systemZone.NEW[StringBody[128]];
String.AppendString[log, "Created "L];
ProtocolDefs.AppendTimestamp[log, handle.stamp];
String.AppendString[log, ": sender "L];
String.AppendString[log, sender];
LogDefs.WriteLogEntry[log];
Heap.systemZone.FREE[@log];
END;
LogCommit: PROCEDURE [handle: Handle] =
BEGIN
log: LONG STRING ← Heap.systemZone.NEW[StringBody[128]];
String.AppendString[log, "Client input: "L];
ProtocolDefs.AppendTimestamp[log, handle.stamp];
String.AppendString[log, ", "L];
String.AppendDecimal[log, handle.validRecipients];
String.AppendString[log, " recipients, "L];
String.AppendLongDecimal[log, HeapDefs.GetWriterOffset[handle.body]];
String.AppendString[log, " words"L];
IF handle.express THEN String.AppendString[log, ", express"L];
LogDefs.WriteLogEntry[log];
Heap.systemZone.FREE[@log];
LogDefs.WriteChar[IF handle.express THEN 'E ELSE 'C];
END;
LogAbort: PROCEDURE [handle: Handle] =
BEGIN
log: LONG STRING ← Heap.systemZone.NEW[StringBody[128]];
String.AppendString[log, "Abandoned "L];
ProtocolDefs.AppendTimestamp[log, handle.stamp];
LogDefs.WriteLogEntry[log];
Heap.systemZone.FREE[@log];
END;
Handle: PUBLIC TYPE = LONG POINTER TO HandleObject;
HandleObject: TYPE = MONITORED RECORD [
body, SL, bad: HeapDefs.WriterHandle,
validate: BOOLEAN,
state: {idle, starting, inItem, dead},
header: BodyDefs.ItemHeader,
itemStart: HeapDefs.ObjectOffset,
stamp: BodyDefs.Timestamp,
recipientCount: CARDINAL,
validRecipients: CARDINAL,
express: BOOLEAN];
WrongCallSequence: ERROR = CODE;
-- Defined only to satisfy the Defs. It is not signalled --
SendFailed: PUBLIC ERROR [notDelivered: BOOLEAN] = CODE;
Create: PUBLIC PROCEDURE RETURNS [handle: Handle] =
BEGIN
handle ← Heap.systemZone.NEW[HandleObject];
handle.state ← idle;
END;
Destroy: PUBLIC PROCEDURE [handle: Handle] =
BEGIN Abort[handle]; handle.state ← dead; Heap.systemZone.FREE[@handle]; END;
validationOn: BOOLEAN ← TRUE; -- debugging facility--
validateSender: BOOLEAN ← TRUE; -- debugging facility--
StartSend: PUBLIC PROCEDURE [
handle: Handle, senderPwd: LONG STRING, sender: BodyDefs.RName,
returnTo: BodyDefs.RName ← NIL, validate: BOOLEAN]
RETURNS [info: SendDefs.StartSendInfo] =
BEGIN
info ← SendFromClient[
handle, 0, 0, ProtocolDefs.MakeKey[senderPwd], sender,
IF returnTo = NIL THEN sender ELSE returnTo, validate];
END;
SendFromClient: PUBLIC ENTRY PROCEDURE [
handle: Handle, fromNet: [0..256), fromHost: [0..256),
senderKey: BodyDefs.Password, --ignored--
sender, returnTo: BodyDefs.RName, validate: BOOLEAN]
RETURNS [info: SendDefs.StartSendInfo] =
BEGIN
header: BodyDefs.ItemHeader;
WriteHeader: PROCEDURE =
BEGIN
HeapDefs.HeapWriteData[handle.body, [@header, SIZE[BodyDefs.ItemHeader]]];
END;
IF handle.state # idle THEN ERROR WrongCallSequence[];
handle.state ← starting;
handle.SL ← HeapDefs.HeapStartWrite[SLinput];
handle.body ← HeapDefs.HeapStartWrite[body];
handle.bad ← NIL;
handle.validate ← validate;
handle.express ← FALSE;
info ← ok;
IF fromHost = 0 THEN BEGIN fromNet ← myName.net; fromHost ← myName.host; END;
-- postmark --
BEGIN
stamp: BodyDefs.Timestamp;
header.type ← PostMark;
header.length ← 2 * SIZE[BodyDefs.Timestamp];
WriteHeader[];
stamp.net ← fromNet;
stamp.host ← fromHost;
stamp.time ← Time.Current[];
handle.stamp ← stamp;
HeapDefs.HeapWriteData[handle.body, [@stamp, SIZE[BodyDefs.Timestamp]]];
END;
-- sender --
BEGIN
header.type ← Sender;
IF NOT RNameFromString[sender]
OR (validateSender AND NOT SiteCacheDefs.ValidateRName[sender]) THEN
BEGIN header.length ← 0; WriteHeader[]; info ← badSender; END
ELSE
BEGIN
header.length ← BodyDefs.RNameSize[sender] * 2;
WriteHeader[];
HeapDefs.HeapWriteRName[handle.body, sender];
END;
END;
-- return-to --
BEGIN
header.type ← ReturnTo;
IF NOT RNameFromString[returnTo]
OR (validateSender AND NOT SiteCacheDefs.ValidateRName[returnTo]) THEN
BEGIN
header.length ← 0;
WriteHeader[];
IF info = ok THEN info ← badReturnTo;
END
ELSE
BEGIN
header.length ← BodyDefs.RNameSize[returnTo] * 2;
WriteHeader[];
HeapDefs.HeapWriteRName[handle.body, returnTo];
END;
END;
-- recipients --
BEGIN
handle.recipientCount ← handle.validRecipients ← 0;
handle.header.type ← Recipients;
handle.header.length ← 0;
handle.itemStart ← HeapDefs.GetWriterOffset[handle.body];
header.type ← Recipients;
header.length ← 0; -- fix up later --
WriteHeader[];
END;
-- Write SL header --
BEGIN
-- SL header --
slHeader: SLDefs.SLHeader;
slHeader.server ← NIL;
slHeader.created ← handle.stamp;
slHeader.received.host ← 0;
slHeader.received.net ← 0;
slHeader.received.time ← handle.stamp.time;
HeapDefs.HeapWriteData[handle.SL, [@slHeader, SIZE[SLDefs.SLHeader]]];
END;
LogStart[handle, sender];
IF info # ok THEN InnerAbort[handle];
END --StartSend-- ;
expressRecipients: CARDINAL ← 50;
AddRecipient: PUBLIC ENTRY PROCEDURE [
handle: Handle, recipient: BodyDefs.RName] =
BEGIN
IF handle.state # starting THEN ERROR WrongCallSequence[];
handle.recipientCount ← handle.recipientCount + 1;
IF handle.validate AND validationOn
AND
(NOT RNameFromString[recipient]
OR NOT SiteCacheDefs.ValidateRName[recipient]) THEN
BEGIN
genuine: CARDINAL = recipient.length;
recipient.length ← MIN[recipient.length, BodyDefs.maxRNameLength];
IF handle.bad = NIL THEN handle.bad ← HeapDefs.HeapStartWrite[temp];
HeapDefs.HeapWriteData[
handle.bad, [@(handle.recipientCount), SIZE[CARDINAL]]];
HeapDefs.HeapWriteRName[handle.bad, recipient];
recipient.length ← genuine;
END
ELSE
BEGIN
genuine: CARDINAL = recipient.length;
recipient.length ← MIN[recipient.length, BodyDefs.maxRNameLength];
handle.validRecipients ← handle.validRecipients + 1;
IF handle.validRecipients > expressRecipients THEN handle.express ← TRUE;
-- Writing recipient names into message body disabled until Laurel 6.
-- handle.header.length ←
-- handle.header.length + 2*BodyDefs.RNameSize[recipient];
-- HeapDefs.HeapWriteRName[handle.body, recipient];
HeapDefs.HeapWriteRName[handle.SL, recipient];
recipient.length ← genuine;
CheckExpressMail[handle, recipient];
END;
END --AddRecipient-- ;
CheckExpressMail: INTERNAL PROC [handle: Handle, recipient: BodyDefs.RName] =
BEGIN
IF NOT handle.express THEN
FOR i: CARDINAL DECREASING IN [0..recipient.length) DO
IF recipient[i] = '. THEN
BEGIN
IF i > 0 AND recipient[i - 1] = '↑ THEN
IF NameInfoDefs.IsMemberDirect["ExpressMail↑.ms"L, recipient] = yes
THEN handle.express ← TRUE;
EXIT
END;
ENDLOOP;
END;
BadBadList: ERROR = CODE;
CheckValidity: PUBLIC ENTRY PROC [
handle: Handle, notify: PROCEDURE [CARDINAL, BodyDefs.RName]]
RETURNS [ok: CARDINAL] =
BEGIN
rName: BodyDefs.RName = [BodyDefs.maxRNameLength];
number: CARDINAL;
reader: HeapDefs.ReaderHandle;
ended: BOOLEAN;
used: CARDINAL;
GetReader: PROCEDURE [obj: HeapDefs.ObjectNumber] =
BEGIN reader ← HeapDefs.HeapStartRead[obj] END;
IF handle.state # starting THEN ERROR WrongCallSequence[];
handle.state ← inItem;
IF handle.bad # NIL THEN
BEGIN
HeapDefs.HeapEndWrite[handle.bad, GetReader];
handle.bad ← NIL;
[ended, ] ← HeapDefs.HeapReadData[reader, [@number, 0]];
UNTIL ended DO
BEGIN
ENABLE UNWIND => HeapDefs.HeapEndRead[reader];
[ended, used] ← HeapDefs.HeapReadData[reader, [@number, SIZE[CARDINAL]]];
IF ended OR used # SIZE[CARDINAL] THEN ERROR BadBadList[];
ended ← HeapDefs.HeapReadRName[reader, rName];
IF notify # NIL THEN notify[number, rName];
END;
ENDLOOP;
HeapDefs.HeapEndRead[reader];
END;
RETURN[handle.validRecipients]
END;
EndItem: INTERNAL PROCEDURE [handle: Handle] =
BEGIN
IF handle.state = starting THEN
BEGIN
IF handle.bad # NIL THEN HeapDefs.HeapAbandonWrite[handle.bad];
handle.bad ← NIL;
handle.state ← inItem;
END;
IF handle.state # inItem THEN ERROR WrongCallSequence[];
BEGIN
save: HeapDefs.ObjectOffset = HeapDefs.GetWriterOffset[handle.body];
HeapDefs.SetWriterOffset[handle.body, handle.itemStart];
HeapDefs.HeapWriteData[
handle.body, [@(handle.header), SIZE[BodyDefs.ItemHeader]]];
HeapDefs.SetWriterOffset[handle.body, save];
handle.itemStart ← save;
END;
END;
StartItem: PUBLIC ENTRY PROC [handle: Handle, type: BodyDefs.ItemType] =
BEGIN
header: BodyDefs.ItemHeader;
EndItem[handle];
handle.state ← inItem;
handle.header.type ← type;
handle.header.length ← 0;
header.type ← type;
header.length ← 0; --fixed up later--
HeapDefs.HeapWriteData[handle.body, [@header, SIZE[BodyDefs.ItemHeader]]];
END --StartItem-- ;
AddToItem: PUBLIC ENTRY PROC [
handle: Handle, buffer: LONG DESCRIPTOR FOR PACKED ARRAY OF CHARACTER] =
BEGIN
IF handle.state # inItem THEN ERROR WrongCallSequence[];
IF handle.header.length MOD 2 # 0 THEN ERROR WrongCallSequence[];
HeapDefs.HeapWriteData[handle.body, [BASE[buffer], (1 + LENGTH[buffer]) / 2]];
handle.header.length ← handle.header.length + LENGTH[buffer];
END --AddToItem-- ;
Send: PUBLIC ENTRY PROCEDURE [handle: Handle] =
BEGIN
EndItem[handle];
handle.state ← idle;
-- End --
BEGIN
header: BodyDefs.ItemHeader;
header.type ← LastItem;
header.length ← 0;
HeapDefs.HeapWriteData[handle.body, [@header, SIZE[BodyDefs.ItemHeader]]];
END;
LogCommit[handle];
-- commit --
BEGIN
Action: PROCEDURE [obj: HeapDefs.ObjectNumber] =
BEGIN
SLDefs.SLWrite[
body: obj, SL: handle.SL,
queue: IF handle.express THEN express ELSE input];
END;
HeapDefs.HeapEndWrite[handle.body, Action];
END;
END;
InnerAbort: INTERNAL PROCEDURE [handle: Handle] =
BEGIN
IF handle.state IN [starting..inItem] THEN
BEGIN
IF handle.bad # NIL THEN HeapDefs.HeapAbandonWrite[handle.bad];
HeapDefs.HeapAbandonWrite[handle.body];
HeapDefs.HeapAbandonWrite[handle.SL];
LogAbort[handle];
END;
handle.state ← idle;
END;
Abort: PUBLIC ENTRY PROCEDURE [handle: Handle] = BEGIN InnerAbort[handle]; END;
ExpandFailed: PUBLIC ERROR = CODE; -- not raised --
Expand: PUBLIC PROC [name: BodyDefs.RName, work: PROC [BodyDefs.RName]]
RETURNS [info: SendDefs.ExpandInfo] =
BEGIN
nameInfo: SiteCacheDefs.RecipientInfo = SiteCacheDefs.FindMBXSite[name];
MyWork: PROC [n: BodyDefs.RName] RETURNS [done: BOOLEAN] = {
work[n]; RETURN[FALSE]};
WITH i: nameInfo SELECT FROM
allDown => info ← allDown;
notFound => info ← notFound;
local, found => info ← individual;
dl =>
BEGIN
ENABLE UNWIND => NameInfoDefs.Close[i.members];
NameInfoDefs.Enumerate[i.members, MyWork];
NameInfoDefs.Close[i.members];
info ← ok;
END;
foreign =>
BEGIN
ENABLE UNWIND => HeapDefs.HeapEndRead[i.members];
HeapDefs.ReadRList[i.members, MyWork];
HeapDefs.HeapEndRead[i.members];
info ← ok;
END;
ENDCASE => ERROR;
END;
myName: PupDefs.PupAddress;
[] ← PupDefs.PupPackageMake[];
PupDefs.PupNameLookup[@myName, "ME"L];
END.