-- Transport Mechanism - fetches MTP distribution lists --

-- [Juniper]<DMS>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.