-- Transport Mechanism - fetches MTP distribution lists -- -- [Juniper]MS>DLFetcher.mesa -- HGM, 13-Nov-84 1:43:50 -- 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.