<> <> <> <> <> <> <> <> <> <> <> <> <> <<>> DIRECTORY BasicTime USING [GMT, Now], Convert USING [RopeFromTimeRFC822], IO, Icons USING [IconFlavor], MailAnswer USING [MakeHeader], MailBasics USING [ItemType, RName, RNameList], MailBasicsItemTypes USING [header, multinationalNote, plainTextForFormatting, tioga1], MailParse USING [endOfInput, FinalizeParse, GetFieldBody, GetFieldName, InitializeParse, ParseError, ParseHandle, NameList], MailSend USING [AddRecipient, AddToItem, Create, MailSendHandle, Send, SendingCredentials, SendingCredentialsList, StartItem, StartSend], MailUtilsBackdoor USING [GetCRTiogaContents, WritePlainCR], PeanutCredentials USING [sendingCredentials, simpleUserName, userRNameList], PeanutParse USING [MessageFieldIndex, MessageInfo], PeanutProfile USING [ccField, ccToSelf, fixupXNSAddresses, messageNodeFormat, outgoingMailFile, toBeforeSubject, recipients, signature], PeanutSendMail USING [], PeanutWindow USING [dirtyMailMessageIcon, dirtyMessageSetIcon, mailMessageIcon, messageSetIcon, OutputRope, CopyMessages], Prop, Rope, TextNode, EditSpanSupport, TiogaAccess USING [CopyNode, Create, DoneWith, EndOf, FromNode, Looks, Nest, Put, Reader, SkipToNextNode, TiogaChar, Writer], TiogaAccessViewers USING [FromViewer, WriteViewer], TiogaOps, TiogaOpsDefs USING [], ViewerClasses USING [Lock, Viewer], ViewerEvents USING [RegisterEventProc, ViewerEvent], ViewerOps USING [CloseViewer, DestroyViewer, OpenIcon, PaintViewer], ViewerTools USING [GetSelectedViewer, MakeNewTextViewer, SelPosRec, SetSelection, TiogaContents]; PeanutSendMailImpl: CEDAR MONITOR IMPORTS BasicTime, Convert, IO, MailAnswer, MailParse, MailSend, MailUtilsBackdoor, PeanutCredentials, PeanutProfile, PeanutWindow, Rope, TextNode, EditSpanSupport, TiogaAccess, TiogaAccessViewers, TiogaOps, ViewerEvents, ViewerOps, ViewerTools EXPORTS PeanutSendMail, PeanutParse = BEGIN Viewer: TYPE = ViewerClasses.Viewer; ROPE: TYPE = Rope.ROPE; RName: TYPE = MailBasics.RName; SendMsgRecObject: TYPE = RECORD[ fullText: ROPE, -- text to be sent from: MailBasics.RName, -- The From: field to: LIST OF MailBasics.RName, cc: LIST OF MailBasics.RName, subject: ROPE, -- The Subject: field voiceID: ROPE ¬ NIL, -- the ID for a voice message replyTo: BOOL ¬ FALSE, -- is this field present numRecipients: INT ¬ 0, numDLs: INT ¬ 0, endHeadersPos: INT ¬ 0 -- for adding Reply-To: field ]; SendingRec: TYPE = REF SendMsgRecObject; SendParseStatus: TYPE = {ok, includesPublicDL, includesPrivateDL, fieldNotAllowed, syntaxError}; messageParseArray: PUBLIC ARRAY PeanutParse.MessageFieldIndex OF PeanutParse.MessageInfo ¬ [ replyToF: ["Reply-To", simpleRope], -- this is really wrong, a special case for now senderF: ["Sender", simpleRope], fromF: ["From", simpleRope], toF: ["To", rNameList], ccF: ["cc", rNameList], cF: ["c", rNameList], bccF: ["bcc", rNameList], dateF: ["Date", simpleRope], subjectF: ["Subject", simpleRope], categoriesF: ["Categories", rCatList], inReplyToF: ["In-Reply-To", simpleRope], voiceF: ["VoiceFileID", simpleRope] ]; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * >> CreateMessageRope: PUBLIC PROC [parent: TextNode.Ref] RETURNS [r: Rope.ROPE] = { firstMessageNode: TextNode.Ref ~ TiogaOps.FirstChild[parent]; length: INT ~ TextNode.LocOffset[[firstMessageNode, 0], TextNode.LastLocWithin[parent]]; RETURN[Rope.MakeRope[base: firstMessageNode, size: length, fetch: FetchFromMessageRope]]; }; FetchFromMessageRope: PROC [data: REF, index: INT] RETURNS [CHAR] = { RETURN [FetchFromNode[NARROW[data], index]]; }; FetchFromNode: PROC [node: TextNode.Ref, index: INT] RETURNS [CHAR] = { loc: TextNode.Location = TextNode.LocRelative[[node, 0], index]; IF loc.node = NIL THEN RETURN[0C] ELSE IF loc.where >= Rope.Size[loc.node.rope] THEN -- It's the node-break character RETURN ['\r] ELSE RETURN [Rope.Fetch[loc.node.rope, loc.where]]; }; TopParent: PROC [node, root: TiogaOps.Ref ¬ NIL] RETURNS [parent: TiogaOps.Ref] = { IF node=NIL THEN RETURN [NIL]; IF root=NIL THEN root ¬ TiogaOps.Root[node]; DO parent ¬ TiogaOps.Parent[node]; IF parent = root THEN RETURN [node]; node ¬ parent; ENDLOOP }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> MailMessageHasBeenEdited: PROC [viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS[abort: BOOL ¬ FALSE] = { IF before THEN { viewer.icon ¬ PeanutWindow.dirtyMailMessageIcon; IF viewer.iconic THEN ViewerOps.PaintViewer[viewer: viewer, hint: all]; }; }; MailMessageHasBeenSaved: PROC [viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS[abort: BOOL ¬ FALSE] = { IF NOT before AND viewer.file # NIL THEN { viewer.icon ¬ PeanutWindow.mailMessageIcon; IF viewer.iconic THEN ViewerOps.PaintViewer[viewer: viewer, hint: all]; }; }; PeanutCheckForReset: TiogaOps.CommandProc = { oldIcon: Icons.IconFlavor ~ viewer.icon; SELECT oldIcon FROM PeanutWindow.dirtyMailMessageIcon => viewer.icon ¬ PeanutWindow.mailMessageIcon; PeanutWindow.dirtyMessageSetIcon => viewer.icon ¬ PeanutWindow.messageSetIcon; ENDCASE; IF viewer.iconic AND viewer.icon#oldIcon THEN ViewerOps.PaintViewer[viewer, all]; }; NewForm: PROC [write: PROC[TiogaAccess.Writer]] = { writer: TiogaAccess.Writer ~ TiogaAccess.Create[]; newForm: Viewer ¬ NIL; write[writer]; newForm ¬ ViewerTools.MakeNewTextViewer[info: [name: "Message", icon: PeanutWindow.mailMessageIcon, iconic: FALSE]]; TiogaAccessViewers.WriteViewer[writer: writer, viewer: newForm]; [] ¬ ViewerEvents.RegisterEventProc[proc: MailMessageHasBeenEdited, event: edit, filter: newForm, before: TRUE]; [] ¬ ViewerEvents.RegisterEventProc[proc: MailMessageHasBeenSaved, event: save, filter: newForm, before: FALSE]; ViewerTools.SetSelection[newForm, NEW[ViewerTools.SelPosRec¬ [0, 0]]]; newForm.class.notify[newForm, LIST[$NextPlaceholder]]; }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> PutRope: PROC [writer: TiogaAccess.Writer, rope: ROPE, looks: TiogaAccess.Looks ¬ ALL[FALSE]] ~ { tiogaChar: TiogaAccess.TiogaChar ¬ [charSet: 0, char: '\000, looks: ALL[FALSE], format: NIL, comment: FALSE, endOfNode: FALSE, deltaLevel: 0, propList: NIL]; Action: PROC [c: CHAR] RETURNS [quit: BOOL ¬ FALSE] -- Rope.ActionType -- ~ { charLooks: TiogaAccess.Looks ¬ looks; SELECT c FROM '\001, '\002 => charLooks['r] ¬ charLooks['t] ¬ TRUE; ENDCASE; tiogaChar.char ¬ c; tiogaChar.looks ¬ charLooks; TiogaAccess.Put[writer, tiogaChar]; }; [] ¬ Rope.Map[base: rope, action: Action]; }; EndNode: PROC [writer: TiogaAccess.Writer, format: ATOM ¬ NIL, comment: BOOL ¬ FALSE] ~ { tiogaChar: TiogaAccess.TiogaChar ¬ [charSet: 0, char: '\000, looks: ALL[FALSE], format: format, comment: comment, endOfNode: TRUE, deltaLevel: 0, propList: NIL]; TiogaAccess.Put[writer, tiogaChar]; }; PutNode: PROC [writer: TiogaAccess.Writer, rope: ROPE ¬ NIL, format: ATOM ¬ NIL] ~ { PutRope[writer, rope]; EndNode[writer, format]; }; PutFromViewer: PROC [writer: TiogaAccess.Writer, viewer: Viewer] ~ { reader: TiogaAccess.Reader ~ TiogaAccessViewers.FromViewer[viewer]; [] ¬ TiogaAccess.SkipToNextNode[reader]; -- skip the root UNTIL TiogaAccess.EndOf[reader] DO [] ¬ TiogaAccess.CopyNode[writer, reader]; ENDLOOP; TiogaAccess.Nest[writer, 1]; -- make up for skipping root TiogaAccess.DoneWith[reader]; }; PutField: PROC [writer: TiogaAccess.Writer, key, val: ROPE, format: ATOM ¬ NIL] ~ { keyLooks: TiogaAccess.Looks ¬ ALL[FALSE]; keyLooks['b] ¬ keyLooks['s] ¬ TRUE; PutRope[writer, key, keyLooks]; PutRope[writer, ": "]; PutRope[writer, val]; EndNode[writer, format]; }; PutFromHeader: PROC [writer: TiogaAccess.Writer, header: ROPE] ~ { size: INT ~ Rope.Size[header]; key, colon, val, cr: INT ¬ 0; WHILE key < size DO colon ¬ Rope.Find[s1: header, s2: ": ", pos1: key]; val ¬ colon + 2; cr ¬ Rope.Find[s1: header, s2: "\r", pos1: key]; IF colon < 0 OR cr < 0 OR cr < val THEN EXIT; PutField[writer: writer, key: Rope.Substr[base: header, start: key, len: colon - key], val: Rope.Substr[base: header, start: val, len: cr - val]]; key ¬ cr + 1; ENDLOOP; }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> CopyDoc: PROC [root: TextNode.Ref] RETURNS [TextNode.Ref] ~ { copy: TextNode.Ref ~ TextNode.Root[EditSpanSupport.CopySpan[[ start: TextNode.MakeNodeLoc[TextNode.FirstChild[root]], end: TextNode.MakeNodeLoc[TextNode.LastWithin[root]] ]].start.node]; RETURN [copy] }; AnswerMsg: PUBLIC PROC [includeOriginal: BOOL, transport: ATOM] = { GetChar: PROC[pos: INT] RETURNS [CHAR] = { ch: CHAR ~ FetchFromNode[messageNode, pos]; IF ch = '\l THEN RETURN['\r] ELSE RETURN[ch]; }; Writer: PROC [writer: TiogaAccess.Writer] ~ { PutFromHeader[writer: writer, header: answer]; PutNode[writer: writer]; -- empty node IF includeOriginal THEN { TiogaAccess.Nest[writer, 1]; -- this makes up for skipping the message header UNTIL TiogaAccess.EndOf[reader] DO [] ¬ TiogaAccess.CopyNode[writer, reader]; ENDLOOP; PutNode[writer: writer]; -- empty node TiogaAccess.DoneWith[reader]; }; PutNode[writer: writer, rope: "\001Message\002", format: PeanutProfile.messageNodeFormat]; PutSignatureField[writer]; }; notOk: BOOL; length, errorIndex: INT; answer: ROPE; start: TiogaOps.Location; messageViewer: Viewer; messageNode: TiogaOps.Ref; thisUser: MailBasics.RName ¬ [$none, NIL]; reader: TiogaAccess.Reader; [viewer: messageViewer, start: start] ¬ TiogaOps.GetSelection[]; messageNode ¬ TopParent[start.node]; IF messageNode = NIL THEN { PeanutWindow.OutputRope["\nSelect message to be answered."]; RETURN; }; length ¬ TextNode.LocOffset[[messageNode, 0], TextNode.LastLocWithin[messageNode]]; IF includeOriginal THEN { reader ¬ TiogaAccess.FromNode[CopyDoc[messageNode]]; IF TiogaOps.FirstChild[messageNode] # NIL THEN -- skip header node [] ¬ TiogaAccess.SkipToNextNode[reader]; }; IF transport # NIL THEN { FOR rL: MailBasics.RNameList ¬ PeanutCredentials.userRNameList, rL.rest UNTIL rL = NIL DO IF transport # rL.first.ns THEN LOOP; thisUser ¬ rL.first; EXIT; ENDLOOP; }; [notOk, answer, errorIndex] ¬ MailAnswer.MakeHeader[which: transport, getChar: GetChar, inputLength: length, userRName: thisUser]; IF notOk THEN { PeanutWindow.OutputRope[IO.PutFR1[ "\nSyntax error in line previous to line containing pos %g", [integer[TextNode.LocNumber[TextNode.LocRelative[[messageNode, 0], errorIndex]]]]]]; IF answer.Length[] = 0 THEN RETURN; PeanutWindow.OutputRope["\n***** Partial answer has been generated *****"]; }; NewForm[Writer]; }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> ForwardMsg: PUBLIC PROC ~ { Maker: PROC [writer: TiogaAccess.Writer] ~ { PutHeaderFields[writer]; PutNode[writer: writer, rope: "\001CoveringMessage\002", format: PeanutProfile.messageNodeFormat]; PutSignatureField[writer]; PutNode[writer: writer]; -- empty node PutNode[writer: writer, rope: "------------------------------------------------------------"]; UNTIL TiogaAccess.EndOf[reader] DO [] ¬ TiogaAccess.CopyNode[writer, reader]; ENDLOOP; TiogaAccess.Nest[writer, 1]; -- make up for skipping message header PutNode[writer: writer, rope: "------------------------------------------------------------"]; }; messageViewer: ViewerClasses.Viewer; start, end: TiogaOps.Location; messageHeader, endHeader: TiogaOps.Ref; reader: TiogaAccess.Reader; [viewer: messageViewer, start: start, end: end] ¬ TiogaOps.GetSelection[]; messageHeader ¬ TopParent[start.node]; endHeader ¬ TopParent[end.node]; IF messageHeader = NIL OR messageHeader # endHeader THEN { PeanutWindow.OutputRope["\nSelect a single message to be forwarded."]; RETURN; }; reader ¬ TiogaAccess.FromNode[CopyDoc[messageHeader]]; IF TiogaOps.FirstChild[messageHeader] # NIL THEN -- skip header node [] ¬ TiogaAccess.SkipToNextNode[reader]; NewForm[Maker]; TiogaAccess.DoneWith[reader]; }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> PutToField: PROC [writer: TiogaAccess.Writer] = { PutField[writer: writer, key: "To", val: Rope.Cat["\001", PeanutProfile.recipients, "\002"]]; }; PutSubjectField: PROC [writer: TiogaAccess.Writer] = { PutField[writer: writer, key: "Subject", val: "\001Topic\002"]; }; PutSignatureField: PROC [writer: TiogaAccess.Writer] = { IF NOT Rope.IsEmpty[PeanutProfile.signature] THEN PutNode[writer: writer, rope: PeanutProfile.signature]; }; PutHeaderFields: PROC [writer: TiogaAccess.Writer] = { IF PeanutProfile.toBeforeSubject THEN { PutToField[writer]; PutSubjectField[writer]; } ELSE { PutSubjectField[writer]; PutToField[writer]; }; IF PeanutProfile.ccField THEN PutField[writer: writer, key: "Cc", val: IF PeanutProfile.ccToSelf THEN PeanutCredentials.simpleUserName.first ELSE "\001Copies To\002"]; PutField[writer: writer, key: "Reply-To", val: PeanutCredentials.simpleUserName.first]; EndNode[writer: writer]; -- empty node }; NewMsgForm: PUBLIC PROC ~ { NewFormWriter: PROC [writer: TiogaAccess.Writer] ~ { PutHeaderFields[writer]; PutNode[writer: writer, rope: "\001Message\002", format: PeanutProfile.messageNodeFormat]; PutSignatureField[writer]; }; NewForm[NewFormWriter]; }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> abortSend: BOOL ¬ FALSE; AbortSend: PUBLIC PROC ~ { abortSend ¬ TRUE; }; CheckForAbort: PROC ~ { IF abortSend THEN ERROR ABORTED; }; Debug: PROC [REF ¬ NIL] ~ {ENABLE ABORTED => CONTINUE; ERROR}; SendMsg: PUBLIC PROC[transport: ATOM] = { senderV: Viewer ¬ NIL; oldLabel: ROPE ¬ NIL; restore: BOOL ¬ FALSE; Restore: PROC [delNodes: BOOL] = { root, first, second: TiogaOps.Ref; prevV: Viewer; prevStart, prevEnd: TiogaOps.Location; prevLevel: TiogaOps.SelectionGrain; cb, pd: BOOL; senderV.label ¬ oldLabel; ViewerOps.OpenIcon[senderV]; IF delNodes THEN { [prevV, prevStart, prevEnd, prevLevel, cb, pd] ¬ TiogaOps.GetSelection[primary]; root ¬ TiogaOps.ViewerDoc[senderV]; first ¬ TiogaOps.FirstChild[root]; second ¬ TiogaOps.StepForward[first]; TiogaOps.SelectNodes[viewer: senderV, start: first, end: second]; TiogaOps.Delete[]; IF prevV # senderV AND prevV # NIL THEN TiogaOps.SetSelection[prevV, prevStart, prevEnd, prevLevel, cb, pd]; }; }; BEGIN ENABLE { UNWIND => IF restore THEN Restore[FALSE]; ABORTED => { Restore[FALSE]; PeanutWindow.OutputRope["Sending ABORTED."]; GO TO Return; }; }; status: SendParseStatus; sPos, mPos: INT; formatting: ROPE; smr: SendingRec; writer: TiogaAccess.Writer ¬ NIL; contents: ViewerTools.TiogaContents; abortSend ¬ FALSE; senderV ¬ ViewerTools.GetSelectedViewer[]; IF senderV = NIL THEN { PeanutWindow.OutputRope["\nSelect message to be sent."]; RETURN }; ViewerOps.CloseViewer[senderV]; IF Rope.Length[PeanutProfile.outgoingMailFile] > 0 THEN { TiogaOps.SelectDocument[senderV]; PeanutWindow.CopyMessages[to: PeanutProfile.outgoingMailFile, delete: FALSE]; }; oldLabel ¬ senderV.label; senderV.label ¬ "Sending"; restore ¬ TRUE; smr ¬ NEW[SendMsgRecObject ¬ [fullText: CreateMessageRope[TiogaOps.ViewerDoc[senderV]]]]; PeanutWindow.OutputRope["\nParsing... "]; [status, sPos, mPos] ¬ ParseTextToBeSent[smr, transport]; IF status # ok AND status # includesPublicDL THEN { SELECT status FROM fieldNotAllowed => IF sPos # mPos THEN { PeanutWindow.OutputRope[Rope.Substr[smr.fullText, sPos, mPos - sPos - 1]]; PeanutWindow.OutputRope["field is not allowed."] } ELSE PeanutWindow.OutputRope[IO.PutFR1["Field at pos %g is not allowed.", [integer[sPos]]]]; syntaxError => IF sPos # mPos THEN { PeanutWindow.OutputRope["Syntax error on line beginning with "]; PeanutWindow.OutputRope[Rope.Substr[smr.fullText, sPos, mPos - sPos - 1]] } ELSE PeanutWindow.OutputRope[IO.PutFR1["Syntax error at position %g.", [integer[sPos]]]]; includesPrivateDL => PeanutWindow.OutputRope["Private DLs are not yet implemented."]; ENDCASE => ERROR; Restore[FALSE]; RETURN; }; CheckForAbort[]; writer ¬ TiogaAccess.Create[]; PutField[writer, "Date", Convert.RopeFromTimeRFC822[BasicTime.Now[]]]; FOR rL: MailBasics.RNameList ¬ PeanutCredentials.userRNameList, rL.rest UNTIL rL=NIL DO IF rL.first.ns = transport THEN { PutField[writer, IF smr.from.name = NIL THEN "From" ELSE "Sender", rL.first.name]; PutFromViewer[writer, senderV]; TiogaAccessViewers.WriteViewer[writer, senderV]; EXIT; }; REPEAT FINISHED => { Restore[FALSE]; PeanutWindow.OutputRope["Cannot find appropriate name for sender."]; RETURN; }; ENDLOOP; <> { textNodeRef: TextNode.Ref ~ TiogaOps.ViewerDoc[senderV]; contents ¬ MailUtilsBackdoor.GetCRTiogaContents[textNodeRef]; IF transport = $xns THEN { smr.fullText ¬ MailUtilsBackdoor.WritePlainCR[textNodeRef]; formatting ¬ contents.formatting; } ELSE { last: INT; <> Debug[]; last ¬ 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; }; }; }; smr.endHeadersPos ¬ Rope.Find[smr.fullText, "\r\r", 0]; IF smr.endHeadersPos < 0 THEN smr.endHeadersPos ¬ smr.fullText.Length[] ELSE smr.endHeadersPos ¬ smr.endHeadersPos + 2; PeanutWindow.OutputRope["Sending message... "]; IF Send[smr, formatting, contents.contents, transport] THEN { PeanutWindow.OutputRope["Message has been delivered."]; IF senderV.file # NIL AND senderV.newVersion THEN Restore[FALSE] ELSE ViewerOps.DestroyViewer[senderV]; } ELSE { Restore[TRUE]; PeanutWindow.OutputRope["Message NOT sent."] }; EXITS Return => RETURN; END; }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> dotRope: ROPE = "."; colonRope: ROPE = ":"; atSignRope: ROPE = "@"; percentRope: ROPE = "%"; FixupXNSAddresses: PROC [rn: RName] RETURNS [nrn: RName] ~ { <> FixAtBreak: PROC [break: ROPE, rn: RName] RETURNS [fixed: BOOL _ FALSE] = { whereBreak: INT _ Rope.FindBackward[rn.name, break]; -- last position of break in rName IF whereBreak < 1 OR whereBreak=Rope.Length[rn.name] THEN RETURN [FALSE]; <> IF whereDot > whereBreak THEN { -- final dot is after the break, not in the "user name" <> domain: ROPE _ Rope.Substr[rn.name, whereDot+1]; -- get the value of t FOR r: LIST OF ROPE _ PeanutProfile.fixupXNSAddresses, r.rest UNTIL r=NIL DO nextDomain: ROPE _ r.first; IF Rope.Equal[domain, nextDomain, FALSE] THEN { nrn.name _ Rope.Replace[rn.name, whereDot, 1, colonRope]; fixed _ TRUE; RETURN; }; ENDLOOP; }; }; fixed: BOOL _ FALSE; whereDot: INT _ -1; nrn _ [rn.ns, rn.name]; -- in case RETURNS early IF rn.ns#$xns THEN RETURN; -- only for xns transport IF Rope.Find[rn.name, colonRope]#-1 THEN RETURN; -- don't even try to fix up rNames that already have colons in them whereDot _ Rope.FindBackward[rn.name, dotRope]; -- last position of a dot in rName IF whereDot < 1 OR whereDot=Rope.Length[rn.name] THEN RETURN; <> fixed _ FixAtBreak[atSignRope, rn]; -- fix up addresses with @ in them FIRST IF NOT fixed THEN [] _ FixAtBreak[percentRope, rn]; -- THEN try to fix up addresses with % in them }; Send: PROC [smr: SendingRec, formatting, textForFormatting: ROPE, transport: ATOM] RETURNS [sent: BOOLEAN] = { msH: MailSend.MailSendHandle ~ MailSend.Create[]; stepper: LIST OF RName; numRecips: INT ¬ 0; failureReason: ROPE; invalidRecipients: MailBasics.RNameList; bugNote: Prop.PropList ¬ NIL; BugNote: PROC [what: ATOM, item: ROPE] RETURNS [ROPE] ~ { bugNote ¬ CONS[[what, item], bugNote]; RETURN [item] }; sent ¬ FALSE; MailSend.StartSend[msH: msH, credentialsList: PeanutCredentials.sendingCredentials]; FOR rL: LIST OF RName _ smr.to, rL.rest UNTIL rL = NIL DO IF rL.first.name # NIL THEN { thisrN: RName _ rL.first; IF PeanutProfile.fixupXNSAddresses#NIL THEN thisrN _ FixupXNSAddresses[thisrN]; MailSend.AddRecipient[msH, thisrN]; numRecips _ numRecips + 1; }; ENDLOOP; CheckForAbort[]; FOR rL: LIST OF RName _ smr.cc, rL.rest UNTIL rL = NIL DO IF rL.first.name # NIL THEN { thisrN: RName _ rL.first; IF PeanutProfile.fixupXNSAddresses#NIL THEN thisrN _ FixupXNSAddresses[thisrN]; MailSend.AddRecipient[msH, thisrN]; numRecips _ numRecips + 1; }; ENDLOOP; CheckForAbort[]; PeanutWindow.OutputRope[IO.PutFR["Sending to %g recipient%g... ", [integer[numRecips]], [rope[IF numRecips = 1 THEN "" ELSE "s"]]]]; MailSend.StartItem[msH, MailBasicsItemTypes.header]; MailSend.AddToItem[msH, BugNote[$header, Rope.Substr[smr.fullText, 0, smr.endHeadersPos]]]; MailSend.StartItem[msH, MailBasicsItemTypes.multinationalNote]; MailSend.AddToItem[msH, BugNote[$multinationalNote, Rope.Substr[smr.fullText, smr.endHeadersPos]]]; IF formatting # NIL THEN { -- send the formatting info as a second item IF transport # $gv THEN { MailSend.StartItem[msH, MailBasicsItemTypes.plainTextForFormatting]; MailSend.AddToItem[msH, BugNote[$plainTextForFormatting, textForFormatting]]; }; MailSend.StartItem[msH, MailBasicsItemTypes.tioga1]; MailSend.AddToItem[msH, BugNote[$tioga1, formatting]] }; CheckForAbort[]; <> [sent, failureReason, invalidRecipients] ¬ MailSend.Send[msH: msH, validate: TRUE, sendEvenIfInvalidNames: FALSE, transport: transport]; IF NOT sent THEN { IF invalidRecipients = NIL THEN PeanutWindow.OutputRope[failureReason] ELSE { PeanutWindow.OutputRope["\nThe following are invalid recipients: "]; FOR rL: MailBasics.RNameList ¬ invalidRecipients, rL.rest UNTIL rL = NIL DO PeanutWindow.OutputRope[IO.PutFR["(%g) %g", [atom[rL.first.ns]], [rope[rL.first.name]]]]; IF rL.rest # NIL THEN PeanutWindow.OutputRope[", "]; ENDLOOP; }; }; }; debugData: Prop.PropList ¬ NIL; GetDebugData: PROC RETURNS [Prop.PropList] ~ { RETURN [debugData] }; <<* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *>> ParseTextToBeSent: PROC [msg: SendingRec, transport: ATOM] RETURNS [status: SendParseStatus, sPos, mPos: INT] = { mLF: PeanutParse.MessageInfo; tHeaders: LIST OF ROPE¬ NIL; msgText: ROPE ¬ msg.fullText; lastCharPos: INT ¬ msgText.Length[] - 1; lastCharIsCR: BOOL ¬ (msgText.Fetch[lastCharPos] = '\r); countOfRecipients, dlCount: INT ¬ 0; 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 ¬ MailParse.endOfInput; mPos¬ mPos + 1; }; RNameListField: PROC[index: PeanutParse.MessageFieldIndex] = { fieldBody, fbEnd: LIST OF RName ¬ NIL; AnotherRName: PROC[rName: RName] RETURNS [ROPE] = { IF fbEnd=NIL THEN fbEnd ¬ fieldBody ¬ CONS[rName, NIL] ELSE fbEnd ¬ fbEnd.rest ¬ CONS[rName, NIL]; IF rName.ns = $file THEN status ¬ includesPrivateDL ELSE IF rName.name.Find["^"] < 0 THEN countOfRecipients ¬ countOfRecipients + 1 ELSE { IF status # includesPrivateDL THEN status¬ includesPublicDL; dlCount¬ dlCount + 1 }; RETURN[NIL]; }; MailParse.NameList[pH, transport, GetNextMsgChar, AnotherRName, NIL]; SELECT index FROM toF => msg.to ¬ Append[msg.to, fieldBody]; ccF, cF, bccF => msg.cc ¬ Append[msg.cc, fieldBody]; fromF => IF fieldBody # NIL THEN msg.from ¬ fieldBody.first; ENDCASE => ERROR; }; Append: PROC [a, b: LIST OF RName] RETURNS [LIST OF RName] ~ { RETURN [IF a = NIL THEN b ELSE CONS[a.first, Append[a.rest, b]]] }; pH: MailParse.ParseHandle; field: ROPE ¬ NIL; fieldNotRecognized: BOOL; mPos ¬ 0; -- where we are in the fulltext, for parsing status ¬ ok; -- start with good status pH ¬ MailParse.InitializeParse[]; DO sPos ¬ mPos; field ¬ MailParse.GetFieldName[pH, GetNextMsgChar ! MailParse.ParseError => { MailParse.FinalizeParse[pH]; GOTO errorExit}]; IF field = NIL THEN EXIT; -- end of headers IF Rope.Equal[field, "Sender", FALSE] OR Rope.Equal[field, "Date", FALSE] THEN { RETURN[fieldNotAllowed, sPos, mPos]; }; fieldNotRecognized ¬ TRUE; FOR i: PeanutParse.MessageFieldIndex IN PeanutParse.MessageFieldIndex DO { mLF ¬ messageParseArray[i]; IF Rope.Equal[messageParseArray[i].name, field, FALSE] THEN -- ignore case { fieldNotRecognized¬ FALSE; SELECT mLF.fType FROM simpleRope => SELECT i FROM fromF => RNameListField[i ! MailParse.ParseError => GOTO errorExit]; replyToF => {msg.replyTo ¬ TRUE; []¬ MailParse.GetFieldBody[pH, GetNextMsgChar, TRUE] }; subjectF => msg.subject ¬ MailParse.GetFieldBody[pH, GetNextMsgChar]; voiceF => msg.voiceID ¬ MailParse.GetFieldBody[pH, GetNextMsgChar]; ENDCASE => [] ¬ MailParse.GetFieldBody[pH, GetNextMsgChar, TRUE]; rCatList => [] ¬ MailParse.GetFieldBody[pH, GetNextMsgChar, TRUE]; rNameList => RNameListField[i ! MailParse.ParseError => GOTO errorExit]; ENDCASE => ERROR; EXIT }; }; ENDLOOP; IF fieldNotRecognized THEN [] ¬ MailParse.GetFieldBody[pH, GetNextMsgChar]; -- skip anything not recognized ENDLOOP; <> MailParse.FinalizeParse[pH]; msg.endHeadersPos ¬ mPos - 1; msg.numRecipients ¬ countOfRecipients; msg.numDLs ¬ dlCount; EXITS errorExit => RETURN[syntaxError, sPos, mPos]; }; TiogaOps.RegisterCommand[name: $RedReset, proc: PeanutCheckForReset, before: FALSE]; TiogaOps.RegisterCommand[name: $YellowReset, proc: PeanutCheckForReset, before: FALSE]; TiogaOps.RegisterCommand[name: $BlueReset, proc: PeanutCheckForReset, before: FALSE]; END.