-- File: WalnutSendMailImpl.mesa
-- Contents: Implementation of the WalnutMsg Send operation
-- Last Edited by: Willie-Sue, December 7, 1982 3:30 pm
 -- Rick on: XXX
 -- Willie-Sue on: June 2, 1983 12:41 pm

DIRECTORY
GVBasics USING [ItemType, RName],
GVMailParse,
GVNames,
GVSend USING [Abort, AddRecipient, AddToItem, CheckValidity, Close, Create, Handle,
  Send, SendFailed, StartItem, StartSend, StartSendInfo],
Icons,
List USING [Append],
Menus,
IO,
Rope,
TEditDocumentRope USING[ Create ],
TiogaOps,
ViewerOps,
ViewerTools,
ViewerClasses,
UserCredentials USING [GetUserCredentials],
WalnutSendMail,
WalnutParse;

WalnutSendMailImpl: CEDAR MONITOR
IMPORTS
GVMailParse, GVNames, GVSend, List, IO, Rope,
TEditDocumentRope, TiogaOps,
ViewerOps, ViewerTools,
UserCredentials,
WalnutSendMail
EXPORTS
WalnutSendMail, WalnutParse =

BEGIN OPEN WalnutSendMail, WalnutParse;

-- Global types & variables

defaultRegistry: PUBLIC ROPE← "pa";

messageParseArray: PUBLIC ARRAY MessageFieldIndex OF MessageInfo ←
[ ["Reply-To", simpleRope],  -- this is really wrong, a special case for now
 ["Sender", simpleRope],
 ["From", simpleRope],
 ["To", rNameList],
 ["cc", rNameList],
 ["c", rNameList],
 ["bcc", rNameList],
 ["Date", simpleRope],
 ["Subject", simpleRope],
 ["Categories", rCatList],
 ["In-Reply-To", simpleRope]
 ];

-- ************************************************************************
SendMsg: PUBLIC PROC[senderV: Viewer, doClose: BOOL← FALSE] RETURNS[sendOk: BOOL] =
{ senderV.inhibitDestroy← TRUE;
ViewerOps.SetMenu[senderV, sendingMenu];
IF needToAuthenticate THEN
  { SenderReport["Authenticating user ..."];
  IF ~AuthenticateUser[] THEN
  {ViewerOps.BlinkIcon[senderV, IF senderV.iconic THEN 0 ELSE 1];
  ViewerOps.SetMenu[senderV, sendMenu];
  senderV.inhibitDestroy← FALSE;
  RETURN
  };
  SenderReport[" ...ok\n"];
  };
  sendOk← InternalSendMsg[senderV, doClose];
ViewerOps.SetMenu[senderV, sendMenu];
senderV.inhibitDestroy← FALSE;
};
-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

AuthenticateUser: PROC RETURNS [BOOL] =
BEGIN
auth: GVNames.AuthenticateInfo;
IF userRName.Length[] = 0 THEN {SenderReport["Please Login\n"]; RETURN[FALSE]};

 SELECT
auth←
GVNames.Authenticate[userRName, UserCredentials.GetUserCredentials[].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;
specialTxt, formatting: ROPE;
smr: SendingRec;
contents: ViewerTools.TiogaContents;
senderInfo: SenderInfo← NARROW[ViewerOps.FetchProp[senderV, $SenderInfo]];

sendOk← FALSE;
senderInfo.aborted← FALSE;
-- senderV.inhibitDestroy← TRUE;
-- ViewerOps.SetMenu[senderV, sendingMenu];

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←
TEditDocumentRope.Create[LOOPHOLE [TiogaOps.ViewerDoc[senderV]]]};

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

IF (status # ok) AND (status # includesPublicDL) THEN
BEGIN
 SELECT status FROM
  fieldNotAllowed =>
  IF sPos # mPos THEN
  { 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]]];
  syntaxError =>
  IF sPos # mPos THEN
  { 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]]];
  includesPrivateDL => SenderReport[" Private dl's are not yet implemented\n"];
  ENDCASE => ERROR;
  ViewerOps.BlinkIcon[senderV, IF senderV.iconic THEN 0 ELSE 1];
 RETURN;
END;

IF CheckForAbortSend[senderInfo] THEN RETURN;

IF (status = includesPublicDL OR smr.numRecipients > maxWithNoReplyTo) AND
~smr.replyTo THEN
{ howToReply: HowToReplyTo← self;
IF ~replyToSelf THEN
{ oldM: Menus.Menu← senderV.menu;
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];
};
IF howToReply # all THEN
  InsertIntoViewer[senderV,
    Rope.Concat["\nReply-To: ", userRName], smr.endHeadersPos-2];  --you dont't want to know why
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];

 specialTxt← Rope.Cat["Date: ", IO.PutFR[NIL, IO.time[]],
  IF smr.from = NIL THEN "\nFrom: " ELSE "\nSender: ", userRName, "\n"];
 InsertIntoViewer[senderV, specialTxt, 0];

 contents← ViewerTools.GetTiogaContents[senderV];
 IF (formatting← contents.formatting).Length[] = 0 THEN smr.fullText← contents.contents
  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]
  };

SenderReport["... Sending message..."];
IF senderInfo.successfullySent← sendOk← Send[smr, senderInfo, formatting]
THEN
{SenderReport[" ... Message has been delivered\n"];
senderInfo.prevMsg← contents;
senderInfo.numCharsToDelete← specialTxt.Length[] - 1;
}
ELSE
{DeleteChars[senderV, specialTxt.Length[] - 1];
  SenderReport["... Message NOT sent\n"];
  };
END;

InsertIntoViewer: PUBLIC PROC[v: Viewer, what: ROPE, where: INT] =
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];
  TiogaOps.InsertRope[what];
  ViewerTools.InhibitUserEdits[v];
  IF (prevV # v) AND (prevV#NIL) THEN
   SetSelection[prevV, prevStart, prevEnd, prevLevel, cb, pd];
END;
 CallWithLocks[InsertChars, thisV];
END;

DeleteChars: PUBLIC ENTRY PROC[v: Viewer, num: INT] =
BEGIN ENABLE UNWIND => NULL;
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[];
  IF (prevV # v) AND (prevV#NIL) THEN
   SetSelection[prevV, prevStart, prevEnd, prevLevel, cb, pd];
  END;
  CallWithLocks[DelChars, thisV];
END;

-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Send: PROC[smr: SendingRec, senderInfo: SenderInfo, formatting: ROPE]
  RETURNS[ sent: BOOLEAN] =
{ InitSending: ENTRY PROC =
{ ENABLE UNWIND => NULL;
senderInfo.sendHandle← GVSend.Create[];
senderInfo.validateFlag← TRUE;
senderInfo.aborted← FALSE;
};
FinishedSending: ENTRY PROC =
{ ENABLE UNWIND => NULL;
IF senderInfo.sendHandle#NIL THEN GVSend.Close[senderInfo.sendHandle];
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.GetUserCredentials[].password,
     sender: userRName,
     returnTo: userRName,
     validate: senderInfo.validateFlag
     ] ;
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 senderInfo.validateFlag THEN
{ IF (numValidRecips← GVSend.CheckValidity[ h, InvalidUserProc]) = 0 THEN
   { SenderReport["\nThere were NO valid recipients; do you wish to send anyway?\n"];
   IF ~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 ~Confirmation[senderInfo] THEN {GVSend.Abort[h]; RETURN};
    };
  };

  IF CheckForAbortSend[senderInfo] THEN RETURN;
  SenderReport[IO.PutFR["..sending to %g recipients\n", IO.int[numValidRecips]]];
  senderInfo.validateFlag← FALSE;  -- if sending fails, don't need to re-validate
  GVSend.StartItem[h, Text];
  GVSend.AddToItem[h, smr.fullText];
  IF formatting#NIL THEN { -- send the formatting info as a second item
  GVSend.StartItem[h, TiogaCTRL]; GVSend.AddToItem[h, formatting] };
 ViewerOps.SetMenu[senderInfo.senderV, blankMenu];
IF CheckForAbortSend[senderInfo] THEN RETURN;
GVSend.Send[ h ] ;
sent← TRUE;
RETURN;
} ;
ENDCASE ;
ENDLOOP;
} ;

-- * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
CanonicalName: PUBLIC PROC [simpleName, registry: ROPE] RETURNS[name: ROPE] =
BEGIN
 name← simpleName;
 IF registry.Length[] = 0 THEN name← name.Cat[".", defaultRegistry]
  ELSE name← name.Cat[".", registry];
END;

ParseTextToBeSent:
PROC[msg: SendingRec] RETURNS[status: SendParseStatus, sPos, mPos: INT] =
BEGIN OPEN GVMailParse;
mLF: 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← endOfInput;
mPos← mPos + 1;
};

RNameListField: PROC[index: MessageFieldIndex] =
BEGIN
fieldBody, fbEnd: LIST OF RName← NIL;
AnotherRName: PROC[r1, r2: ROPE, isFile, isNested: BOOL] RETURNS [ROPE, BOOLEAN] =
BEGIN
   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;
   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
     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;
END;

pH: ParseHandle;
field: ROPE← NIL;
fieldNotRecognized: BOOL;
mPos← 0;  -- where we are in the fulltext, for parsing
 status← ok;  -- start with good status

pH← InitializeParse[];

DO
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: MessageFieldIndex IN MessageFieldIndex DO
{ mLF← messageParseArray[i];
IF Rope.Equal[messageParseArray[i].name, field, FALSE] THEN -- ignore case
 { fieldNotRecognized← FALSE;
SELECT mLF.fType FROM
   simpleRope =>
    IF i = fromF THEN RNameListField[i ! ParseError => GOTO errorExit] ELSE
    {IF i = replyToF THEN msg.replyTo← TRUE;
     []← 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;

-- 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];
END;

END.