PeanutSendMailImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Created by Paxton, April 1, 1983 3:02 pm
Last Edited by: Pausch, July 18, 1983 2:13 pm
Last Edited by: Willie-Sue, July 29, 1986 4:51:54 pm PDT
Last Edited by: Gasbarro October 9, 1985 6:30:55 pm PDT
Bertrand Serlet June 25, 1986 5:35:26 pm PDT
Michael Plass, September 25, 1985 3:11:14 pm PDT
Doug Wyatt, August 29, 1985 4:40:59 pm PDT
DIRECTORY
BasicTime USING [GMT, Now, nullGMT, Unpack, Unpacked],
GVAnswer USING [MakeHeader],
GVBasics USING [ItemType, RName],
GVMailParse USING [endOfInput, FinalizeParse, GetFieldBody, GetFieldName, InitializeParse, ParseError, ParseHandle, ParseNameList],
GVNames USING [Authenticate, AuthenticateInfo],
GVSend USING [AddRecipient, AddToItem, CheckValidity, Create, Handle, Send, SendFailed, StartItem, StartSend, StartSendInfo],
IO USING [int, PutFR, rope],
List USING [Append],
Icons USING [IconFlavor],
Menus USING [MouseButton],
PeanutParse USING [MessageFieldIndex, MessageInfo],
PeanutProfile USING [ccField, ccToSelf, messageNodeFormat, outgoingMailFile, toBeforeSubject, recipients, signature],
PeanutRetrieve USING [CopyMessages],
PeanutSendMail USING [SendingRec, SendMsgRecObject, SendParseStatus],
PeanutWindow USING [abortFlag, dirtyMailMessageIcon, dirtyMessageSetIcon, mailMessageIcon, messageSetIcon, OutputRope],
PutGet USING [ToRope],
Rope USING [ActionType, Cat, Concat, Equal, Fetch, Find, Length, MakeRope, Map, ROPE, Size, Substr],
TextNode USING [Body, Location, LocRelative, NarrowToTextNode, Ref, RefTextNode],
TiogaAccess USING [CopyNode, Create, EndOf, FromViewer, GetNodeRefs, Looks, Put, Reader, SkipToNextNode, TiogaChar, Writer, WriteReader, WriteViewer],
TiogaOps USING [BackSpace, CommandProc, FirstChild, GetRope, GetSelection, InsertRope, LastChild, Location, Lock, LockSel, NextPlaceholder, Parent, Ref, RegisterCommand, Root, SelectBranches, SelectDocument, SelectPoint, ToPrimary, Unlock, UnlockSel, ViewerDoc],
TiogaOpsDefs USING [],
UserCredentials USING [Get],
UserProfile USING [CallWhenProfileChanges, ProfileChangedProc],
ViewerClasses USING [Lock, Viewer],
ViewerEvents USING [RegisterEventProc, ViewerEvent],
ViewerOps USING [CloseViewer, DestroyViewer, OpenIcon, PaintViewer],
ViewerTools USING [GetSelectedViewer, MakeNewTextViewer, SelPosRec, SetSelection, TiogaContents, TiogaContentsRec];
PeanutSendMailImpl: CEDAR MONITOR
IMPORTS BasicTime, GVAnswer, GVMailParse, GVNames, GVSend, IO, List, PeanutProfile, PeanutRetrieve, PeanutWindow, PutGet, Rope, TextNode, TiogaAccess, TiogaOps, UserCredentials, UserProfile, ViewerEvents, ViewerOps, ViewerTools
EXPORTS PeanutSendMail, PeanutParse, TiogaOpsDefs
= BEGIN OPEN PeanutSendMail;
NodeBody: PUBLIC TYPE ~ TextNode.Body; -- export to TiogaOpsDefs
TiogaCTRL: GVBasics.ItemType = Tioga1;
Viewer: TYPE = ViewerClasses.Viewer;
ROPE: TYPE = Rope.ROPE;
RName: TYPE = GVBasics.RName;
userRName: PUBLIC ROPE← NIL; -- user name with registry
simpleUserName: PUBLIC ROPE← NIL; -- user name without registry
userRegistry: PUBLIC ROPE← NIL;
defaultRegistry: PUBLIC ROPE← "pa";
needToAuthenticate: BOOL← TRUE;
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]
];
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
AuthenticateUser:
PUBLIC
PROC
RETURNS [
BOOL] = {
uN: ROPE ~ UserCredentials.Get[].name;
proc: PROC[r: ROPE] = {InternalReport[r]};
auth: GVNames.AuthenticateInfo;
IF Rope.Length[uN] = 0 THEN { proc["Please Login"]; RETURN[FALSE] }
ELSE {
dot: INT ~ uN.Find["."];
IF dot<0
THEN {
simpleUserName ← uN;
userRegistry ← defaultRegistry;
userRName ← Rope.Cat[simpleUserName, ".", userRegistry];
}
ELSE {
simpleUserName ← uN.Substr[len: dot];
userRegistry ← uN.Substr[start: dot+1];
userRName ← uN;
};
};
auth ← GVNames.Authenticate[userRName, UserCredentials.Get[].password];
SELECT auth
FROM
group => proc["... Can't login as group"];
individual => {needToAuthenticate ← FALSE; RETURN[TRUE]};
notFound => {proc[userRName]; proc[" is invalid - please Login"]};
allDown => proc["... No server responded"];
badPwd => proc["... Your Password is invalid - please Login"];
ENDCASE;
RETURN[FALSE];
};
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
PeanutSendInit: UserProfile.ProfileChangedProc = { needToAuthenticate ←
TRUE };
CreateMessageRope:
PUBLIC
PROC [parent: TextNode.Ref]
RETURNS [r: Rope.
ROPE] = {
firstMessageNode: TextNode.Ref ~ TiogaOps.FirstChild[parent];
RETURN[Rope.MakeRope[base: firstMessageNode, size: 2048, fetch: FetchFromMessageRope]];
};
FetchFromMessageRope:
PROC [data:
REF, index:
INT]
RETURNS [
CHAR] = {
firstMessageNode: TextNode.Ref ← NARROW[data];
loc: TextNode.Location = TextNode.LocRelative[[firstMessageNode,0], index];
n: TextNode.RefTextNode = TextNode.NarrowToTextNode[loc.node];
IF n=NIL THEN RETURN[0C];
IF loc.where >= Rope.Size[n.rope] THEN RETURN ['\n];
RETURN [Rope.Fetch[n.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]];
TiogaAccess.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]];
};
TiogaAccessPutRope:
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: 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];
};
TiogaAccessEndNode:
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];
};
TiogaAccessPutNode:
PROC [writer: TiogaAccess.Writer,
rope:
ROPE ←
NIL, format:
ATOM ←
NIL] ~ {
TiogaAccessPutRope[writer, rope];
TiogaAccessEndNode[writer, format];
};
TiogaAccessPutField:
PROC [writer: TiogaAccess.Writer,
key, val:
ROPE, format:
ATOM ←
NIL] ~ {
keyLooks: TiogaAccess.Looks ← ALL[FALSE];
keyLooks['b] ← keyLooks['s] ← TRUE;
TiogaAccessPutRope[writer, key, keyLooks];
TiogaAccessPutRope[writer, ": "];
TiogaAccessPutRope[writer, val];
TiogaAccessEndNode[writer, format];
};
TiogaAccessPutHeader:
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: "\n", pos1: key];
IF colon<0 OR cr<0 OR cr<val THEN EXIT;
TiogaAccessPutField[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;
};
TiogaAccessPutFromViewer:
PROC [writer: TiogaAccess.Writer, viewer: Viewer] ~ {
reader: TiogaAccess.Reader ~ TiogaAccess.FromViewer[viewer];
[] ← TiogaAccess.SkipToNextNode[reader]; -- skip the root
UNTIL TiogaAccess.EndOf[reader]
DO
[] ← TiogaAccess.CopyNode[writer, reader];
ENDLOOP;
};
TiogaAccessWriteTiogaContents:
PROC [writer: TiogaAccess.Writer]
RETURNS [ViewerTools.TiogaContents] ~ {
reader: TiogaAccess.Reader ~ TiogaAccess.WriteReader[writer];
root: TextNode.Ref ~ NARROW[TiogaAccess.GetNodeRefs[reader].root];
contents, formatting: ROPE;
dataLen, count: INT;
[dataLen, count, contents] ← PutGet.ToRope[root];
formatting ← Rope.Substr[base: contents, start: dataLen, len: count-dataLen];
contents ← Rope.Substr[base: contents, start: 0, len: dataLen];
RETURN[NEW[ViewerTools.TiogaContentsRec ← [contents, formatting]]];
};
AnswerMsg:
PUBLIC
PROC [mouseButton: Menus.MouseButton, shift, control:
BOOL] = {
notOk: BOOL;
errorIndex: INT;
txt, answer: ROPE;
messageNode: TiogaOps.Ref;
AnswerGetChar: PROC[pos: INT] RETURNS[CHAR] = {RETURN[txt.Fetch[pos]]};
AnswerWriter:
PROC [writer: TiogaAccess.Writer] ~ {
TiogaAccessPutHeader[writer: writer, header: answer];
TiogaAccessPutNode[writer: writer]; -- empty node
TiogaAccessPutNode[writer: writer, rope: "\001Message\002",
format: PeanutProfile.messageNodeFormat];
PutSignatureField[writer];
};
IF needToAuthenticate AND NOT AuthenticateUser[] THEN RETURN;
messageNode ← TopParent[TiogaOps.GetSelection[].start.node];
IF messageNode =
NIL
THEN {
InternalReport["\nSelect message to be answered."]; RETURN
};
txt ← CreateMessageRope[messageNode];
[notOk, answer, errorIndex]← GVAnswer.MakeHeader[
getChar: AnswerGetChar, getLength: txt.Length[],
userName: IF PeanutProfile.ccToSelf THEN simpleUserName ELSE "",
userRegistry: userRegistry
];
IF notOk
THEN {
InternalReport[
IO.PutFR[
"\nSyntax error in line previous to line containing pos %g (in message being answered)",
IO.int[errorIndex]]];
IF answer.Length[] = 0 THEN RETURN;
InternalReport["\n*****Partial answer has been generated\n"];
};
NewForm[AnswerWriter];
};
ForwardMsg:
PUBLIC
PROC [mouseButton: Menus.MouseButton, shift, control:
BOOL] = {
sourceViewer: Viewer;
lockedPrimary, lockedSecondary, lockedDest, lockedSource: BOOL ← FALSE;
start, end: TiogaOps.Location;
sourceDoc, destDoc, messageHeader: TiogaOps.Ref;
singleNode: BOOL;
This probably should be revised to work if selection is in the message header rather than the message body.
Simple:
PROC [node: TiogaOps.Ref]
RETURNS [
BOOL] = {
n: TextNode.RefTextNode;
TRUSTED { n ← TextNode.NarrowToTextNode[LOOPHOLE[node]] };
IF n=NIL THEN RETURN [FALSE];
singleNode ← n.child=NIL AND n.last;
IF ~singleNode THEN RETURN [FALSE];
RETURN [n.runs=NIL]
};
Cleanup:
PROC = {
IF lockedPrimary THEN TiogaOps.UnlockSel[primary];
IF lockedSecondary THEN TiogaOps.UnlockSel[secondary];
IF lockedDest THEN TiogaOps.Unlock[destDoc];
IF lockedSource THEN TiogaOps.Unlock[sourceDoc];
};
IF needToAuthenticate AND NOT AuthenticateUser[] THEN RETURN;
TiogaOps.LockSel[primary]; lockedPrimary ← TRUE;
[sourceViewer, start, end, ----, ----, ----] ← TiogaOps.GetSelection[];
IF sourceViewer =
NIL
THEN {
TiogaOps.UnlockSel[primary]; InternalReport["\nSelect message to be forwarded."]; RETURN
};
IF start.node=end.node
AND Simple[start.node]
THEN {
-- send without Tioga formatting
ForwardWriter:
PROC [writer: TiogaAccess.Writer] ~ {
PutHeaderFields[writer];
TiogaAccessPutNode[writer: writer, rope: "\001CoveringMessage\002",
format: PeanutProfile.messageNodeFormat];
PutSignatureField[writer];
TiogaAccessPutNode[writer: writer]; -- empty node
TiogaAccessPutNode[writer: writer,
rope: "------------------------------------------------------------"];
TiogaAccessPutNode[writer: writer, rope: TiogaOps.GetRope[start.node]];
TiogaAccessPutNode[writer: writer,
rope: "------------------------------------------------------------"];
};
NewForm[ForwardWriter];
}
ELSE {
-- forward with Tioga formatting
destViewer: Viewer;
sourceDoc ← TiogaOps.ViewerDoc[sourceViewer];
messageHeader ← TopParent[start.node, sourceDoc];
IF TopParent[end.node, sourceDoc] # messageHeader
THEN {
TiogaOps.UnlockSel[primary]; InternalReport["\nSelect single message to be forwarded."]; RETURN
};
destViewer ← ViewerTools.MakeNewTextViewer[info: [name: "Message", icon: PeanutWindow.mailMessageIcon, iconic: FALSE]];
[] ← ViewerEvents.RegisterEventProc[proc: MailMessageHasBeenEdited, event: edit, filter: destViewer, before: TRUE];
[] ← ViewerEvents.RegisterEventProc[proc: MailMessageHasBeenSaved, event: save, filter: destViewer, before: FALSE];
destDoc ← TiogaOps.ViewerDoc[destViewer];
TiogaOps.LockSel[secondary]; lockedSecondary ← TRUE;
TiogaOps.Lock[destDoc]; lockedDest ← TRUE;
IF sourceDoc#destDoc THEN { TiogaOps.Lock[sourceDoc]; lockedSource ← TRUE };
TiogaOps.SelectPoint[destViewer, [TiogaOps.FirstChild[destDoc],0], primary];
TiogaOps.InsertRope["Subject: \001Topic\002\nTo: \001Recipients\002\nReply-To: "];
TiogaOps.InsertRope[userRName];
TiogaOps.InsertRope["\ncc: \001Copies To\002\n\n"];
TiogaOps.InsertRope["\001CoveringMessage\002\n\n"];
IF PeanutProfile.signature#NIL THEN TiogaOps.InsertRope[PeanutProfile.signature];
TiogaOps.InsertRope["-------------------------------------\n"];
IF ~singleNode THEN TiogaOps.BackSpace[]; -- get rid of CR at end
TiogaOps.SelectBranches[
-- source
viewer: sourceViewer, level: IF singleNode THEN char ELSE branch, caretBefore: FALSE,
pendingDelete: FALSE, which: secondary,
start: TiogaOps.FirstChild[messageHeader], end: TiogaOps.LastChild[messageHeader]];
TiogaOps.ToPrimary[];
TiogaOps.SelectPoint[destViewer, [TiogaOps.FirstChild[destDoc],0], primary];
[] ← TiogaOps.NextPlaceholder[gotoend: TRUE];
};
Cleanup[];
};
PutToField:
PROC [writer: TiogaAccess.Writer] = {
TiogaAccessPutField[writer: writer, key: "To", val: Rope.Cat["\001", PeanutProfile.recipients, "\002"]];
};
PutSubjectField:
PROC [writer: TiogaAccess.Writer] = {
TiogaAccessPutField[writer: writer, key: "Subject", val: "\001Topic\002"];
};
PutSignatureField:
PROC [writer: TiogaAccess.Writer] = {
IF PeanutProfile.signature#NIL THEN TiogaAccessPutNode[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 TiogaAccessPutField[writer: writer, key: "cc",
val: IF PeanutProfile.ccToSelf THEN simpleUserName ELSE "\001Copies To\002"];
TiogaAccessPutField[writer: writer, key: "Reply-To", val: simpleUserName];
TiogaAccessEndNode[writer: writer]; -- empty node
};
NewMsgForm:
PUBLIC
PROC [mouseButton: Menus.MouseButton, shift, control:
BOOL] = {
NewFormWriter:
PROC [writer: TiogaAccess.Writer] ~ {
PutHeaderFields[writer];
TiogaAccessPutNode[writer: writer, rope: "\001Message\002", format: PeanutProfile.messageNodeFormat];
PutSignatureField[writer];
};
NewForm[NewFormWriter];
};
InternalReport:
PROC [r:
ROPE] =
INLINE { PeanutWindow.OutputRope[r] };
CheckForAbort:
PROC
RETURNS [
BOOL] =
INLINE {
RETURN [PeanutWindow.abortFlag] };
* * * * * * * * * * * * * * * * * * * * * * * * * * * * *
RFC822Date:
PROC[gmt: BasicTime.
GMT ← BasicTime.nullGMT]
RETURNS[date:
ROPE] = {
generates arpa standard time, dd mmm yy hh:mm:ss zzz
Swiped from WalnutSendMailImpl of November 10, 1983
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"; -- fix zone bug (wso)
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← IO.PutFR[IF arpaNeg THEN "-%02g%02g" ELSE "+%02g%02g", IO.int[zDif], IO.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[IO.PutFR[NIL, IO.int[upt.year]], 2];
tyme← IO.PutFR[timeFormat, IO.int[upt.hour], IO.int[upt.minute], IO.int[upt.second], IO.rope[zone]];
date← IO.PutFR[dateFormat, IO.int[upt.day], IO.rope[month], IO.rope[year], IO.rope[tyme]];
};
SendMsg:
PUBLIC
PROC [mouseButton: Menus.MouseButton, shift, control:
BOOL] = {
senderV: Viewer ← NIL;
oldLabel: ROPE ← NIL;
restore: BOOL ← FALSE;
Restore:
PROC = {
senderV.label ← oldLabel;
ViewerOps.OpenIcon[senderV]
};
BEGIN ENABLE
UNWIND => {
IF restore
THEN Restore[] };
status: SendParseStatus;
sPos, mPos: INT;
formatting: ROPE;
smr: SendingRec;
reader: TiogaAccess.Reader ← NIL;
writer: TiogaAccess.Writer ← NIL;
contents: ViewerTools.TiogaContents;
IF needToAuthenticate AND NOT AuthenticateUser[] THEN RETURN;
PeanutWindow.abortFlag ← FALSE;
senderV ← ViewerTools.GetSelectedViewer[];
IF senderV = NIL THEN { InternalReport["\nSelect message to be sent."]; RETURN };
this needs to be done first, before the user can change the selection out from under me ... the "right" way would be to access the sending viewer later and make tioga lower level calls, but CopyMessages is easier to use, so I [R. Pausch] just call it before the selection can change. NOTE, however that if the message has troubles being sent, this copy will still work ...
{ outgoing:
ROPE = PeanutProfile.outgoingMailFile;
IF Rope.Length[outgoing]>0
THEN {
TiogaOps.SelectDocument[senderV];
PeanutRetrieve.CopyMessages[to: outgoing, delete: FALSE];
};
};
reader ← TiogaAccess.FromViewer[senderV];
oldLabel ← senderV.label;
senderV.label ← "Sending"; restore ← TRUE;
ViewerOps.CloseViewer[senderV];
smr ←
NEW[SendMsgRecObject←
[fullText: CreateMessageRope[NARROW[TiogaAccess.GetNodeRefs[reader].root]]]];
InternalReport["\nParsing..."];
[status, sPos, mPos]← ParseTextToBeSent[smr];
IF (status # ok)
AND (status # includesPublicDL)
THEN {
SELECT status
FROM
fieldNotAllowed =>
IF sPos # mPos THEN
{ InternalReport[Rope.Substr[smr.fullText, sPos, mPos-sPos-1]];
InternalReport[" field is not allowed."]
}
ELSE InternalReport[IO.PutFR[" field at pos %g is not allowed", IO.int[sPos]]];
syntaxError =>
IF sPos # mPos THEN
{ InternalReport["\nSyntax error on line beginning with "];
InternalReport[Rope.Substr[smr.fullText, sPos, mPos-sPos-1]]
}
ELSE InternalReport[IO.PutFR["..... Syntax error at position %g ", IO.int[sPos]]];
includesPrivateDL => InternalReport[" Private dl's are not yet implemented"];
ENDCASE => ERROR;
Restore;
RETURN;
};
IF CheckForAbort[]
THEN {
Restore; InternalReport["... Message NOT sent."];
RETURN
};
writer ← TiogaAccess.Create[];
TiogaAccessPutField[writer, "Date", RFC822Date[]];
TiogaAccessPutField[writer, IF smr.from=NIL THEN "From" ELSE "Sender", userRName];
TiogaAccessPutFromViewer[writer, senderV];
contents ← TiogaAccessWriteTiogaContents[writer];
IF (formatting← contents.formatting).Length[] = 0 THEN smr.fullText← contents.contents
ELSE {
-- check for null at end of contents; move it to formatting
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]
};
InternalReport["... Sending message..."];
IF Send[smr, formatting]
THEN {
InternalReport[" ... Message has been delivered"];
IF senderV.file#NIL AND senderV.newVersion THEN Restore[]
ELSE ViewerOps.DestroyViewer[senderV];
}
ELSE {
Restore[];
InternalReport["... Message NOT sent."]
};
END;
};
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Send:
PROC[smr: SendingRec, formatting:
ROPE]
RETURNS[ sent:
BOOLEAN] = {
sendHandle: GVSend.Handle ← GVSend.Create[];
sent ← SendMessage[smr, formatting, sendHandle,
TRUE ! GVSend.SendFailed =>
IF notDelivered
THEN {
InternalReport["\nCommunication failure during send."];
sent ← FALSE; CONTINUE
}
ELSE {
InternalReport["\nCommunication failure, but message delivered."];
sent ← TRUE; CONTINUE;
};
];
IF sendHandle#NIL THEN GVSend.Close[sendHandle];
};
SendMessage:
PROC[smr: SendingRec, formatting:
ROPE, h: GVSend.Handle, validateFlag:
BOOL]
RETURNS [sent:
BOOLEAN] = {
DO
ENABLE GVSend.SendFailed =>
CONTINUE;
-- try again if SendFailed
startInfo: GVSend.StartSendInfo;
stepper: LIST OF RName;
numRecips: INT ← 0;
numValidRecips: INT;
firstInvalidUser: BOOL← TRUE;
numInvalidUsers: INTEGER← 0;
ReportFromSend: PROC[r: ROPE] = { InternalReport[r]};
InvalidUserProc:
PROC [ userNum:
INT, userName: RName ] = {
IF firstInvalidUser THEN {ReportFromSend["\nInvalid user(s): "]; firstInvalidUser← FALSE};
SELECT numInvalidUsers ← numInvalidUsers + 1
FROM
1 => ReportFromSend[userName];
IN [2..5] => {ReportFromSend[", "]; ReportFromSend[userName]};
6 => ReportFromSend[", ..."];
ENDCASE;
} ;
sent ← FALSE ;
startInfo ← GVSend.StartSend[ handle: h,
senderPwd: UserCredentials.Get[].password,
sender: userRName,
returnTo: userRName,
validate: validateFlag
] ;
SELECT startInfo
FROM
badPwd => {ReportFromSend["\nInvalid password"]; RETURN};
badSender => {ReportFromSend["\nInvalid sender name"]; RETURN};
badReturnTo => {ReportFromSend["\nBad return-to field"]; RETURN};
allDown => {ReportFromSend["\nAll servers are down"]; RETURN};
ok => {
stepper ← smr.to;
WHILE stepper #
NIL
DO
GVSend.AddRecipient[ h, stepper.first ];
numRecips ← numRecips + 1;
stepper ← stepper.rest;
ENDLOOP;
IF CheckForAbort[] THEN RETURN;
stepper ← smr.cc;
WHILE stepper #
NIL
DO
GVSend.AddRecipient[ h, stepper.first ] ;
numRecips ← numRecips + 1 ;
stepper ← stepper.rest ;
ENDLOOP ;
IF CheckForAbort[] THEN RETURN;
IF validateFlag
THEN {
IF (numValidRecips← GVSend.CheckValidity[ h, InvalidUserProc]) = 0
THEN {
ReportFromSend["\nThere were NO valid recipients."]; RETURN
};
IF numValidRecips # numRecips
THEN {
tempInteger: INT ← numRecips-numValidRecips;
ReportFromSend[IO.PutFR["\nThere were %g invalid recipients,", IO.int[tempInteger] ]];
RETURN;
};
};
IF CheckForAbort[] THEN RETURN;
ReportFromSend[IO.PutFR["..sending to %g recipients", IO.int[numValidRecips]]];
validateFlag← FALSE; -- if sending fails, don't need to re-validate
GVSend.StartItem[h, Text];
AddToItem[h, smr.fullText];
IF formatting#
NIL
THEN {
-- send the formatting info as a second item
GVSend.StartItem[h, TiogaCTRL];
AddToItem[h, formatting]
};
IF CheckForAbort[] 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;
};
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
CanonicalName:
PUBLIC
PROC [simpleName, registry:
ROPE]
RETURNS[name:
ROPE] = {
name← simpleName;
IF registry.Length[] = 0
THEN name← name.Cat[".", userRegistry]
ELSE name← name.Cat[".", registry];
};
ParseTextToBeSent:
PROC[msg: SendingRec]
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] = '\n);
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← '\n
ELSE ch← GVMailParse.endOfInput;
mPos← mPos + 1;
};
RNameListField:
PROC[index: PeanutParse.MessageFieldIndex] = {
fieldBody, fbEnd: LIST OF RName← NIL;
AnotherRName:
PROC[r1, r2:
ROPE, isFile, isNested:
BOOL]
RETURNS [
ROPE,
BOOLEAN] = {
name: ROPE;
name← 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
ELSE
{ IF status # includesPrivateDL THEN status← includesPublicDL;
RETURN[NIL, FALSE];
};
GVMailParse.ParseNameList[pH, GetNextMsgChar, AnotherRName, NIL];
SELECT index
FROM
toF =>
IF msg.to =
NIL
THEN msg.to← fieldBody
ELSE IF fieldBody#NIL THEN
TRUSTED
{msg.to← LOOPHOLE[List.Append[LOOPHOLE[msg.to], LOOPHOLE[fieldBody]]]};
ccF, cF, bccF =>
IF msg.cc =
NIL
THEN msg.cc← fieldBody
ELSE IF fieldBody#NIL THEN
TRUSTED
{msg.cc← LOOPHOLE[List.Append[LOOPHOLE[msg.cc], LOOPHOLE[fieldBody]]]};
fromF => msg.from← fieldBody.first; -- needs to be non-NIL
ENDCASE => ERROR;
};
pH: GVMailParse.ParseHandle;
field: ROPE← NIL;
fieldNotRecognized: BOOL;
mPos← 0; -- where we are in the fulltext, for parsing
status← ok; -- start with good status
pH← GVMailParse.InitializeParse[];
DO
sPos← mPos;
[field, fieldNotRecognized]← GVMailParse.GetFieldName[pH, GetNextMsgChar ! GVMailParse.ParseError =>
{ GVMailParse.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: 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 ! GVMailParse.ParseError => GOTO errorExit];
replyToF => {msg.replyTo←
TRUE;
[]← GVMailParse.GetFieldBody[pH, GetNextMsgChar, TRUE]
};
subjectF => msg.subject← GVMailParse.GetFieldBody[pH, GetNextMsgChar];
voiceF => msg.voiceID← GVMailParse.GetFieldBody[pH, GetNextMsgChar];
ENDCASE => []← GVMailParse.GetFieldBody[pH, GetNextMsgChar, TRUE];
rCatList => []← GVMailParse.GetFieldBody[pH, GetNextMsgChar, TRUE];
rNameList => RNameListField[i ! GVMailParse.ParseError => GOTO errorExit];
ENDCASE => ERROR;
EXIT
};
};
ENDLOOP;
IF fieldNotRecognized THEN
[]← GVMailParse.GetFieldBody[pH, GetNextMsgChar]; -- skip anything not recognized
ENDLOOP;
now we are positioned at the beginning of the body of the message
GVMailParse.FinalizeParse[pH];
msg.endHeadersPos← mPos - 1;
if any recipient is at another arpa site, all recipients should be arpa qualified
however, like Laurel, we'll only do the From/Sender field in full arpa regalia
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];
UserProfile.CallWhenProfileChanges[PeanutSendInit];
END.