<> <> <> <> <> <> <> <> <<>> <> DIRECTORY BasicTime USING [GMT, Now], Char USING [Code, XCHAR], Convert USING [RopeFromTimeRFC822], IO, MailBasics USING [ItemType, RName, RNameList], MailBasicsItemTypes USING [header, multinationalNote, plainTextForFormatting, tioga1], MailParse, MailSend USING [AddRecipient, AddToItem, Create, MailSendHandle, SendingCredentialsList, StartItem, StartSend], MailSendSidedoor USING [SendWithAbort], MailUtilsBackdoor USING [GetCRTiogaContents, WritePlainCR], MailUtils USING [GetLoggedInUser], Menus, PFS, PFSNames, Rope, RuntimeError USING [BoundsFault], SendMailOps, SendMailInternal, SendMailParseMsg USING [MessageFieldIndex, MessageInfo, messageParseArray], TextEdit USING [FetchChar, Size], TextNode USING [FirstChild, LastLocWithin, Location, LocOffset, LocRelative, Ref], Tioga USING [Node], TiogaIO USING [FromPair], TiogaOps, UserProfile USING [Number, Token], ViewerClasses USING [Viewer], ViewerOps, ViewerTools USING [GetTiogaContents, EnableUserEdits, InhibitUserEdits, TiogaContents]; SendMailImpl: CEDAR MONITOR IMPORTS BasicTime, Char, Convert, IO, MailParse, MailSend, MailSendSidedoor, MailUtilsBackdoor, MailUtils, PFS, PFSNames, Rope, RuntimeError, SendMailParseMsg, SendMailInternal, SendMailOps, TextEdit, TextNode, TiogaIO, TiogaOps, ViewerOps, ViewerTools, UserProfile EXPORTS SendMailInternal, SendMailOps = BEGIN OPEN SendMailInternal, SendMailOps; RName: TYPE = MailBasics.RName; ROPE: TYPE = Rope.ROPE; Viewer: TYPE = ViewerClasses.Viewer; OutBoxMsg: TYPE = SendMailOps.OutBoxMsg; testingFormatting: BOOL ¬ TRUE; -- works in gv land sendingCredentials: MailSend.SendingCredentialsList ¬ NIL; needUserName: BOOL ¬ TRUE; <<************************************************************************>> Send: PUBLIC PROC[v: Viewer, doClose: BOOL ¬ FALSE, transport: ATOM ¬ NIL] RETURNS[sent: BOOL] = { oldMenu: Menus.Menu = v.menu; v.inhibitDestroy ¬ TRUE; sent ¬ FALSE; BEGIN ENABLE UNWIND => GOTO out; ViewerOps.SetMenu[v, sendingMenu]; sent ¬ InternalSendMsg[v, doClose, transport, TRUE]; EXITS out => NULL; END; ViewerOps.SetMenu[v, oldMenu]; v.inhibitDestroy ¬ FALSE; }; SendUnformatted: PUBLIC PROC[v: Viewer, doClose: BOOL ¬ FALSE, transport: ATOM ¬ NIL] RETURNS[sent: BOOL] = { oldMenu: Menus.Menu = v.menu; v.inhibitDestroy ¬ TRUE; sent ¬ FALSE; BEGIN ENABLE UNWIND => GOTO out; ViewerOps.SetMenu[v, sendingMenu]; sent ¬ InternalSendMsg[v, doClose, transport, FALSE]; EXITS out => NULL; END; ViewerOps.SetMenu[v, oldMenu]; v.inhibitDestroy ¬ FALSE; }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> AppendHeaderLine: PUBLIC PROC[v: Viewer, line: ROPE, changeSelection: BOOL ¬ FALSE] = { ENABLE RuntimeError.BoundsFault => GOTO exit; text: ROPE; i: INT ¬ 0; ch: CHAR; TRUSTED {text ¬ CreateRopeForTextNode[LOOPHOLE [TiogaOps.ViewerDoc[v]]]}; DO -- find the double CR at the end of the headers UNTIL (ch ¬ text.Fetch[i]) = '\r DO i ¬ i + 1; ENDLOOP; IF (ch ¬ text.Fetch[i ¬ i + 1]) = '\r THEN EXIT; ENDLOOP; InsertIntoViewer[v, line, i-1, SendMailOps.labelFont, changeSelection]; ViewerTools.EnableUserEdits[v]; EXITS exit => SenderReport["Malformed headers; append of %g not done", [rope[line]] ]; }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> InternalSendMsg: PROC[senderV: Viewer, doClose: BOOL, transport: ATOM, sendFormatted: BOOL] RETURNS[sendOk: BOOL] = { status: SendParseStatus; sPos, mPos: INT; formatting: ROPE; smr: SendingRec; addedTxtLength: INT; newTxt: ROPE; textNodeRef: TextNode.Ref ¬ NIL; allowDL, dlNotAllowed: BOOL ¬ FALSE; contents, currentText: ViewerTools.TiogaContents; senderInfo: SenderInfo ¬ NARROW[ViewerOps.FetchProp[senderV, $SenderInfo]]; numForReplyTo: INT ¬ UserProfile.Number["SendMailTool.MaxRecipientsWithoutReplyTo", 10]; endHeadersPosForReplyTo: INT; ReplyToOption: PROC RETURNS[continue: BOOL ¬ TRUE] = { howToReply: HowToReplyTo ¬ self; IF ~replyToSelf THEN { oldM: Menus.Menu ¬ senderV.menu; IF CheckForAbortSend[senderInfo] THEN RETURN; ViewerOps.SetMenu[senderV, replyToMenu]; SendMailOps.SenderReport["..."]; IF smr.numPublicDLs > 0 THEN SenderReport[" , %g public DLs", [integer[smr.numPublicDLs]] ]; IF smr.numPrivateDLs > 0 THEN SenderReport[", %g private DLs", [integer[smr.numPrivateDLs]] ]; IF smr.numRecipients > 0 THEN SenderReport[", %g other recipients", [integer[smr.numRecipients]] ]; SendMailOps.SenderReport["; please choose Reply-To option"]; 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 { ViewerTools.EnableUserEdits[senderV]; InternalInsert[senderV, "Reply-to: ", NameForXport[transport], endHeadersPosForReplyTo, SendMailOps.labelFont]; }; ViewerTools.EnableUserEdits[senderV]; -- make sure can edit SELECT TRUE FROM ( howToReply = cancel ) => { SenderReport["\nDelivery cancelled. Reply-to: has been added\n"]; continue ¬ FALSE; }; ENDCASE => allowDL ¬ TRUE; }; DoReader: PROC ~ { tc: ViewerTools.TiogaContents ~ ViewerTools.GetTiogaContents[senderV]; textNodeRef: Tioga.Node ~ TiogaIO.FromPair[[tc.contents, tc.formatting]]; contents ¬ MailUtilsBackdoor.GetCRTiogaContents[textNodeRef]; IF transport = $xns THEN { smr.fullText ¬ MailUtilsBackdoor.WritePlainCR[textNodeRef]; formatting ¬ contents.formatting; } ELSE { 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 NOT sendFormatted THEN formatting ¬ NIL; }; IF transport = NIL THEN transport ¬ $xns; IF numForReplyTo > 20 THEN numForReplyTo ¬ 20; -- hard limit 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 { textNodeRef ¬ LOOPHOLE [TiogaOps.ViewerDoc[senderV]] }; smr.fullText ¬ CreateRopeForTextNode[textNodeRef]; [status, sPos, mPos] ¬ ParseText[smr, transport]; endHeadersPosForReplyTo ¬ smr.endHeadersPos-1; SELECT status FROM fieldNotAllowed => { IF sPos # mPos THEN { substr: ROPE = Rope.Substr[smr.fullText, MAX[0, sPos-1], mPos-sPos]; ShowErrorFeedback[senderV, sPos, mPos]; SenderReport["\n* * * %g field is not allowed\n", [rope[substr]] ] } ELSE SenderReport[" field at pos %g is not allowed\n", [integer[sPos]] ]; Blink[senderV]; RETURN }; syntaxError => { IF sPos # mPos THEN { substr: ROPE = Rope.Substr[smr.fullText, MAX[0, sPos-1], mPos-sPos]; ShowErrorFeedback[senderV, sPos, mPos]; SenderReport["\n* * * Syntax error on line beginning with %g\n", [rope[substr]] ]; } ELSE SenderReport["\n* * * Syntax error at position %g\n", [integer[sPos]] ]; Blink[senderV]; RETURN }; pdlNotFound, pdlSyntaxError => { Blink[senderV]; RETURN }; ENDCASE => NULL; IF CheckForAbortSend[senderInfo] THEN RETURN; allowDL ¬ smr.replyTo; IF (status = includesPublicDL OR status = includesPrivateDL OR smr.numRecipients > numForReplyTo) AND ~smr.replyTo THEN { IF ~replyToSelf THEN IF NOT ReplyToOption[] THEN RETURN; IF CheckForAbortSend[senderInfo] THEN RETURN; }; IF doClose AND ~senderV.iconic THEN ViewerOps.CloseViewer[senderV]; DO --for adding reply-to currentText ¬ GetCRTiogaContents[senderV]; <> newTxt ¬ Rope.Concat[IF smr.from.name = NIL THEN "From: " ELSE "Sender: ", MailUtils.GetLoggedInUser[transport] ]; addedTxtLength ¬ newTxt.Length[]; InsertIntoViewer[senderV, newTxt, 0, SendMailOps.labelFont]; <> newTxt ¬ Rope.Concat["Date: ", Convert.RopeFromTimeRFC822[BasicTime.Now[], TRUE, TRUE]]; addedTxtLength ¬ newTxt.Length[] + addedTxtLength + 1; InsertIntoViewer[senderV, newTxt, 0, SendMailOps.labelFont]; <> DoReader[]; IF smr.subject.Length[] > 40 THEN smr.subject ¬ Rope.Concat[Rope.Substr[smr.subject, 0, 35], " ..."]; smr.subject ¬ Rope.Cat[" \"", smr.subject, "\" "]; IF ( smr.endHeadersPos ¬ Rope.Find[smr.fullText, "\r\r", 0] ) < 0 THEN smr.endHeadersPos ¬ smr.fullText.Length[] ELSE smr.endHeadersPos ¬ smr.endHeadersPos + 2; senderInfo.currentOutBox ¬ NEW[SendMailOps.OutBoxMsgRec ¬ [contents, currentText, smr.subject, NIL] ]; SenderReport["... Sending %g", [rope[smr.subject]] ]; [sendOk, dlNotAllowed] ¬ SendIt[smr, senderInfo, formatting, contents.contents, allowDL, transport]; SELECT TRUE FROM ( senderInfo.successfullySent ¬ sendOk ) => { SenderReport["%g has been delivered\n", [rope[smr.subject]] ]; AddToOutBox[ senderInfo.currentOutBox ]; RETURN; }; dlNotAllowed => { DeleteChars[senderV, addedTxtLength]; ViewerTools.InhibitUserEdits[senderV]; -- don't allow edits while waiting IF NOT ReplyToOption[] THEN RETURN; allowDL ¬ TRUE; LOOP; }; ENDCASE => { DeleteChars[senderV, addedTxtLength]; SenderReport["%g NOT sent\n", [rope[smr.subject]] ]; RETURN; }; ENDLOOP; }; GetCRTiogaContents: PUBLIC PROC[viewer: Viewer] RETURNS [contents: ViewerTools.TiogaContents ¬ NIL] = { tc: ViewerTools.TiogaContents ~ ViewerTools.GetTiogaContents[viewer]; textNodeRef: Tioga.Node ~ TiogaIO.FromPair[[tc.contents, tc.formatting]]; contents ¬ MailUtilsBackdoor.GetCRTiogaContents[textNodeRef]; }; AddToOutBox: PUBLIC ENTRY PROC[outBoxMsg: OutBoxMsg] = { ENABLE UNWIND => NULL; outBoxMsg.next ¬ SendMailOps.outBox; SendMailOps.outBox ¬ outBoxMsg; IF SendMailOps.outBoxLength > 0 THEN { count: INT ¬ 1; oB: OutBoxMsg ¬ SendMailOps.outBox; DO IF oB.next = NIL THEN EXIT; IF count = SendMailOps.outBoxLength THEN { oB.next ¬ NIL; EXIT }; count ¬ count + 1; oB ¬ oB.next; ENDLOOP; }; }; ChangeOutBoxLength: PUBLIC ENTRY PROC[new: INT] RETURNS[old: INT] = { ENABLE UNWIND => NULL; old ¬ SendMailOps.outBoxLength; SendMailOps.outBoxLength ¬ new; }; GetOutBoxMsgForSender: PUBLIC PROC[sender: Viewer] RETURNS[OutBoxMsg] = { senderInfo: SenderInfo ¬ NARROW[ViewerOps.FetchProp[sender, $SenderInfo]]; RETURN[senderInfo.currentOutBox]; }; 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, textForFormatting: ROPE, allowDL: BOOL, transport: ATOM] RETURNS[ sent, dlNotAllowed: BOOL] = { InitSending: ENTRY PROC = { ENABLE UNWIND => NULL; senderInfo.sendHandle ¬ MailSend.Create[]; senderInfo.aborted ¬ FALSE; }; FinishedSending: ENTRY PROC = { ENABLE UNWIND => NULL; senderInfo.sendHandle ¬ NIL }; InitSending[]; [sent, dlNotAllowed] ¬ SendMessage[smr, senderInfo, formatting, textForFormatting, TRUE, allowDL, transport]; FinishedSending[]; }; SendMessage: PROC[smr: SendingRec, senderInfo: SenderInfo, formatting, textForFormatting: ROPE, validateFlag, allowDL: BOOL, transport: ATOM] RETURNS[ sent, noDlsAllowed: BOOL ¬ FALSE ] = { msH: MailSend.MailSendHandle ¬ senderInfo.sendHandle; stepper: LIST OF RName; numRecips: INT ¬ 0; failureReason: ROPE; firstInvalidUser: BOOL ¬ TRUE; invalidRecipients, dlsNotAllowed, fakeDls: MailBasics.RNameList; <> DO MailSend.StartSend[ msH: senderInfo.sendHandle, credentialsList: sendingCredentials]; stepper ¬ smr.to; WHILE stepper # NIL DO IF stepper.first.name # NIL THEN { MailSend.AddRecipient[ msH, stepper.first ] ; numRecips ¬ numRecips + 1 ; }; stepper ¬ stepper.rest; ENDLOOP; IF CheckForAbortSend[senderInfo] THEN RETURN; stepper ¬ smr.cc; WHILE stepper # NIL DO IF stepper.first.name # NIL THEN { MailSend.AddRecipient[ msH, stepper.first ] ; numRecips ¬ numRecips + 1 ; }; stepper ¬ stepper.rest ; ENDLOOP ; IF CheckForAbortSend[senderInfo] THEN RETURN; SenderReport[".. sending to %g recipients\n", [integer[numRecips]] ]; MailSend.StartItem[msH, MailBasicsItemTypes.header]; MailSend.AddToItem[msH, Rope.Substr[smr.fullText, 0, smr.endHeadersPos] ]; MailSend.StartItem[msH, MailBasicsItemTypes.multinationalNote]; MailSend.AddToItem[msH, Rope.Substr[smr.fullText, smr.endHeadersPos] ]; IF formatting # NIL THEN { MailSend.StartItem[msH, MailBasicsItemTypes.tioga1]; MailSend.AddToItem[msH, formatting]; IF transport # $gv THEN { MailSend.StartItem[msH, MailBasicsItemTypes.plainTextForFormatting]; MailSend.AddToItem[msH, textForFormatting]; }; }; <> <<{ MailSend.StartItem[h, Audio]; AddToItem[h, smr.voiceID] };>> IF CheckForAbortSend[senderInfo] THEN RETURN; senderInfo.startSendTime ¬ BasicTime.Now[]; [sent, failureReason, invalidRecipients, dlsNotAllowed, fakeDls] ¬ MailSendSidedoor.SendWithAbort[msH, validateFlag, FALSE, allowDL, SenderAbortProc, transport]; IF sent THEN RETURN; IF ( invalidRecipients = NIL ) AND ( dlsNotAllowed = NIL ) THEN { IF ( fakeDls = NIL ) THEN SenderReport[failureReason] ELSE { allowDL ¬ TRUE; numRecips ¬ 0; LOOP }; }; IF ( invalidRecipients # NIL ) THEN { SenderReport["\nThe following are invalid recipients: "]; SenderReport["(%g) %g", [atom[invalidRecipients.first.ns]], [rope[invalidRecipients.first.name]] ]; FOR rL: MailBasics.RNameList ¬ invalidRecipients.rest, rL.rest UNTIL rL = NIL DO SenderReport[", (%g) %g", [atom[rL.first.ns]], [rope[rL.first.name]] ]; ENDLOOP; }; IF ( dlsNotAllowed # NIL ) THEN { nDLs: INT ¬ 1; SenderReport["\nThe following appear to be dl recipients (dl recipients should have a Reply-To field): "]; SenderReport["(%g) %g", [atom[dlsNotAllowed.first.ns]], [rope[dlsNotAllowed.first.name]] ]; FOR rL: MailBasics.RNameList ¬ dlsNotAllowed.rest, rL.rest UNTIL rL = NIL DO SenderReport[", (%g) %g", [atom[rL.first.ns]], [rope[rL.first.name]] ]; nDLs ¬ nDLs.SUCC; ENDLOOP; noDlsAllowed ¬ TRUE; smr.numPublicDLs ¬ nDLs; smr.numRecipients ¬ smr.numRecipients - nDLs; }; SenderReport["\n"]; RETURN; ENDLOOP; }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> ParseText: PUBLIC PROC[msg: SendingRec, transport: ATOM] RETURNS[status: SendParseStatus, sPos, mPos: INT] = { OPEN MailParse; mLF: SendMailParseMsg.MessageInfo; tHeaders: LIST OF ROPE ¬ NIL; msgText: ROPE ¬ msg.fullText; lastCharPos: INT ¬ msgText.Length[] - 1; lastCharIsCR: BOOL ¬ ( msgText.Fetch[lastCharPos] = '\r ); countOfRecipients, publicDLCount, privateDLCount: 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 ¬ '\r ELSE ch ¬ endOfInput; mPos ¬ mPos + 1; }; RNameListField: PROC[index: SendMailParseMsg.MessageFieldIndex] = { fieldBody, fbEnd: LIST OF RName ¬ NIL; ParsePvtDL: PROC [fname: ROPE] = { pdlH: ParseHandle ¬ NIL; -- need new handle for each PDL pdlStream: IO.STREAM ¬ NIL; fullPath, reallyName: PFS.PATH; 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 ¬ endOfList } ELSE c ¬ endOfList; }; -- Extract filename from between quotes IF fname.Fetch[0] = '" THEN fname ¬ Rope.Substr[fname, 1, Rope.Length[fname]-2]; BEGIN wDir: ROPE ¬ UserProfile.Token["SendMailTool.DefaultDLDir"]; fullPath ¬ PFSNames.ExpandName[PFS.PathFromRope[fname], PFS.PathFromRope[wDir] ! PFS.Error => { SenderReport["\nPFS.Error: %g\n", [rope[error.explanation]] ]; pdlStatus ¬ pdlSyntaxError; CONTINUE} ]; IF pdlStatus = pdlSyntaxError THEN RETURN; END; pdlH ¬ InitializeParse[]; reallyName ¬ PFS.FileLookup[fullPath, LIST["dl"] ! PFS.Error => CONTINUE]; IF reallyName = NIL THEN { SenderReport["\nFileLookup failed for %g\n", [rope[fname]] ]; RETURN; }; pdlStream ¬ PFS.StreamOpen[reallyName ! PFS.Error => { SenderReport["\nPFS.Error: (file %g) %g\n", [rope[PFS.RopeFromPath[reallyName]]], [rope[error.explanation]] ]; pdlStatus ¬ pdlNotFound; CONTINUE} ]; IF pdlStream = NIL THEN RETURN; <<>> <> BEGIN insideQuote: BOOL ¬ FALSE; DO IF pdlStream.EndOf[] THEN { pdlStream.SetIndex[0]; EXIT } -- no : found ELSE { c: CHAR = pdlStream.GetChar[]; SELECT c FROM ': => IF NOT insideQuote THEN EXIT; -- leave positioned after : '" => insideQuote ¬ NOT insideQuote; '\r => { SenderReport["\nCR's not allowed in private dl's\n"]; pdlStream.Close[]; pdlStatus ¬ pdlSyntaxError; RETURN; }; ENDCASE => NULL; }; ENDLOOP; END; pdlH ¬ InitializeParse[]; NameList[pdlH, transport, GetPDLChar, AnotherRName, NIL]; FinalizeParse[pdlH]; pdlH ¬ NIL; pdlStream.Close[]; END; }; AnotherRName: PROC[rName: RName] RETURNS [nameToWrite: ROPE ¬ NIL] = { name: ROPE = rName.name; IF rName.ns = $file THEN { status ¬ includesPrivateDL; privateDLCount ¬ privateDLCount + 1; ParsePvtDL[name]; RETURN; }; <> IF fbEnd=NIL THEN fbEnd ¬ fieldBody ¬ CONS[rName, NIL] ELSE fbEnd ¬ fbEnd.rest ¬ CONS[rName, NIL]; IF ( name.Find["^"] < 0 ) AND ( name.Find["­"] < 0 ) THEN countOfRecipients ¬ countOfRecipients + 1 ELSE IF status = includesPrivateDL THEN privateDLCount ¬ privateDLCount + 1 ELSE { status ¬ includesPublicDL; publicDLCount ¬ publicDLCount + 1; }; }; DRNameListAppend: PROC[one, two: LIST OF RName] RETURNS[LIST OF RName] = { <> tail: LIST OF RName; IF one = NIL THEN RETURN[two]; tail ¬ one; UNTIL tail.rest = NIL DO tail ¬ tail.rest; ENDLOOP; tail.rest ¬ two; RETURN[one]; }; NameList[pH, transport, GetNextMsgChar, AnotherRName, NIL]; SELECT index FROM toF => IF msg.to = NIL THEN msg.to ¬ fieldBody ELSE IF fieldBody#NIL THEN msg.to ¬ DRNameListAppend[msg.to, fieldBody]; ccF, cF, bccF => IF msg.cc = NIL THEN msg.cc ¬ fieldBody ELSE IF fieldBody#NIL THEN msg.cc ¬ DRNameListAppend[msg.cc, fieldBody]; fromF => IF fieldBody # NIL THEN msg.from ¬ fieldBody.first ELSE ERROR MailParse.ParseError[badFieldBody]; -- needs to be non-NIL replyToF => NULL; -- just to syntax check the ReplyTo field ENDCASE => ERROR; }; pH: ParseHandle; field: ROPE ¬ NIL; fieldNotRecognized: BOOL; mPos ¬ 0; -- where we are in the fulltext status ¬ ok; -- start with good status pH ¬ InitializeParse[]; DO sPos ¬ mPos; field ¬ GetFieldName[pH, GetNextMsgChar ! ParseError => { FinalizeParse[pH]; GOTO errorExit}]; IF field = NIL THEN EXIT; IF Rope.Equal[field, "Sender", FALSE] OR Rope.Equal[field, "Date", FALSE] THEN RETURN[fieldNotAllowed, sPos, mPos]; fieldNotRecognized ¬ TRUE; FOR i: SendMailParseMsg.MessageFieldIndex IN SendMailParseMsg.MessageFieldIndex DO { mLF ¬ SendMailParseMsg.messageParseArray[i]; IF Rope.Equal[SendMailParseMsg.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; <> FinalizeParse[pH]; msg.endHeadersPos ¬ mPos - 1; msg.numRecipients ¬ countOfRecipients; msg.numPublicDLs ¬ publicDLCount; msg.numPrivateDLs ¬ privateDLCount; IF pdlStatus # ok THEN RETURN[pdlStatus, 0, 0]; EXITS errorExit => RETURN[syntaxError, sPos, mPos]; }; Blink: PROC[v: Viewer] = { ViewerOps.BlinkIcon[v, IF v.iconic THEN 0 ELSE 1]}; NameForXport: PROC[transport: ATOM] RETURNS[who: ROPE] = { retry: BOOL ¬ TRUE; DO FOR rL: MailBasics.RNameList ¬ SendMailOps.userRNameList, rL.rest UNTIL rL=NIL DO IF rL.first.ns # transport THEN LOOP; who ¬ rL.first.name; EXIT; ENDLOOP; IF ( who = NIL ) AND ( SendMailOps.userRNameList # NIL ) THEN who ¬ SendMailOps.userRNameList.first.name; IF who # NIL THEN RETURN; IF retry THEN DoUserNameAndRegistry[] ELSE RETURN; retry ¬ FALSE; ENDLOOP; }; <> CreateRopeForTextNode: 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]; <> r ¬ Rope.Substr[r, TextNode.LocOffset[[doc, 0], [TextNode.FirstChild[doc], 0]]]; }; Fetch: PROC [data: REF, index: INT] RETURNS [CHAR] ~ { doc: TextNode.Ref ~ NARROW[data]; loc: TextNode.Location ~ TextNode.LocRelative[[doc, 0], index]; IF loc.where < TextEdit.Size[loc.node] THEN { char: Char.XCHAR ~ TextEdit.FetchChar[loc.node, loc.where]; RETURN[VAL[Char.Code[char]]]; -- char MOD 256 } ELSE RETURN['\r]; }; END.