-- MTPSender.mesa
-- Edited by Levin, October 16, 1980 5:07 PM
-- Edited by Schroeder, March 4, 1981 12:35 PM
-- Edited by Brotz, March 7, 1983 11:14 AM
DIRECTORY
Core USING [DMSUser],
exD: FROM "ExceptionDefs" USING [AppendStringToExceptionLine,
cantConnectToMailServer, DisplayExceptionString, ExceptionLineOverflow, ftpError,
GetExceptionString, nil],
FTPDefs USING [FTPBeginDeliveryOfMessage, FTPCreateUser, FTPDestroyUser,
FTPEndDeliveryOfMessage, FTPError, FTPIdentifyNextRejectedRecipient, FTPInitialize,
FTPOpenConnection, FTPSendBlockOfMessage, FTPSendRecipientOfMessage,
FTPSetCredentials, FTPUser, PupCommunicationPrimitives],
intCommon USING [profileSend],
LaurelSendDefs USING [AbortPoint, DeliverBody, EnumerateRecipientList, FromState,
GetRecipients, InsertReplyToField, NoticeUserAbort, ReportDelivery, ReportError,
ReportProgress, ReportRejectedRecipients, RetryThis, SendErrorType, SendMode],
String USING [AppendChar, AppendDecimal, AppendString];
MTPSender: PROGRAM
IMPORTS exD, FTPDefs, intC: intCommon, LaurelSendDefs, String
EXPORTS LaurelSendDefs =
BEGIN OPEN LaurelSendDefs;
MTPSend: PUBLIC PROCEDURE [sendMode: SendMode, fromState: FromState,
replyTo: BOOLEAN, userFeedback: BOOLEAN, formatProc: PROCEDURE,
user: Core.DMSUser] =
BEGIN
screenStringLength: CARDINAL = 100;
maxRecipientsWithoutConfirmation: CARDINAL = 20;
utilityString: STRING = [screenStringLength];
ftpUser: FTPDefs.FTPUser ← NIL;
ftpFrontM: STRING ← [30];
ftpErrorCode: SendErrorType ← ftpError;
rejectedRecipients, recipients: CARDINAL;
charsDelivered: CARDINAL ← 0;
CollectErrors1: PROCEDURE =
BEGIN
thisRecipient, recipNo: CARDINAL;
nameListFull: BOOLEAN ← FALSE;
nameList: STRING ← [screenStringLength];
FindRecipient: PROCEDURE [newName: STRING] RETURNS [BOOLEAN] =
BEGIN
IF thisRecipient = recipNo THEN
BEGIN
IF nameList.length+newName.length+3 <= nameList.maxlength THEN
BEGIN
IF rejectedRecipients > 0 THEN String.AppendString[nameList, ", "L];
String.AppendString[nameList, newName];
END
ELSE nameListFull ← TRUE;
RETURN[TRUE]
END;
thisRecipient ← thisRecipient+1;
RETURN[FALSE]
END; -- of FindRecipient --
nameList.length ← 0;
FOR rejectedRecipients ← 0, rejectedRecipients + 1 DO
utilityString.length ← 0;
[recipNo, ] ← FTPDefs.FTPIdentifyNextRejectedRecipient[ftpUser, utilityString];
IF recipNo = 0 THEN EXIT;
NoticeUserAbort[]; --must keep going until no more errors
IF NOT nameListFull THEN
{thisRecipient ← 1; [] ← EnumerateRecipientList[0, FindRecipient]};
ENDLOOP;
AbortPoint[];
IF userFeedback AND rejectedRecipients > 0 AND sendMode = red THEN
ReportRejectedRecipients[rejectedRecipients, nameList, nameListFull];
END; -- of CollectErrors1 --
CollectErrors2: PROCEDURE =
BEGIN
errorFound: BOOLEAN ← FALSE;
recipNo: CARDINAL;
DO
utilityString.length ← 0;
[recipNo, ] ← FTPDefs.FTPIdentifyNextRejectedRecipient[ftpUser, utilityString];
IF recipNo # 0 THEN errorFound ← TRUE ELSE EXIT;
ENDLOOP;
IF errorFound THEN ReportError[unexpectedResponse, NIL, 0, 0];
END; -- of CollectErrors2 --
SendRecipient: PROCEDURE[name: STRING] RETURNS[BOOLEAN] =
BEGIN
FTPDefs.FTPSendRecipientOfMessage[ftpUser, name, NIL, NIL];
AbortPoint[];
RETURN[FALSE] --stop sending recipients if abort
END; -- of SendRecipient --
SendBodyBlock: PROCEDURE[block: POINTER, bytes: CARDINAL] =
BEGIN
FTPDefs.FTPSendBlockOfMessage[ftpUser, block, bytes];
charsDelivered ← charsDelivered+bytes;
END;
ConstructFTPErrorMessage: PROCEDURE[back: STRING] =
BEGIN
utilityString.length ← 0;
IF ftpFrontM # NIL THEN --presume it fits
String.AppendString[utilityString, ftpFrontM];
IF back # NIL THEN --hope ftp won’t mind smashed string length
BEGIN
back.length ← MIN[back.length, utilityString.maxlength-utilityString.length];
String.AppendString[utilityString, back];
END;
END;
BuildCredentialsString: PROCEDURE =
BEGIN
utilityString.length ← 0;
String.AppendString[utilityString, user.name];
String.AppendChar[utilityString, ’.];
String.AppendString[utilityString, user.registry];
END; -- of BuildCredentialsString --
-- main body of Send
AbortPoint[];
recipients ← GetRecipients[];
utilityString.length ← 0;
String.AppendDecimal[utilityString, recipients];
String.AppendString[utilityString, " recipient"L];
IF recipients # 1 THEN String.AppendChar[utilityString, ’s];
IF userFeedback AND sendMode = red AND ~replyTo
AND recipients > maxRecipientsWithoutConfirmation
THEN {exD.DisplayExceptionString[utilityString]; InsertReplyToField[user]};
formatProc[];
ReportProgress[exD.nil, utilityString, TRUE];
BEGIN
ENABLE BEGIN
FTPDefs.FTPError =>
BEGIN
AbortPoint[]; -- if user abort given then this will cause SendError
ConstructFTPErrorMessage[message];
ReportError[ftpErrorCode, utilityString, 0, 0]; -- causes SendError
END;
UNWIND =>
IF ftpUser # NIL THEN
FTPDefs.FTPDestroyUser[ftpUser ! FTPDefs.FTPError => CONTINUE];
END;
ftpUser ← FTPDefs.FTPCreateUser[NIL, FTPDefs.PupCommunicationPrimitives[]];
BuildCredentialsString[];
FTPDefs.FTPSetCredentials[ftpUser, primary, utilityString, NIL];
exD.GetExceptionString[exD.cantConnectToMailServer, ftpFrontM];
DO
sendHost: STRING = IF intC.profileSend # NIL THEN intC.profileSend ELSE user.registry;
IF userFeedback THEN exD.AppendStringToExceptionLine
[" ..."L, 1 ! exD.ExceptionLineOverflow => CONTINUE];
FTPDefs.FTPOpenConnection[ftpUser, sendHost, mail, NIL
! FTPDefs.FTPError =>
BEGIN
ConstructFTPErrorMessage[message];
IF RetryThis[utilityString]
THEN LOOP ELSE ReportError[cantConnect, NIL, 0, 0];
END];
EXIT;
ENDLOOP;
AbortPoint[];
exD.GetExceptionString[exD.ftpError, ftpFrontM];
FTPDefs.FTPBeginDeliveryOfMessage[ftpUser];
IF userFeedback THEN exD.AppendStringToExceptionLine
["."L, 1 ! exD.ExceptionLineOverflow => CONTINUE];
[] ← EnumerateRecipientList[user.registry.length + 1, SendRecipient];
CollectErrors1[];
DeliverBody[user, fromState, userFeedback, SendBodyBlock];
--can’t stop delivery from here on
CollectErrors2[];
ftpErrorCode ← uncertainClosing;
FTPDefs.FTPEndDeliveryOfMessage[ftpUser];
FTPDefs.FTPDestroyUser[ftpUser];
END; -- of ENABLE
IF userFeedback THEN ReportDelivery
[charsDelivered, recipients - rejectedRecipients, recipients];
END; -- MTPSend --
-- start code for module
FTPDefs.FTPInitialize[];
END. -- of SendOp --