-- Transport Mechanism - fetches MTP distribution lists --

-- [Juniper]<DMS>MS>DLFetcher.mesa

-- Randy Gobbel		19-May-81 13:28:57 --
-- Mike Schroeder	September 19, 1980  12:08 PM --
-- Andrew Birrell	30-Sep-80 16:45:56 --

DIRECTORY
Ascii,
BodyDefs	USING[ maxRNameLength, RName, RNameSize ],
FTPDefs		USING[CommunicationError, FileHandle, FileInfo,
		      FilePrimitives, FilePrimitivesObject, FileType,
		      FileError, FileSystem, FTPCreateUser, FTPDestroyUser,
		      FTPError, FTPOpenConnection, FTPRetrieveFile, FTPUser,
		      Mode, ProtocolError, PupCommunicationPrimitives,
		      UnidentifiedError ],
HeapDefs	USING[ HeapAbandonWrite, HeapEndWrite, HeapStartRead,
		       HeapStartWrite, HeapWriteData, HeapWriteRName,
		       ObjectNumber, objectStart, ReaderHandle,
		       SetWriterOffset, WriterHandle ],
PupDefs		USING[ AppendPupAddress, PupAddress ],
PupTypes	USING[ mailSoc ],
ServerDefs	USING[ NoSuchServer, ServerAddr, ServerNotUp ],
SiteCacheDefs	USING[ RecipientInfo ],
String		USING[ AppendChar, AppendString, StringBoundsFault ];

DLFetcher: PROGRAM
IMPORTS BodyDefs, FTPDefs, HeapDefs, PupDefs, ServerDefs, String
EXPORTS SiteCacheDefs =

BEGIN

OPEN Ascii, FTPDefs, String;

FetchDL: PROCEDURE[dlName: BodyDefs.RName,
                   host: STRING,
                   owner: BodyDefs.RName]
	   RETURNS[dl: SiteCacheDefs.RecipientInfo] = BEGIN

--variables--

	ftpUser: FTPUser;
	myFilePrimitivesObject: FilePrimitivesObject;
	writer: HeapDefs.WriterHandle;
	reader: HeapDefs.ReaderHandle;

	SyntaxError: SIGNAL = CODE;

-- my file system --

	MyCreateFileSystem: PROCEDURE [bufferSize: CARDINAL]
			RETURNS [fileSystem: FileSystem] = {RETURN[NIL]};

	MyDestroyFileSystem: PROCEDURE [fileSystem: FileSystem] = {};

	MyCloseFile: PROCEDURE [fileSystem: FileSystem, fileHandle: FileHandle,
			aborted: BOOLEAN] = {};

	MyOpenFile: PROCEDURE [fileSystem: FileSystem, file: STRING, mode: Mode,
			fileTypePlease: BOOLEAN, info: FileInfo] RETURNS [fileHandle: FileHandle,
			fileType: FileType] = BEGIN
		IF info.author # NIL AND info.author.length # 0
		AND owner # NIL
			THEN AppendString[owner, info.author ! StringBoundsFault => CONTINUE];
		RETURN[NIL, unknown];
		END;

	MyWriteFile: PROCEDURE [fileSystem: FileSystem, fileHandle: FileHandle,
			receiveBlock: PROC [UNSPECIFIED, POINTER, CARDINAL] RETURNS [CARDINAL], 
			receiveBlockData: UNSPECIFIED] = BEGIN
		colonSeen, semicolonSeen, boundFault: BOOLEAN _ FALSE;
		position, bytes: CARDINAL;
		name: BodyDefs.RName = [BodyDefs.maxRNameLength];
		bufferLength: CARDINAL = 100;
		buffer: PACKED ARRAY [0..2*bufferLength) OF CHARACTER;
		rListLength: CARDINAL _ 0;
		NextChar: PROCEDURE RETURNS [ch: CHARACTER] =
			BEGIN
				IF bytes = 0
					THEN ch _ NUL
					ELSE BEGIN
						ch _ buffer[position];
						position _ position + 1;
						IF position = bytes THEN BEGIN
							bytes _ receiveBlock[receiveBlockData,@buffer,bufferLength];
							position _ 0
							END;
						END;
			END; --NextChar--
		position _ 0;
		bytes _ receiveBlock[receiveBlockData,@buffer,bufferLength];
		DO
			c: CHARACTER;
			name.length _ 0;
			DO
				SELECT (c _ NextChar[]) FROM
					NUL, ', => IF boundFault THEN SIGNAL SyntaxError ELSE EXIT;
					'; => IF (NOT colonSeen) OR semicolonSeen
							THEN SIGNAL SyntaxError
							ELSE {semicolonSeen _ TRUE; EXIT};
					': => IF colonSeen
							THEN SIGNAL SyntaxError
							ELSE {boundFault _ FALSE; name.length _ 0; colonSeen _ TRUE};
					SP, TAB, CR => NULL;
					'( => UNTIL ([] _ NextChar[]) = ') DO ENDLOOP;
					ENDCASE => AppendChar[name, c ! StringBoundsFault =>
									{name.length _ 0; boundFault _ TRUE; CONTINUE}];
			ENDLOOP;
		IF name.length = 0
			THEN BEGIN
				IF c # NUL THEN LOOP; 
				HeapDefs.SetWriterOffset[writer, HeapDefs.objectStart];
				SetRListLength[rListLength];
				EXIT -- done
				END
			ELSE BEGIN --process name
				rListLength _ rListLength + BodyDefs.RNameSize[name];
				HeapDefs.HeapWriteRName[writer, name];
				END;
		ENDLOOP;
		END; -- of MyWriteFile --

	SaveReader: PROCEDURE[obj: HeapDefs.ObjectNumber] =
		{reader _ HeapDefs.HeapStartRead[obj]};

	SetRListLength: PROCEDURE[l: CARDINAL] = INLINE
		{HeapDefs.HeapWriteData[writer, [@l, SIZE[CARDINAL]]];};

	myFilePrimitivesObject.CreateFileSystem _ MyCreateFileSystem;
	myFilePrimitivesObject.OpenFile _ MyOpenFile;
	myFilePrimitivesObject.WriteFile _ MyWriteFile;
	myFilePrimitivesObject.CloseFile _ MyCloseFile;
	myFilePrimitivesObject.DestroyFileSystem _ MyDestroyFileSystem;
	ftpUser _ FTPCreateUser[@myFilePrimitivesObject, PupCommunicationPrimitives[]];
	BEGIN -- for exits --
		FTPOpenConnection[ftpUser, host, files, NIL !
			FTPError =>  SELECT ftpError FROM
				-- noSuchHost can't happen --
				IN CommunicationError, IN ProtocolError, IN UnidentifiedError =>
					{dl _ [allDown[]]; GOTO done;};
				ENDCASE => NULL
			];
		writer _ HeapDefs.HeapStartWrite[temp];
		SetRListLength[0];
		[] _ FTPRetrieveFile[ftpUser, NIL, dlName, unknown !
			SyntaxError => BEGIN
				HeapDefs.HeapAbandonWrite[writer];
				dl _ [notFound[]]; GOTO done;
				END;
			FTPError => BEGIN
				HeapDefs.HeapAbandonWrite[writer];
				SELECT ftpError FROM
					illegalFilename, noSuchFile => {dl _ [notFound[]]; GOTO done;};
					IN CommunicationError, IN FileError, IN ProtocolError,
						IN UnidentifiedError => {dl _ [allDown[]]; GOTO done;};
					ENDCASE => NULL;
				END ];
		HeapDefs.HeapEndWrite[writer, SaveReader];
		dl _ [foreign[reader]];
		IF owner.length # 0 THEN FOR i:CARDINAL IN [0..dlName.length) DO
			IF dlName[i] = '^ THEN BEGIN
				 FOR j:CARDINAL IN [i+1..dlName.length) DO
					AppendChar[owner, dlName[j]];
					ENDLOOP;
					EXIT;
				END;
			REPEAT FINISHED => owner.length _ 0;
			ENDLOOP;
		EXITS
			done => NULL;
		END;
	FTPDestroyUser[ftpUser];
	END;

ForeignDL: PUBLIC PROC[ who: BodyDefs.RName,
                        oldInfo: SiteCacheDefs.RecipientInfo ]
               RETURNS[ newInfo: SiteCacheDefs.RecipientInfo ] =
   BEGIN
   -- If "who" is "thing^.where", oldInfo is info for "where.foreign" --
   WITH old: oldInfo SELECT FROM
     found =>
       BEGIN
       addr: PupDefs.PupAddress _ ServerDefs.ServerAddr[old.server !
          ServerDefs.NoSuchServer => {newInfo _ [notFound[]]; GOTO noAddr };
          ServerDefs.ServerNotUp => {newInfo _ [allDown[]]; GOTO noAddr } ];
       host: STRING = [11] --377#377#377--;
       author: BodyDefs.RName _ [BodyDefs.maxRNameLength];
       addr.socket _ PupTypes.mailSoc;
       PupDefs.AppendPupAddress[host, addr];
       newInfo _ FetchDL[who, host, author];
       EXITS noAddr => NULL;
       END;
   ENDCASE => newInfo _ oldInfo;
   END;

END.