[Cyan]<CedarChest6.1>WalnutSend>WalnutSendMailImpl.mesa!3

WalnutSendMailImpl.mesa

Last Edited by: Willie-Sue, August 15, 1986 5:01:08 pm PDT

Last Edited by: Donahue, October 2, 1985 7:59:30 am PDT

Last Edited by: Neil Gunther, April 17, 1985 1:06:34 pm PST

Hal Murray August 6, 1985 1:04:01 am PDT

Contents: Implementation of the WalnutMsg Send operation

DIRECTORY

BasicTime USING [GMT, nullGMT, Unpacked, Now, Unpack],

FS USING [ComponentPositions, Error, ExpandName, StreamOpen],

GVBasics USING [ItemType, RName],

GVMailParse,

GVNames,

GVSend USING [Abort, AddRecipient, AddToItem, CheckValidity, Create, Handle,

Send, SendFailed, StartItem, StartSend, StartSendInfo],

Icons,

Menus,

IO,

Rope,

RopeList USING [Append],

RuntimeError USING [BoundsFault],

TextNode,

TiogaOps,

UserProfile USING [Token],

ViewerClasses USING [Viewer],

ViewerOps,

ViewerTools,

UserCredentials USING [Get],

WalnutDocumentRope,

WalnutSendOps,

WalnutSendOpsExtras,

WalnutSendInternal,

WalnutParseMsg USING [MessageFieldIndex, MessageInfo, messageParseArray, CanonicalName];

WalnutSendMailImpl: CEDAR MONITOR

IMPORTS

BasicTime, FS,

GVMailParse, GVNames, GVSend, IO, Rope, RopeList, RuntimeError,

TextNode, TiogaOps,

ViewerOps, ViewerTools,

UserCredentials, UserProfile,

WalnutParseMsg,

WalnutSendInternal,

WalnutSendOps,

WalnutSendOpsExtras

EXPORTS

WalnutDocumentRope, WalnutSendInternal, WalnutSendOps =

BEGIN OPEN WalnutSendInternal, WalnutSendOpsExtras;

RName: TYPE = GVBasics.RName;

ROPE: TYPE = Rope.ROPE;

Viewer: TYPE = ViewerClasses.Viewer;

************************************************************************

Send: PUBLIC PROC[v: Viewer, doClose: BOOL← FALSE] RETURNS[sent: BOOL] =

{ oldMenu: Menus.Menu = v.menu;

v.inhibitDestroy← TRUE;

BEGIN ENABLE UNWIND => GOTO out;

ViewerOps.SetMenu[v, sendingMenu];

IF needToAuthenticate THEN

{ SenderReport["Authenticating user ..."];

IF ~AuthenticateUser[] THEN

{ViewerOps.BlinkIcon[v, IF v.iconic THEN 0 ELSE 1];

ViewerOps.SetMenu[v, oldMenu];

v.inhibitDestroy ← FALSE;

RETURN[FALSE]

};

SenderReport[" ...ok\n"];

};

sent ← InternalSendMsg[v, doClose];

EXITS

out => NULL;

END;

ViewerOps.SetMenu[v, oldMenu];

v.inhibitDestroy ← FALSE;

};

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

AppendHeaderLine: PUBLIC PROC[v: Viewer, line: ROPE, changeSelection: BOOL ← FALSE] =

BEGIN ENABLE RuntimeError.BoundsFault => GOTO exit;

text: ROPE;

i: INT ← 0;

ch: CHAR;

TRUSTED {text ← Create[LOOPHOLE [TiogaOps.ViewerDoc[v]]]};

DO -- find the double CR at the end of the headers

UNTIL (ch ← text.Fetch[i]) = '\n DO i ← i + 1; ENDLOOP;

IF (ch ← text.Fetch[i ← i + 1]) = '\n THEN EXIT;

ENDLOOP;

InsertIntoViewer[v, line, i-1, WalnutSendOps.labelFont, changeSelection];

ViewerTools.EnableUserEdits[v];

EXITS

exit => SenderReport[IO.PutFR["Malformed headers; append of &g not done", IO.rope[line]]];

END;

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

AuthenticateUser: PROC RETURNS [BOOL] =

BEGIN OPEN WalnutSendOps;

auth: GVNames.AuthenticateInfo;

IF userRName.Length[] = 0 THEN {SenderReport["Please Login\n"]; RETURN[FALSE]};

SELECT

auth ←

GVNames.Authenticate[userRName, UserCredentials.Get[].password] FROM

group => SenderReport["... Can't login as group\n"];

individual => {needToAuthenticate ← FALSE; RETURN[TRUE]};

notFound => {SenderReport[userRName]; SenderReport[" is invalid - please Login\n"]};

allDown => SenderReport["... No server responded\n"];

badPwd => SenderReport["... Your Password is invalid - please Login\n"];

ENDCASE;

RETURN[FALSE];

END;

InternalSendMsg: PROC[senderV: Viewer, doClose: BOOL] RETURNS[sendOk: BOOL] =

BEGIN

status: SendParseStatus;

sPos, mPos: INT;

formatting: ROPE;

smr: SendingRec;

addedTxtLength: INT;

newTxt: ROPE;

contents, currentText: ViewerTools.TiogaContents;

senderInfo: SenderInfo ← NARROW[ViewerOps.FetchProp[senderV, $SenderInfo]];

Blink: PROC[v: Viewer] = { ViewerOps.BlinkIcon[v, IF v.iconic THEN 0 ELSE 1]};

sendOk ← FALSE;

senderInfo.aborted ← FALSE;

IF senderInfo.successfullySent AND ~senderV.newVersion THEN

{ SenderReport["\nDo you really want to send this message again?"];

IF ~Confirmation[senderInfo] THEN

{ SenderReport[" .. Not sent\n"];

senderInfo.successfullySent ← FALSE;

RETURN}

};

senderInfo.successfullySent ← FALSE;

SenderReport["... Parsing..."];

smr ← NEW[SendMsgRecObject];

TRUSTED

{ smr.fullText ← Create[LOOPHOLE [TiogaOps.ViewerDoc[senderV]]] };

[status, sPos, mPos] ← ParseTextToBeSent[smr];

SELECT status FROM

fieldNotAllowed => {

IF sPos # mPos THEN

{ ShowErrorFeedback[senderV, sPos, mPos];

SenderReport[Rope.Substr[smr.fullText, MAX[0, sPos-1], mPos-sPos]];

SenderReport[" field is not allowed\n"]}

ELSE SenderReport[IO.PutFR[" field at pos %g is not allowed\n", IO.int[sPos]]];

Blink[senderV];

RETURN

};

syntaxError => {

IF sPos # mPos THEN

{ ShowErrorFeedback[senderV, sPos, mPos];

SenderReport["\nSyntax error on line beginning with "];

SenderReport[Rope.Substr[smr.fullText, MAX[0, sPos-1], mPos-sPos]]}

ELSE SenderReport[IO.PutFR["..... Syntax error at position %g ", IO.int[sPos]]];

Blink[senderV];

RETURN

};

pdlNotFound, pdlSyntaxError => {

Blink[senderV];

RETURN

};

ENDCASE => NULL;

IF CheckForAbortSend[senderInfo] THEN RETURN;

IF (status = includesPublicDL OR status = includesPrivateDL

OR smr.numRecipients > maxWithNoReplyTo) AND ~smr.replyTo THEN

{ howToReply: HowToReplyTo ← self;

IF ~replyToSelf THEN

{ oldM: Menus.Menu ← senderV.menu;

IF CheckForAbortSend[senderInfo] THEN RETURN;

ViewerOps.SetMenu[senderV, replyToMenu];

SenderReport[

IO.PutFR["... %g public DLs and %g other recipients; please choose Reply-To option",

IO.int[smr.numDLs], IO.int[smr.numRecipients]]];

SenderReport[

"\nClick Self to reply-to self, All to reply-to all, Cancel to cancel Send\n"];

howToReply ← ReplyToResponse[senderInfo];

ViewerOps.SetMenu[senderV, oldM];

};

IF howToReply # all THEN

InternalInsert[senderV, "Reply-to: ", WalnutSendOps.userRName,

smr.endHeadersPos-1, WalnutSendOps.labelFont];

IF howToReply = cancel THEN

{SenderReport["\nDelivery cancelled. Reply-to: has been added\n"];

RETURN

};

IF CheckForAbortSend[senderInfo] THEN RETURN;

};

IF doClose AND ~senderV.iconic THEN ViewerOps.CloseViewer[senderV];

first add the From:/Sender: line

currentText ← ViewerTools.GetTiogaContents[senderV];

newTxt ←

Rope.Cat[IF smr.from = NIL THEN "From: " ELSE "Sender: ", WalnutSendOps.userRName];

addedTxtLength ← newTxt.Length[];

InsertIntoViewer[senderV, newTxt, 0, WalnutSendOps.labelFont];

now put the date at the very front

newTxt ← Rope.Concat["Date: ", InternalRFC822Date[BasicTime.nullGMT, TRUE]];

addedTxtLength ← newTxt.Length[] + addedTxtLength + 1;

InsertIntoViewer[senderV, newTxt, 0, WalnutSendOps.labelFont];

contents ← ViewerTools.GetTiogaContents[senderV];

note that there is guaranteed to be formatting since we added some to make things look nice

{ last: INT ← contents.contents.Length[] - 1;

IF contents.contents.Fetch[last] = '\000 THEN -- NULL for padding

{ smr.fullText ← Rope.Substr[contents.contents, 1, last-1];

formatting ← Rope.Concat["\000", contents.formatting] }

ELSE

{ smr.fullText ← Rope.Substr[contents.contents, 1];

formatting ← contents.formatting } };

IF smr.subject.Length[] > 40 THEN

smr.subject ← Rope.Concat[Rope.Substr[smr.subject, 0, 35], " ..."];

smr.subject ← Rope.Cat[" \"", smr.subject, "\" "];

SenderReport["... Sending "]; SenderReport[smr.subject];

IF senderInfo.successfullySent ← sendOk ← SendIt[smr, senderInfo, formatting]

THEN

{ SenderReport[smr.subject]; SenderReport[" has been delivered\n"];

senderInfo.prevMsg ← currentText;

}

ELSE

{ DeleteChars[senderV, addedTxtLength];

SenderReport[smr.subject]; SenderReport[" NOT sent\n"];

};

END;

RFC822Date: PUBLIC PROC[gmt: BasicTime.GMT ← BasicTime.nullGMT] RETURNS[date: ROPE] =

generates arpa standard time, dd mmm yy hh:mm:ss zzz

{ RETURN[InternalRFC822Date[gmt, FALSE]] };

InternalRFC822Date: PROC[gmt: BasicTime.GMT, withDay: BOOL] RETURNS[date: ROPE] =

generates arpa standard time, dd mmm yy hh:mm:ss zzz

BEGIN OPEN IO;

upt: BasicTime.Unpacked ←

BasicTime.Unpack[IF gmt = BasicTime.nullGMT THEN BasicTime.Now[] ELSE gmt];

zone: ROPE;

month, tyme, year: ROPE;

timeFormat: ROPE = "%02g:%02g:%02g %g"; -- "hh:mm:ss zzz"

dateFormat: ROPE = "%2g %g %g %g"; -- "dd mmm yy timeFormat"

arpaNeg: BOOL ← upt.zone > 0;

aZone: INT ← ABS[upt.zone];

zDif: INT ← aZone / 60;

zMul: INT ← zDif * 60;

IF (zMul = aZone) AND arpaNeg THEN

{ IF upt.dst = yes THEN

SELECT zDif FROM

0 => zone ← "UT";

4 => zone ← "EDT";

5 => zone ← "CDT";

6 => zone ← "MDT";

8 => zone ← "PDT";

ENDCASE

ELSE

SELECT zDif FROM

0 => zone ← "UT";

5 => zone ← "EST";

6 => zone ← "CST";

7 => zone ← "MST";

8 => zone ← "PST";

ENDCASE;

};

IF zone = NIL THEN

{ mm: INT ← aZone - zMul;

zone ← PutFR[IF arpaNeg THEN "-%02g%02g" ELSE "+%02g%02g", int[zDif], int[mm]];

};

SELECT upt.month FROM

January => month ← "Jan";

February => month ← "Feb";

March => month ← "Mar";

April => month ← "Apr";

May => month ← "May";

June => month ← "Jun";

July => month ← "Jul";

August => month ← "Aug";

September => month ← "Sep";

October => month ← "Oct";

November => month ← "Nov";

December => month ← "Dec";

unspecified => ERROR;

ENDCASE => ERROR;

year ← Rope.Substr[PutFR[NIL, int[upt.year]], 2];

tyme ← PutFR[timeFormat, int[upt.hour], int[upt.minute], int[upt.second], rope[zone]];

date ← PutFR[dateFormat, int[upt.day], rope[month], rope[year], rope[tyme]];

IF withDay THEN {

dayOfWeek: ROPE;

SELECT upt.weekday FROM

Monday => dayOfWeek ← "Mon, ";

Tuesday => dayOfWeek ← "Tue, ";

Wednesday => dayOfWeek ← "Wed, ";

Thursday => dayOfWeek ← "Thu, ";

Friday => dayOfWeek ← "Fri, ";

Saturday => dayOfWeek ← "Sat, ";

Sunday => dayOfWeek ← "Sun, ";

ENDCASE => dayOfWeek ← "";

date ← dayOfWeek.Concat[date];

};

END;

ShowErrorFeedback: PUBLIC PROC[v: Viewer, start, end: INT] =

BEGIN OPEN TiogaOps;

ENABLE UNWIND => GOTO exit;

startLoc, endLoc: Location;

thisV: Ref = ViewerDoc[v];

beginning: Location ← [FirstChild[thisV], 0];

startLoc ← LocRelative[beginning, start];

endLoc ← LocRelative[beginning, end];

SetSelection[viewer: v, start: startLoc, end: endLoc, which: feedback];

EXITS

exit => NULL;

END;

InsertIntoViewer: PUBLIC PROC

[v: Viewer, what: ROPE, where: INT, labelFont: ROPE, changeSelection: BOOL ← FALSE] = {

prefix: ROPE ← Rope.Substr[ what, 0, Rope.Find[s1: what, s2: ":"] ];

field: ROPE ← Rope.Replace[base: what, start: 0, len: prefix.Length, with: NIL];

InternalInsert[v, prefix, field, where, labelFont, changeSelection];

};

InternalInsert: PROC

[v: Viewer, prefix, field: ROPE, where: INT, labelFont: ROPE, changeSelection: BOOL ← FALSE] =

BEGIN OPEN TiogaOps;

thisV: Ref = ViewerDoc[v];

InsertChars: PROC[root: Ref] =

BEGIN

insertLoc: Location;

prevV: Viewer;

prevStart, prevEnd: Location;

prevLevel: SelectionGrain;

cb, pd: BOOL;

IF where < 0 THEN insertLoc ← LastLocWithin[LastChild[thisV]]

ELSE insertLoc ← LocRelative[[FirstChild[thisV], 0], where];

[prevV, prevStart, prevEnd, prevLevel, cb, pd] ← GetSelection[primary];

ViewerTools.EnableUserEdits[v];

SelectPoint[v, insertLoc, primary];

IF where # 0 THEN TiogaOps.Break[]; -- make a new node

IF labelFont # NIL THEN TiogaOps.SetLooks[labelFont, caret];

TiogaOps.InsertRope[prefix];

IF labelFont # NIL THEN TiogaOps.ClearLooks[caret];

TiogaOps.InsertRope[field];

IF where = 0 THEN TiogaOps.Break[]; -- make a new node

ViewerTools.InhibitUserEdits[v];

IF ~changeSelection AND (prevV # v) AND (prevV#NIL) AND ~prevV.destroyed THEN

SetSelection[prevV, prevStart, prevEnd, prevLevel, cb, pd !

TiogaOps.SelectionError => CONTINUE];

END;

LockViewerOpen[v];

IF thisV = NIL THEN InsertChars[thisV] ELSE CallWithLocks[InsertChars, thisV];

ReleaseOpenViewer[v];

END;

DeleteChars: PUBLIC ENTRY PROC[v: Viewer, num: INT] =

BEGIN ENABLE UNWIND => NULL;

IF num # 0 THEN DeleteLeadingChars[v, num]

END;

DeleteLeadingChars: INTERNAL PROC[v: Viewer, num: INT] =

BEGIN OPEN TiogaOps;

thisV: Ref ← ViewerDoc[v];

DelChars: PROC[root: Ref] =

BEGIN

prevV: Viewer;

prevStart, prevEnd: Location;

prevLevel: SelectionGrain;

cb, pd: BOOL;

startLoc: Location ← [FirstChild[thisV], 0];

endLoc: Location ← LocRelative[startLoc, num];

[prevV, prevStart, prevEnd, prevLevel, cb, pd] ← GetSelection[primary];

ViewerTools.EnableUserEdits[v];

SetSelection[viewer: v, start: startLoc, end: endLoc];

Delete[];

GoToNextNode[];

Join[];

IF (prevV # v) AND (prevV#NIL) THEN

SetSelection[prevV, prevStart, prevEnd, prevLevel, cb, pd];

END;

IF thisV = NIL THEN DelChars[thisV] ELSE CallWithLocks[DelChars, thisV];

END;

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

SendIt: PROC[smr: SendingRec, senderInfo: SenderInfo, formatting: ROPE] RETURNS[ sent: BOOLEAN] =

{ InitSending: ENTRY PROC =

{ ENABLE UNWIND => NULL;

senderInfo.sendHandle ← GVSend.Create[];

senderInfo.aborted ← FALSE;

};

FinishedSending: ENTRY PROC =

{ ENABLE UNWIND => NULL;

senderInfo.sendHandle ← NIL

};

InitSending[];

sent ← SendMessage[smr, senderInfo, formatting ! GVSend.SendFailed =>

{ IF notDelivered THEN

{ SenderReport["\nCommunication failure during send. Retry?\n"];

IF Confirmation[senderInfo] THEN RETRY

ELSE { sent ← FALSE; CONTINUE }

}

ELSE {

SenderReport["\nCommunication failure, but message delivered\n"];

sent ← TRUE;

CONTINUE;

};

}];

FinishedSending[];

} ;

SendMessage: PROC[smr: SendingRec, senderInfo: SenderInfo, formatting: ROPE]

RETURNS[ sent: BOOLEAN ] = {

DO ENABLE GVSend.SendFailed => CONTINUE; -- try again if SendFailed

h: GVSend.Handle ← senderInfo.sendHandle;

startInfo: GVSend.StartSendInfo;

stepper: LIST OF RName;

tempInteger: INT;

numRecips: INT ← 0;

numValidRecips: INT;

firstInvalidUser: BOOL ← TRUE;

numInvalidUsers: INTEGER ← 0;

InvalidUserProc: PROC [ userNum: INT, userName: RName ] = {

IF firstInvalidUser THEN {SenderReport["\nInvalid user(s): "]; firstInvalidUser ← FALSE};

SELECT numInvalidUsers ← numInvalidUsers + 1 FROM

1 => SenderReport[userName];

IN [2..5] => {SenderReport[", "]; SenderReport[userName]};

6 => SenderReport[", ...\n"];

ENDCASE;

} ;

sent ← FALSE ;

startInfo ← GVSend.StartSend[ handle: senderInfo.sendHandle,

senderPwd: UserCredentials.Get[].password,

sender: WalnutSendOps.userRName,

returnTo: WalnutSendOps.userRName,

validate: TRUE

] ;

SELECT startInfo FROM

badPwd => {SenderReport["\nInvalid password\n"]; RETURN};

badSender => {SenderReport["\nInvalid sender name\n"]; RETURN};

badReturnTo => {SenderReport["\nBad return-to field\n"]; RETURN};

allDown => {SenderReport["\nAll servers are down\n"]; RETURN};

ok => {

stepper ← smr.to;

WHILE stepper # NIL DO

GVSend.AddRecipient[ h, stepper.first ];

numRecips ← numRecips + 1;

stepper ← stepper.rest;

ENDLOOP;

IF CheckForAbortSend[senderInfo] THEN RETURN;

stepper ← smr.cc;

WHILE stepper # NIL DO

GVSend.AddRecipient[ h, stepper.first ] ;

numRecips ← numRecips + 1 ;

stepper ← stepper.rest ;

ENDLOOP ;

IF CheckForAbortSend[senderInfo] THEN RETURN;

IF (numValidRecips ← GVSend.CheckValidity[ h, InvalidUserProc]) = 0 THEN

{ SenderReport["\nThere were NO valid recipients; do you wish to send anyway?\n"];

IF CheckForAbortSend[senderInfo] OR ~Confirmation[senderInfo] THEN

{GVSend.Abort[h]; RETURN};

};

IF numValidRecips # numRecips THEN

{ tempInteger ← numRecips-numValidRecips;

SenderReport[IO.PutFR["\nThere were %g invalid recipients,", IO.int[tempInteger] ]];

SenderReport[" do you wish to send anyway?\n"];

IF CheckForAbortSend[senderInfo] OR ~Confirmation[senderInfo] THEN

{GVSend.Abort[h]; RETURN};

};

IF CheckForAbortSend[senderInfo] THEN RETURN;

SenderReport[IO.PutFR["..sending to %g recipients\n", IO.int[numValidRecips]]];

GVSend.StartItem[h, Text];

AddToItem[h, smr.fullText];

IF formatting#NIL THEN { -- send the formatting info as a second item

GVSend.StartItem[h, WalnutSendOps.TiogaCTRL];

AddToItem[h, formatting]

};

IF smr.voiceID.Length[] # 0 THEN

{ GVSend.StartItem[h, Audio]; AddToItem[h, smr.voiceID] };

ViewerOps.SetMenu[senderInfo.senderV, blankMenu];

IF CheckForAbortSend[senderInfo] THEN RETURN;

GVSend.Send[ h ] ;

sent ← TRUE;

RETURN;

} ;

ENDCASE;

ENDLOOP;

};

AddToItem: PROC [handle: GVSend.Handle, buffer: ROPE] = {

maxChunkSize: INT ~ 10000;

size: INT ~ Rope.Size[buffer];

i: INT ← 0;

UNTIL i = size DO

chunkSize: INT ~ MIN[size-i, maxChunkSize];

GVSend.AddToItem[handle, Rope.Substr[buffer, i, chunkSize]];

i ← i + chunkSize;

ENDLOOP;

};

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

ParseTextToBeSent: PROC[msg: SendingRec] RETURNS[status: SendParseStatus, sPos, mPos: INT] =

BEGIN OPEN GVMailParse;

mLF: WalnutParseMsg.MessageInfo;

tHeaders: LIST OF ROPE ← NIL;

msgText: ROPE ← msg.fullText;

lastCharPos: INT ← msgText.Length[] - 1;

lastCharIsCR: BOOL ← (msgText.Fetch[lastCharPos] = '\n);

countOfRecipients, dlCount: INT ← 0;

pdlStatus: SendParseStatus ← ok;

GetNextMsgChar: PROC[] RETURNS [ch: CHAR] =

{ IF mPos <= lastCharPos THEN ch ← Rope.Fetch[msgText, mPos]

ELSE IF (mPos=lastCharPos+1) AND ~lastCharIsCR THEN ch ← '\n

ELSE ch ← endOfInput;

mPos ← mPos + 1;

};

RNameListField: PROC[index: WalnutParseMsg.MessageFieldIndex] =

BEGIN

fieldBody, fbEnd: LIST OF RName ← NIL;

ParsePvtDL: PROC [fname: ROPE] = {

pdlH: ParseHandle ← NIL; -- need new handle for each PDL

pdlStream: IO.STREAM ← NIL;

fullName: ROPE;

BEGIN ENABLE UNWIND => {

IF pdlH # NIL THEN FinalizeParse[pdlH];

IF pdlStream # NIL THEN pdlStream.Close[];

};

GetPDLChar: PROC RETURNS [c: CHAR] = {

-- No CR's allowed in file.

IF pdlStream # NIL AND NOT pdlStream.EndOf[] THEN

{ IF (c ← pdlStream.GetChar[]) = '; THEN c ← endOfInput }

ELSE c ← endOfInput;

};

-- Extract filename from between quotes

IF fname.Fetch[0] = '" THEN

fname ← Rope.Substr[fname, 1, Rope.Length[fname]-2];

BEGIN

cp: FS.ComponentPositions;

wDir: ROPE ← UserProfile.Token["WalnutSend.DefaultDLDir"];

[fullName, cp, ] ← FS.ExpandName[fname, wDir ! FS.Error => {

SenderReport[IO.PutFR["\n%g\n", IO.rope[error.explanation]]];

pdlStatus ← pdlSyntaxError;

CONTINUE} ];

IF pdlStatus = pdlSyntaxError THEN RETURN;

IF cp.ext.length = 0 THEN fullName ← fullName.Concat[".dl"];

END;

pdlH ← InitializeParse[];

pdlStream ← FS.StreamOpen[fullName ! FS.Error => {

SenderReport[IO.PutFR["\n%g\n", IO.rope[error.explanation]]];

pdlStatus ← pdlNotFound;

CONTINUE} ];

IF pdlStream = NIL THEN RETURN;

check the syntax of the pdl

IF pdlStream.EndOf[] THEN { pdlStream.SetIndex[0]; EXIT } -- no : found

ELSE {

c: CHAR ← pdlStream.GetChar[];

IF c = ': THEN EXIT; -- leave positioned after :

IF c = '\n THEN {

SenderReport["\nCR's not allowed in private dl's\n"];

pdlStream.Close[];

pdlStatus ← pdlSyntaxError;

RETURN;

};

ENDLOOP;

pdlH ← InitializeParse[];

ParseNameList[pdlH, GetPDLChar, AnotherRName, NIL];

FinalizeParse[pdlH]; pdlH ← NIL;

pdlStream.Close[];

END;

};

AnotherRName: PROC[r1, r2: ROPE, isFile, isNested: BOOL] RETURNS [ROPE, BOOLEAN] =

BEGIN

name: ROPE;

IF isFile THEN {

status ← includesPrivateDL;

ParsePvtDL[r1];

RETURN[NIL, FALSE];

};

name ← WalnutParseMsg.CanonicalName[r1, r2];

IF fbEnd=NIL THEN fbEnd ← fieldBody ← CONS[name, NIL]

ELSE fbEnd ← fbEnd.rest ← CONS[name, NIL];

-- IF isFile THEN status ← includesPrivateDL

-- ELSE IF name.Find["^"] < 0 THEN countOfRecipients ← countOfRecipients + 1

IF name.Find["^"] < 0 AND name.Find[""] < 0 THEN countOfRecipients ← countOfRecipients + 1

ELSE

{ IF status # includesPrivateDL THEN status ← includesPublicDL;

dlCount ← dlCount + 1

};

RETURN[NIL, FALSE];

END;

ParseNameList[pH, GetNextMsgChar, AnotherRName, NIL];

SELECT index FROM

toF => IF msg.to = NIL THEN msg.to ← fieldBody

ELSE IF fieldBody#NIL THEN msg.to ← RopeList.Append[msg.to, fieldBody];

ccF, cF, bccF => IF msg.cc = NIL THEN msg.cc ← fieldBody

ELSE IF fieldBody#NIL THEN msg.cc ← RopeList.Append[msg.cc, fieldBody];

fromF => msg.from ← fieldBody.first; -- needs to be non-NIL

replyToF => NULL; -- just to syntax check the ReplyTo field

ENDCASE => ERROR;

END;

pH: ParseHandle;

field: ROPE ← NIL;

fieldNotRecognized: BOOL;

mPos ← 0; -- where we are in the fulltext

status ← ok; -- start with good status

pH ← InitializeParse[];

sPos ← mPos;

[field, fieldNotRecognized] ← GetFieldName[pH, GetNextMsgChar ! ParseError =>

{ FinalizeParse[pH]; GOTO errorExit}];

IF ~fieldNotRecognized THEN EXIT;

IF Rope.Equal[field, "Sender", FALSE] OR Rope.Equal[field, "Date", FALSE] THEN

RETURN[fieldNotAllowed, sPos, mPos];

FOR i: WalnutParseMsg.MessageFieldIndex IN WalnutParseMsg.MessageFieldIndex DO

{ mLF ← WalnutParseMsg.messageParseArray[i];

IF Rope.Equal[WalnutParseMsg.messageParseArray[i].name, field, FALSE] THEN

{ fieldNotRecognized ← FALSE;

SELECT mLF.fType FROM

simpleRope =>

SELECT i FROM

fromF => RNameListField[i ! ParseError => GOTO errorExit];

replyToF => {

msg.replyTo ← TRUE;

RNameListField[i ! ParseError => GOTO errorExit];

};

subjectF => msg.subject ← GetFieldBody[pH, GetNextMsgChar];

voiceF => msg.voiceID ← GetFieldBody[pH, GetNextMsgChar];

ENDCASE => [] ← GetFieldBody[pH, GetNextMsgChar, TRUE];

rCatList => [] ← GetFieldBody[pH, GetNextMsgChar, TRUE];

rNameList => RNameListField[i ! ParseError => GOTO errorExit];

ENDCASE => ERROR;

EXIT

};

ENDLOOP;

IF fieldNotRecognized THEN

[] ← GetFieldBody[pH, GetNextMsgChar]; -- skip anything not recognized

ENDLOOP;

now we are positioned at the beginning of the body of the message

FinalizeParse[pH];

msg.endHeadersPos ← mPos - 1;

msg.numRecipients ← countOfRecipients;

msg.numDLs ← dlCount;

IF pdlStatus # ok THEN RETURN[pdlStatus, 0, 0];

EXITS

errorExit => RETURN[syntaxError, sPos, mPos];

END;

move from WalnutDocumentRopeImpl

Create: PUBLIC PROC [doc: TextNode.Ref] RETURNS [r: ROPE] = {

docSize: INT ← TextNode.LocOffset[[doc,0], TextNode.LastLocWithin[doc]];

r ← Rope.MakeRope[base: doc, size: docSize, fetch: Fetch];

IF docSize > 0 THEN {

loc0: TextNode.Location = TextNode.LocRelative[[doc,0], 0];

loc1: TextNode.Location = TextNode.LocRelative[[doc,0], 1];

IF loc0 = loc1 THEN {

RRA: I think that this is a bug! But we have observed this, so we have to correct for it, I think. I wish that this were not the case.

r ← Rope.Substr[r, 1];

};

Fetch: PROC [data: REF, index: INT] RETURNS [CHAR] = {

doc: TextNode.Ref ← NARROW[data];

loc: TextNode.Location = TextNode.LocRelative[[doc,0], index];

n: TextNode.RefTextNode = TextNode.NarrowToTextNode[loc.node];

IF n=NIL THEN ERROR;

IF loc.where >= Rope.Size[n.rope] THEN RETURN ['\n];

RETURN [Rope.Fetch[n.rope, loc.where]]

};

END.