MSMessageImpl.mesa
Copyright Ó 1987, 1990, 1991 by Xerox Corporation. All rights reserved.
Doug Terry, November 29, 1988 4:33:30 pm PST
Willie-sue Orr, December 11, 1991 7:46 pm PST -0100 -0100 -0100 -0100
Wes Irish, July 19, 1989 9:40:08 am PDT
Routines for parsing various XNS message body parts.
DIRECTORY
BasicTime USING [FromNSTime],
Convert USING [Error, TimeFromRope],
CrRPC USING [CreateClientHandle, Handle],
HeaderContentsP0V0,
IO,
MailFormatP1516V3,
MailFormatP1516V3Aux,
MailFormatExtraTypes,
MailTransportP17V5Aux USING [ExposeGatewayRecord],
MSBasics USING [CHRName, RName, X400RName],
MSMessage USING [BodyPartType, g3Fax, headingBodyPart, ia5Note, interpress, iso6937Note, multinationalNote, nsTextFile, otherNSFile, pilotFile, teletex, vpDocument, vpFolder],
MSUtils USING [StrippedName],
Rope,
RuntimeError USING [BoundsFault],
XNSCHName USING [FieldTooLong, Name, NameFromRope, RopeFromName];
MSMessageImpl: CEDAR PROGRAM
IMPORTS BasicTime, Convert, CrRPC, HeaderContentsP0V0, IO, MailFormatP1516V3Aux, MailTransportP17V5Aux, MSUtils, Rope, RuntimeError, XNSCHName
EXPORTS MSMessage
~ BEGIN
OPEN
HeaderContents: HeaderContentsP0V0,
MailFormat: MailFormatP1516V3,
MailFormatAux: MailFormatP1516V3Aux,
MailTransportAux: MailTransportP17V5Aux;
STREAM: TYPE ~ IO.STREAM;
ROPE: TYPE ~ Rope.ROPE;
HeadingBodyPartFlags: TYPE ~ REF HeadingBodyPartFlagsObject;
HeadingBodyPartFlagsObject: TYPE ~ MACHINE DEPENDENT RECORD [
body: PACKED SEQUENCE length: CARDINAL OF BOOL
];
We don't really want textAnnotation as top priority but it might hold the "Date:" field, and that we do care about...
priorityList: LIST OF CARD32 ¬ LIST[MailFormat.textAnnotation, MailFormat.originator, MailFormat.subject, MailFormat.inReplyTo, MailFormat.messageID, MailFormat.primaryRecipients, MailFormat.copyRecipients, MailFormat.replyToUsers, MailFormat.replyBy];
nullXNSName: XNSCHName.Name ¬ ["", "", ""];
Message Header
These routines convert an X.400 style header into a RFC-822 looking text header. The conversion should comply with the rules for converting between X.400 and RFC-822 headers specified in RFC-987 and RFC-1026, but currently does not.
GetHeader: PUBLIC PROC [bodypart: STREAM]
RETURNS[text, plainText, formatting: STREAM, bodyAnnotSize: CARD32] ~ {
Takes a stream of bits representing a mail message header and returns the header in text form as a stream.
tR, pR, fR: ROPE;
[tR, pR, fR, bodyAnnotSize] ¬ GetHeaderRope[bodypart];
RETURN[IO.RIS[tR], IO.RIS[pR], IO.RIS[fR], bodyAnnotSize];
};
GetHeaderRope: PUBLIC PROC [bodypart: STREAM]
RETURNS [text, plainText, formatting: ROPE, bodyAnnotSize: CARD32] ~ {
Like GetHeader but returns a rope.
bpRope: ROPE ¬ IO.GetRope[bodypart];
h: CrRPC.Handle ¬ CrRPC.CreateClientHandle[$Loopback, NIL];
heading: MailFormat.HeadingBodyPart ¬ HeaderContents.HeadingFromBodyPart[h, bpRope].value;
[text, plainText, formatting, bodyAnnotSize] ¬ RFC822FromX400Header[heading];
};
RFC822FromX400Header: PROC [heading: MailFormat.HeadingBodyPart]
RETURNS [text, plainText, formatting: ROPE, bodyAnnotSize: CARD32 ¬ 0] ~ {
Parses the XNS Mail header and turns it into a RFC-822 looking text header.
This PROC is overly complex because we'd like to see things in a preferred order, which is not the order in which the header is necessarily arranged...
date: BOOL ¬ FALSE;
dateAnnotation: BOOL ¬ FALSE;
possibleDate: ROPE;
possibleDateRope: ROPE;
originNameRope: ROPE;
output: STREAM ¬ IO.ROS[];
originName: XNSCHName.Name;
headingBodyPartUsed: HeadingBodyPartFlags ¬ NEW[HeadingBodyPartFlagsObject[heading.length]];
h: CrRPC.Handle ¬ CrRPC.CreateClientHandle[$Loopback, NIL];
FOR i: CARDINAL IN [0..headingBodyPartUsed.length) DO
headingBodyPartUsed[i] ¬ FALSE;
ENDLOOP;
find the originiator of the message, to qualifiy names of recipients
FOR i: CARDINAL IN [0..headingBodyPartUsed.length) DO
SELECT heading[i].type FROM
MailFormat.originator => {
originator: MailFormat.Originator ¬ HeaderContents.OriginatorFromAttr[h, heading[i].value].value;
originNameRope ¬ MSUtils.StrippedName[RopeFromRName[originator, nullXNSName], NIL, NIL];
EXIT;
};
MailFormat.authorizingUsers => IF ( originNameRope = NIL ) THEN {
authorizingUsers: MailFormat.AuthorizingUsers ¬
HeaderContents.AuthorizingUsersFromAttr[h, heading[i].value].value;
foo: MSBasics.RName;
bad: BOOL ¬ FALSE;
BEGIN ENABLE RuntimeError.BoundsFault => { bad ¬ TRUE; GOTO exit };
foo ¬ authorizingUsers.body[0];
EXITS exit => NULL;
END;
IF NOT bad THEN
originNameRope ¬ MSUtils.StrippedName[RopeFromRName[foo, nullXNSName], NIL, NIL];
};
ENDCASE;
ENDLOOP;
IF originNameRope # NIL THEN originName ¬ XNSCHName.NameFromRope[originNameRope ! XNSCHName.FieldTooLong => RESUME];
Pick out attributes in priority order (basically a selection sort)
FOR pl: LIST OF CARD32 ¬ priorityList, pl.rest WHILE pl # NIL DO
find the attribute (if it exists)
FOR i: CARDINAL IN [0..heading.length) DO
IF headingBodyPartUsed[i] THEN LOOP;
IF heading[i].type = pl.first THEN {
[date, possibleDate] ¬ PrintAttr[output, heading[i], originName];
dateAnnotation ¬ dateAnnotation OR date;
IF possibleDate # NIL THEN possibleDateRope ¬ possibleDate;
headingBodyPartUsed[i] ¬ TRUE;
EXIT;
};
ENDLOOP;
ENDLOOP;
Now finish off any attributes that weren't in our priority list
FOR i: CARDINAL IN [0..heading.length) DO
thisP, thisF: ROPE;
thisBAS: CARD32 ¬ 0;
IF headingBodyPartUsed[i] THEN LOOP;
[date, possibleDate, thisP, thisF, thisBAS] ¬ PrintAttr[output, heading[i], originName];
IF ( thisBAS # 0 ) THEN bodyAnnotSize ¬ thisBAS;
IF thisP # NIL THEN { plainText ¬ thisP; LOOP };
IF thisF # NIL THEN { formatting ¬ thisF; LOOP };
dateAnnotation ¬ dateAnnotation OR date;
IF possibleDate # NIL THEN possibleDateRope ¬ possibleDate;
ENDLOOP;
text ¬ IO.RopeFromROS[output];
Create a "Date:" field (if possible) if none is present
IF (NOT dateAnnotation) AND possibleDateRope # NIL THEN {
goodDate: BOOL ¬ TRUE;
[] ¬ Convert.TimeFromRope[r: possibleDateRope
! Convert.Error => {goodDate ¬ FALSE; CONTINUE}];
IF goodDate THEN text ¬ Rope.Cat["Date: ", possibleDateRope, "\r", text];
};
};
PrintAttr: PROC [out: STREAM, attr: MailFormat.Attribute, originName: XNSCHName.Name] RETURNS [date: BOOL ¬ FALSE, possibleDate, plainText, formatting: ROPE ¬ NIL, bodyAnnotSize: CARD32 ¬ 0] ~ {
h: CrRPC.Handle ¬ CrRPC.CreateClientHandle[$Loopback, NIL];
SELECT attr.type FROM
MailFormat.forwardedHeadings => {
forwardedHeadings: MailFormat.ForwardedHeadings ← HeaderContents.ForwardedHeadingsFromAttr[h, attr.value].value;
IO.PutF[out, "ForwardedHeadings: %g\r", IO.rope[MailFormatAux.ExposeForwardedHeadings[forwardedHeadings, 1]]];
};
MailFormat.forwardedHeadings => out.PutRope["ForwardedHeadings: <<suppressed>>\r"];
MailFormat.copyRecipients => {
copyRecipients: MailFormat.CopyRecipients ¬ HeaderContents.CopyRecipientsFromAttr[h, attr.value].value;
IO.PutF1[out, "Cc: %g\r", [rope[RopeFromRNameList[copyRecipients, originName]]]];
};
MailFormat.blindCopyRecipients => {
blindCopyRecipients: MailFormat.BlindCopyRecipients ¬ HeaderContents.BlindCopyRecipientsFromAttr[h, attr.value].value;
IO.PutF1[out, "Bcc: %g\r", [rope[RopeFromRNameList[blindCopyRecipients, originName]]]];
};
MailFormat.subject => {
subject: MailFormat.Subject ¬ HeaderContents.SubjectFromAttr[h, attr.value].value;
IO.PutF1[out, "Subject: %g\r", [rope[FixUpSubjectLine[subject]]] ];
};
MailFormat.textAnnotation => {
textAnnotation: MailFormat.TextAnnotation ¬ HeaderContents.TextAnnotationFromAttr[h, attr.value].value;
needsNewLine: BOOL ¬ TRUE;
lenSub1: INT ~ textAnnotation.Length[]-1;
IF ( lenSub1 > 0 ) THEN {
ch: CHAR ~ textAnnotation.Fetch[lenSub1];
SELECT ch FROM
'\r => needsNewLine ¬ FALSE;
'\l => textAnnotation ¬ textAnnotation.Substr[0, lenSub1];
ENDCASE;
};
IO.PutRope[out, textAnnotation];
IF needsNewLine THEN out.PutChar['\r];
date ¬ Rope.Match[pattern: "Date:*", object: textAnnotation, case: FALSE] OR Rope.Match[pattern: "*\rDate:*", object: textAnnotation, case: FALSE];
};
MailFormatExtraTypes.newTextAnnotation => {
textAnnotation: MailFormat.TextAnnotation ¬ HeaderContents.TextAnnotationFromAttr[h, attr.value].value;
textAnnotation ¬ CheckForDuplicateFields[textAnnotation];
IO.PutRope[out, textAnnotation];
IF ( textAnnotation.Length[] > 0 )
AND ( textAnnotation.Fetch[textAnnotation.Length[]-1] # '\r ) THEN out.PutChar['\r];
date ¬ Rope.Match[pattern: "Date:*", object: textAnnotation, case: FALSE] OR Rope.Match[pattern: "*\rDate:*", object: textAnnotation, case: FALSE];
};
MailFormat.primaryRecipients => {
primaryRecipients: MailFormat.PrimaryRecipients ¬ HeaderContents.PrimaryRecipientsFromAttr[h, attr.value].value;
IO.PutF1[out, "To: %g\r", [rope[RopeFromRNameList[primaryRecipients, originName]]]];
};
MailFormat.inReplyTo => {
inReplyTo: MailFormat.InReplyTo ¬ HeaderContents.InReplyToFromAttr[h, attr.value].value;
IO.PutF1[out, "In-Reply-To: %g\r", IO.rope[RopeFromIPMessageID[inReplyTo, 1]]];
};
MailFormat.autoforwarded => {
autoforwarded: MailFormat.Autoforwarded ¬ HeaderContents.AutoforwardedFromAttr[h, attr.value].value;
IO.PutF1[out, "Autoforwarded: %g\r", IO.bool[autoforwarded]];
};
MailFormat.importance => {
importance: MailFormat.Importance ¬ HeaderContents.ImportanceFromAttr[h, attr.value].value;
IO.PutF1[out, "Importance: %g\r", IO.rope[MailFormatAux.ExposeImportance[importance, 1]]];
};
MailFormat.obsoletes => {
obsoletes: MailFormat.Obsoletes ¬ HeaderContents.ObsoletesFromAttr[h, attr.value].value;
IO.PutF1[out, "Obsoletes: %g\r", IO.rope[RopeFromIPMessageIDList[obsoletes, 1]]];
};
MailFormat.authorizingUsers => {
authorizingUsers: MailFormat.AuthorizingUsers ¬ HeaderContents.AuthorizingUsersFromAttr[h, attr.value].value;
IO.PutF1[out, "From: %g\r", [rope[RopeFromRNameList[authorizingUsers, nullXNSName]]]];
};
MailFormat.expiryDate => {
expiryDate: MailFormat.ExpiryDate ¬ HeaderContents.ExpiryDateFromAttr[h, attr.value].value;
IO.PutF1[out, "Expiry-Date: %g\r", IO.time[BasicTime.FromNSTime[expiryDate]]];
};
MailFormat.crossReferences => {
crossReferences: MailFormat.CrossReferences ¬ HeaderContents.CrossReferencesFromAttr[h, attr.value].value;
IO.PutF1[out, "References: %g\r", IO.rope[RopeFromIPMessageIDList[crossReferences, 1]]];
};
MailFormat.sensitivity => {
sensitivity: MailFormat.Sensitivity ¬ HeaderContents.SensitivityFromAttr[h, attr.value].value;
IO.PutF1[out, "Sensitivity: %g\r", IO.rope[MailFormatAux.ExposeSensitivity[sensitivity, 1]]];
};
MailFormat.replyRequest => {
replyRequest: MailFormat.ReplyRequest ¬ HeaderContents.ReplyRequestFromAttr[h, attr.value].value;
IO.PutF1[out, "ReplyRequest: %g\r", IO.rope[RopeFromRNameList[replyRequest, originName]]];
};
MailFormat.immutable => {
immutable: MailFormat.Immutable ¬ HeaderContents.ImmutableFromAttr[h, attr.value].value;
IO.PutF1[out, "Immutable: %g\r", IO.rope[MailFormatAux.ExposeImmutable[immutable, 1]]];
};
MailFormat.messageID => {
messageID: MailFormat.MessageID ¬ HeaderContents.MessageIDFromAttr[h, attr.value].value;
IO.PutF1[out, "Message-ID: %g\r", IO.rope[RopeFromIPMessageID[messageID, 1]]];
possibleDate ¬ messageID.uniqueString;
};
MailFormat.replyBy => {
replyBy: MailFormat.ReplyBy ¬ HeaderContents.ReplyByFromAttr[h, attr.value].value;
IO.PutF1[out, "Reply-By: %g\r", IO.time[BasicTime.FromNSTime[replyBy]]];
};
MailFormat.replyToUsers => {
replyToUsers: MailFormat.ReplyToUsers ¬ HeaderContents.ReplyToUsersFromAttr[h, attr.value].value;
IO.PutF1[out, "Reply-To: %g\r", [rope[RopeFromRNameList[replyToUsers, originName]]]];
};
MailFormat.originator => {
originator: MailFormat.Originator ¬ HeaderContents.OriginatorFromAttr[h, attr.value].value;
IO.PutF1[out, "Sender: %g\r", [rope[RopeFromRName[originator, nullXNSName]]]];
};
116, 117 => NULL; -- known to be uninteresting, 116 is NOT a string
MailFormatExtraTypes.bodyAnnotationSize => { -- ExpiryDateFromAttr return CARD32
bodyAnnotSize ¬ HeaderContents.ExpiryDateFromAttr[h, attr.value].value;
};
MailFormatExtraTypes.tiogaPlainText =>
plainText ¬ HeaderContents.TextAnnotationFromAttr[h, attr.value].value;
MailFormatExtraTypes.tiogaFormatting =>
formatting ¬ HeaderContents.TextAnnotationFromAttr[h, attr.value].value;
ENDCASE => { -- treat value as string, but be cautious
string: MailFormat.TextAnnotation;
string ¬ HeaderContents.TextAnnotationFromAttr[h, attr.value
! IO.Error, IO.EndOfStream => GOTO noGood].value;
IF string.Length[] # 0 THEN
IO
.PutF[out, "Header-Attribute-%g: %g\r", IO.card[attr.type], IO.rope[string]];
EXITS noGood => NULL;
};
};
testRope: ROPE ¬ "testing 123\015testing 456\015\015testing 789";
Foo: PROC RETURNS[ROPE] = { RETURN [FixUpSubjectLine[testRope]] };
FixUpSubjectLine: PROC[subject: ROPE] RETURNS[ROPE] = {
pos: INT ¬ 0;
count: INT ¬ 0;
DO-- remove trailing cr's or lf's
length: INT ¬ subject.Length[];
IF length<=0 THEN RETURN [subject];
SELECT subject.Fetch[length-1] FROM
'\r, '\l => subject ¬ subject.Substr[0, length-1];
ENDCASE => EXIT;
ENDLOOP;
DO-- look for embedded cr's or lf's, add a space if there isn't one already
where: INT ¬ Rope.SkipTo[s: subject, pos: pos, skip: "\l\r"];
ch: CHAR;
IF ( count ¬ count + 1 ) > 10 THEN RETURN[Rope.Concat["Count > 10: ", subject]];
IF where = subject.Length[] THEN RETURN[subject];
ch ¬ subject.Fetch[where+1];
IF ( ch = ' ) OR ( ch = '\t ) THEN { pos ¬ where+1; LOOP };
subject ¬ Rope.Cat[subject.Substr[0, where], "\r\t", subject.Substr[where+1] ];
pos ¬ where+1
ENDLOOP;
};
RopeFromIPMessageID: PROC [messageID: MailFormat.MessageID, level: NAT]
RETURNS [rope: ROPE] ~ {
this: ROPE ~ RopeFromRName[messageID.originator, nullXNSName];
IF ( this.Length[] >= 4 ) THEN-- suppress "?::" or "::"
rope ¬ Rope.Cat["Originator: \"", this, "\", "];
IF rope = NIL THEN RETURN[Rope.Cat["\"", messageID.uniqueString, "\""]];
rope ¬ Rope.Cat[rope, "UniqueString: \"", messageID.uniqueString, "\""];
};
RopeFromIPMessageIDList: PROC [messageIDList: MailFormat.IPMessageIDList, level: NAT] RETURNS [rope: ROPE] ~ {
FOR i: CARDINAL IN [0..messageIDList.length) DO
this: ROPE ~ RopeFromIPMessageID[messageIDList.body[i], (level+1)];
IF this = NIL THEN LOOP;
rope ¬ Rope.Cat[rope, IF ( rope # NIL ) THEN ", " ELSE NIL, this];
ENDLOOP;
};
RopeFromRName: PROC [name: MSBasics.RName, originName: XNSCHName.Name] RETURNS [rope: ROPE] ~ {
WITH name SELECT FROM
it: MSBasics.CHRName => {
rope ¬ QualifyName[it.xns, originName ! XNSCHName.FieldTooLong => RESUME] };
it: MSBasics.X400RName => {
rope ¬ MailTransportAux.ExposeGatewayRecord[it.gateway, 1] };
ENDCASE => ERROR
};
RopeFromRNameList: PROC [list: MailFormat.RNameList, originName: XNSCHName.Name] RETURNS [rope: ROPE] ~ {
rope ¬ NIL;
FOR i: CARDINAL IN [0..list.length) DO
rope ¬ Rope.Cat[rope, IF i>0 THEN ", " ELSE NIL, RopeFromRName[list.body[i], originName]];
ENDLOOP;
};
QualifyName: PROC[name, originName: XNSCHName.Name] RETURNS[rp: ROPE] = {
qualified: XNSCHName.Name ¬ name;
IF qualified.domain.Length[] = 0 THEN RETURN[qualified.object];
IF qualified.organization.Length[] = 0 THEN qualified.organization ¬ NIL;
IF qualified.organization = NIL OR ( Rope.Equal[qualified.organization, originName.organization, FALSE] ) THEN {
IF Rope.Equal[qualified.domain, originName.domain, FALSE] THEN
RETURN
[name.object];
RETURN[Rope.Cat[name.object, ":", name.domain]];
};
RETURN[XNSCHName.RopeFromName[qualified]];
};
original: ROPE = "Original-";
CheckForDuplicateFields: PROC[old: ROPE] RETURNS[new: ROPE] = {
Replace: PROC[which, whereToLook: ROPE] RETURNS[ROPE] = {
where: INT;
where ¬ Rope.Find[whereToLook, which, 0, FALSE];
IF where = -1 THEN RETURN[whereToLook];
IF where = 0 THEN RETURN[original.Concat[whereToLook]];
IF whereToLook.Fetch[where-1] # '\r THEN RETURN[whereToLook];
RETURN[Rope.Cat[Rope.Substr[whereToLook, 0, where], original, Rope.Substr[whereToLook, where]]];
};
new ¬ Replace["From:", old];
new ¬ Replace["Sender:", new];
new ¬ Replace["To:", new];
new ¬ Replace["Cc:", new];
};
Multinational Note
GetNote: PUBLIC PROC [bodypart: STREAM] RETURNS [text: STREAM] ~ {
Takes a stream of bits representing a multinational note (i.e. characters from the Xerox Character Code Standard) and returns the text as a stream.
This is a no-op since text in Cedar can be considered a string of Xerox Character Codes in Character Set 0. Someday Cedar may deal with other Character Sets as well.
RETURN[bodypart];
};
GetNoteRope: PUBLIC PROC [bodypart: STREAM] RETURNS [text: ROPE] ~ {
Like GetNote but returns a rope.
RETURN[IO.GetRope[GetNote[bodypart]]];
};
International Alphabet Note
GetIA5Note: PUBLIC PROC [bodypart: STREAM] RETURNS [text: STREAM] ~ {
Takes a stream of bits representing characters from international Alphabet No 5 and returns the text as a stream.
This is a no-op since IA5 is very similar to ASCII.
RETURN[bodypart];
};
GetIA5NoteRope: PUBLIC PROC [bodypart: STREAM] RETURNS [text: ROPE] ~ {
Like GetIA5Note but returns a rope.
RETURN[IO.GetRope[GetIA5Note[bodypart]]];
};
Utilities
RopeFromBodyPartType: PUBLIC PROC [type: MSMessage.BodyPartType] RETURNS [rope: ROPE] ~ {
Returns a human-sensible name for the given body part type.
rope ¬ SELECT type FROM
MSMessage.headingBodyPart => "Interpersonal Message Header",
MSMessage.vpFolder => "Viewpoint Folder",
MSMessage.nsTextFile => "XNS Text File",
MSMessage.vpDocument => "Viewpoint Document",
MSMessage.otherNSFile => "XNS Serialized File",
MSMessage.multinationalNote => "Multinational Note",
MSMessage.ia5Note => "International Alphabet No 5 Note",
MSMessage.pilotFile => "Pilot (XDE) File",
MSMessage.g3Fax => "G3 Fax Document",
MSMessage.teletex => "Teletex Document",
MSMessage.iso6937Note => "ISO6937 (CEN/CENELEC) Note",
MSMessage.interpress => "Interpress Master",
ENDCASE => "Unknown";
};
END.