-- TestFTP.mesa
-- HGM,  July 31, 1980  1:18 AM  
-- MAS,  July 9, 1980  8:44 PM  
  
DIRECTORY
  FTPDefs USING [
    VirtualFilename, FileInfo, FtpError, Intent,
    FTPError, FTPInitialize, FTPFinalize,
    FTPUser, FTPCreateUser, FTPSetCredentials, FTPDestroyUser,
    FTPOpenConnection, FTPCloseConnection, FTPRenewConnection,
    FTPEnumerateFiles, FTPDeleteFile, FTPRenameFile,
    FTPRetrieveFile, FTPNoteFilenameUsed, FTPStoreFile, FTPTransferFile,
    FTPInventoryDumpFile, FTPBeginDumpFile, FTPEndDumpFile,
    AltoFilePrimitives, PupCommunicationPrimitives],
  PupDefs USING [SetPupCheckit, UseAltoChecksumMicrocode],
  Inline USING [LowHalf],
  ImageDefs USING [StopMesa],
  IODefs USING [CR, WriteChar, WriteLine, WriteString],
  OsStaticDefs USING [OsStatics],
  Runtime USING [CallDebugger],
  SegmentDefs USING [
    MemoryConfig, GetMemoryConfig,
    FileHandle, Write, Read, OldFileOnly, FileNameError,
    NewFile, DestroyFile, GetFileTimes, GetEndOfFile],
  StreamDefs USING [
    StreamHandle, CreateByteStream, FileLength, GetPosition, SetPosition, ReadBlock],
  StringDefs USING [AppendLongDecimal, BcplToMesaString, EquivalentStrings],
  Storage USING [Pages, FreePages];
  
TestFTP: PROGRAM
  IMPORTS
    Inline, ImageDefs, IODefs, Runtime, SegmentDefs, StringDefs, StreamDefs, Storage,
    FTPDefs, PupDefs =
  BEGIN
  OPEN IODefs, FTPDefs;
  
-- Fiddle these to switch to another server
-- There are also a few specific names used for testing access and timings
  user: STRING _ [40];
  password: STRING _ [40];
  isSapsford: BOOLEAN = IsSapsford[];

  IsSapsford: PROCEDURE RETURNS [BOOLEAN] =
    BEGIN
    StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserName, user];
    RETURN[StringDefs.EquivalentStrings[user, "Sapsford"L]];
    END;

  defaultServer: STRING = IF isSapsford THEN "Igor" ELSE "Idun";
  mesaServer: STRING = "Iris";
  currentServer: STRING;


  remoteScratch1: STRING = "Scratch.1$";
  remoteScratch2: STRING = "Scratch.2$";
  remoteScratch3: STRING = "Scratch.3$";
  remoteScratches: STRING = "Scratch.*!*";
  localScratch: STRING = "Foo.$";
  localScratch2: STRING = "Baz.$";

  ftpuser: FTPUser;

  WriteLong: PROCEDURE [n: LONG CARDINAL] =
    BEGIN
    s: STRING = [20];
    StringDefs.AppendLongDecimal[s,n];
    WriteString[s];
    END;

  clock: POINTER TO INTEGER = LOOPHOLE[430B];
  msPerTick: CARDINAL = 39;
  ticksPerSecond: CARDINAL = 1000/msPerTick;
  when: INTEGER;

  StartTiming: PROCEDURE [s: STRING] =
    BEGIN
    WriteString[s];
    when _ clock^;
    END;

  StopTiming: PROCEDURE [s: STRING, bytes: LONG CARDINAL _ 0] =
    BEGIN
    ms: LONG CARDINAL _ LONG[clock^-when]*msPerTick;
    IF bytes#0 THEN WriteLong[bytes];
    WriteString[s];
    WriteString[", "];
    WriteLong[ms];
    WriteString[" ms"];
    IF bytes#0 THEN
      BEGIN
      WriteString[", "];
      WriteLong[8*(bytes*1000/ms)];
      WriteString[" bits/sec"];
      END;
    WriteLine["."];
    when _ clock^;
    END;

  Pause: PROCEDURE [seconds: INTEGER] =
    BEGIN
    when _ clock^;
    UNTIL (clock^-when)>(seconds*ticksPerSecond) DO ENDLOOP;
    END;

  Start: PROCEDURE [server: STRING, quiet: BOOLEAN _ FALSE] =
    BEGIN
    serverText: STRING = [100];
    currentServer _ server;
    IF ~quiet THEN
      BEGIN
      StartTiming["Opening FTP connection to "];
      WriteString[server];
      WriteString[" ..."];
      END;
    FTPInitialize[];
    ftpuser _ FTPCreateUser[AltoFilePrimitives[],PupCommunicationPrimitives[]];
    StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserName, user];
    StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserPassword, password];
    FTPSetCredentials[ftpuser, primary, user, password];
    FTPOpenConnection[ftpuser,server,files,serverText];
    IF ~quiet THEN
      BEGIN
      StopTiming[" ok"];
      WriteLine[serverText];
      END;
    END;

  ReOpen: PROCEDURE =
    BEGIN
    serverText: STRING = [100];
    FTPCloseConnection[ftpuser];
    FTPOpenConnection[ftpuser,currentServer,files,serverText];
    END;

  List: PROCEDURE [remote: STRING] =
    BEGIN
    Lister: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN
      WriteString["  "];
      WriteString[name];
      IF info.creationDate#NIL THEN
        BEGIN
        THROUGH [name.length..25) DO WriteChar[' ]; ENDLOOP;
        WriteString[info.creationDate];
        END;
      WriteChar[CR];
      END;
    StartTiming["Listing "];
    WriteString[remote];
    WriteLine[" ..."];
    FTPEnumerateFiles[ftpuser, remote, enumeration, Lister, NIL];
    StopTiming["End of listing"];
    END;

  ListViaTemp: PROCEDURE [remote: STRING] =
    BEGIN
    Lister: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN
      WriteString["  "];
      WriteString[name];
      IF info.creationDate#NIL THEN
        BEGIN
        THROUGH [name.length..25) DO WriteChar[' ]; ENDLOOP;
        WriteString[info.creationDate];
        END;
      WriteChar[CR];
      END;
    StartTiming["Listing "];
    WriteString[remote];
    WriteLine[" ..."];
    FTPEnumerateFiles[ftpuser, remote, unspecified, Lister, NIL];
    StopTiming["End of listing"];
    END;

  ListDump: PROCEDURE [remote: STRING] =
    BEGIN
    Lister: PROCEDURE [x: UNSPECIFIED, name: STRING, y, z: UNSPECIFIED] =
      BEGIN
      WriteString["  "];
      WriteLine[name];
      END;
    StartTiming["Listing contents of "];
    WriteString[remote];
    WriteLine[" ..."];
    FTPInventoryDumpFile[ftpuser, remote, enumeration, Lister, NIL];
    StopTiming["End of listing"];
    END;

  RetrieveStar: PROCEDURE [discard, remote: STRING] =
    BEGIN
    Snarf: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN
      WriteString["  "];
      Retrieve[discard,name];
      END;
    WriteString["Multiple Retrieving "];
    WriteString[remote];
    WriteLine[" ..."];
    FTPEnumerateFiles[ftpuser, remote, retrieval, Snarf, NIL];
    WriteLine["End of Multiple Retrieve."];
    END;

  Retrieve: PROCEDURE [local, remote: STRING] =
    BEGIN
    bc: LONG CARDINAL;
    StartTiming[local];
    WriteString[" <= ["];
    WriteString[currentServer];
    WriteString["]"];
    WriteString[remote];
    WriteString[" ... "];
    bc _ FTPRetrieveFile[ftpuser, local, remote, unknown];
    StopTiming[" bytes", bc];
    END;

  SingleRetrieve: PROCEDURE [server, local, remote: STRING] =
    BEGIN
    bc: LONG CARDINAL;
    user: STRING _ [40];
    password: STRING _ [40];
    serverText: STRING = [100];
    StartTiming["Single retrieve: "];
    WriteString[local];
    WriteString[" <= ["];
    WriteString[server];
    WriteString["]"];
    WriteString[remote];
    WriteString[" ... "];
    FTPInitialize[];
    ftpuser _ FTPCreateUser[AltoFilePrimitives[],PupCommunicationPrimitives[]];
    StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserName, user];
    StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserPassword, password];
    FTPSetCredentials[ftpuser, primary, user, password];
    FTPOpenConnection[ftpuser,server,files,serverText];
    bc _ FTPRetrieveFile[ftpuser, local, remote, unknown];
    FTPCloseConnection[ftpuser];
    FTPDestroyUser[ftpuser];
    FTPFinalize[];
    StopTiming[" bytes",bc];
    END;

  Store: PROCEDURE [local, remote: STRING] =
    BEGIN
    bc: LONG CARDINAL;
    StartTiming[local];
    WriteString[" => ["];
    WriteString[currentServer];
    WriteString["]"];
    WriteString[remote];
    WriteString[" ... "];
    bc _ FTPStoreFile[ftpuser, local, remote, binary];
    StopTiming[" bytes", bc];
    END;

  SingleStore: PROCEDURE [server, local, remote: STRING] =
    BEGIN
    bc: LONG CARDINAL;
    user: STRING _ [40];
    password: STRING _ [40];
    serverText: STRING = [100];
    StartTiming["Single store: "];
    StartTiming[local];
    WriteString[" => ["];
    WriteString[server];
    WriteString["]"];
    WriteString[remote];
    WriteString[" ... "];
    FTPInitialize[];
    ftpuser _ FTPCreateUser[AltoFilePrimitives[],PupCommunicationPrimitives[]];
    StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserName, user];
    StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserPassword, password];
    FTPSetCredentials[ftpuser, primary, user, password];
    FTPOpenConnection[ftpuser,server,files,serverText];
    bc _ FTPStoreFile[ftpuser, local, remote, binary];
    FTPCloseConnection[ftpuser];
    FTPDestroyUser[ftpuser];
    FTPFinalize[];
    StopTiming[" bytes",bc];
    END;

  DeleteStar: PROCEDURE [remote: STRING] =
    BEGIN
    Kill: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN
      WriteString["  "];
      Delete[name];
      END;
    WriteString["Multiple Delete of "];
    WriteString[remote];
    WriteLine[" ..."];
    FTPEnumerateFiles[ftpuser, remote, deletion, Kill, NIL];
    WriteLine["End of deleting."];
    END;

  Delete: PROCEDURE [remote: STRING] =
    BEGIN
    StartTiming["Deleting "];
    WriteString[remote];
    WriteString[" ..."];
    FTPDeleteFile[ftpuser, remote];
    StopTiming[" ok"];
    END;

  Rename: PROCEDURE [old, new: STRING] =
    BEGIN
    StartTiming["Renaming "];
    WriteString[old];
    WriteString[" to be "];
    WriteString[new];
    WriteString[" ..."];
    FTPRenameFile[ftpuser, old, new];
    StopTiming[" ok"];
    END;

  StartDumping: PROCEDURE [where: STRING] =
    BEGIN
    WriteString["Dumping things into "];
    WriteString[where];
    WriteString[" ..."];
    FTPBeginDumpFile[ftpuser,where];
    WriteChar[CR];
    END;

  StopDumping: PROCEDURE =
    BEGIN
    FTPEndDumpFile[ftpuser];
    WriteLine["End of Dumping."];
    END;

  Load: PROCEDURE [local, remote: STRING] =
    BEGIN
    Loader: PROCEDURE [x: UNSPECIFIED, name: STRING, y, z: UNSPECIFIED] =
      BEGIN
      WriteString["  "];
      IF local#NIL THEN Retrieve[local, name]  -- all into one
      ELSE Retrieve[name, name]; -- use name from dump file
      END;
    WriteString["Loading "];
    WriteString[remote];
    WriteLine[" ..."];
    FTPInventoryDumpFile[ftpuser, remote, retrieval, Loader, NIL];
    WriteLine["End of load"];
    END;

  Transfer: PROCEDURE [from, source, destination: STRING] =
    BEGIN
    bc: LONG CARDINAL;
    user: STRING _ [40];
    password: STRING _ [40];
    serverText: STRING = [100];
    temp: FTPUser;
    FTPInitialize[];
    temp _ FTPCreateUser[AltoFilePrimitives[],PupCommunicationPrimitives[]];
    StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserName, user];
    StringDefs.BcplToMesaString[OsStaticDefs.OsStatics.UserPassword, password];
    FTPSetCredentials[temp, primary, user, password];
    FTPOpenConnection[temp,from,files,serverText];
    WriteLine[serverText];
    StartTiming["Transfer: ["];
    WriteString[from];
    WriteString["]"];
    WriteString[source];
    WriteString[" => ["];
    WriteString[currentServer];
    WriteString["]"];
    WriteString[destination];
    WriteString[" ... "];
    bc _ FTPTransferFile[temp,source,ftpuser,destination,unknown,NIL,NIL];
    StopTiming[" bytes",bc];
    FTPCloseConnection[temp];
    FTPDestroyUser[temp];
    FTPFinalize[];
    END;

  Stop: PROCEDURE [quiet: BOOLEAN _ FALSE] =
    BEGIN
    IF ~quiet THEN StartTiming["Closing down ..."];
    FTPCloseConnection[ftpuser];
    FTPDestroyUser[ftpuser];
    FTPFinalize[];
    IF ~quiet THEN StopTiming[" ok"];
    END;

  SimpleTest: PROCEDURE [localFile: STRING] =
    BEGIN
    Store[localFile, remoteScratch1];
    Retrieve[localScratch, remoteScratch1];
    List[remoteScratch1];
    Delete[remoteScratch1];
    CompareFiles[localFile, localScratch];
    END;

  FancyTest: PROCEDURE [localFile: STRING] =
    BEGIN
    remoteName: STRING = [100];
    Store[localFile, remoteScratch1];
    Rename[remoteScratch1, remoteScratch2];
    Retrieve[localScratch, remoteScratch2];
    FTPNoteFilenameUsed[ftpuser,remoteName,NIL];
    WriteString["Remote name is: "];
    WriteLine[remoteName];
    FTPRenewConnection[ftpuser];
    ReOpen[];
    List[remoteScratches];
    ListViaTemp[remoteScratches];
    CompareFiles[localFile, localScratch];
    Transfer[currentServer,remoteScratch2,remoteScratch3];
    Retrieve[localScratch, remoteScratch3];
    List[remoteScratches];
    CompareFiles[localFile, localScratch];
    END;

  SimpleDumpTest: PROCEDURE [localFile: STRING] =
    BEGIN
    StartDumping[remoteScratch2];
      WriteString["  "];
    Store[localFile, remoteScratch1];
    StopDumping[];
    ListDump[remoteScratch2];
    Load[localScratch,remoteScratch2];
    CompareFiles[localFile, localScratch];
    END;

  FancyDumpTest: PROCEDURE =
    BEGIN
    StartDumping[remoteScratch2];
    Store["User.cm", "User.cm$"];
    Store["Com.cm", "Com.cm$"];
    Store["Binder.bcd", "Binder.bcd$"];
    Store["Rem.cm", "Rem.cm$"];
    Store["User.cm", "User.cm$$"];
    StopDumping[];
    ListDump[remoteScratch2];
    Load[NIL,remoteScratch2];
    CompareFiles["User.cm", "User.cm$"];
    CompareFiles["Com.cm", "Com.cm$"];
    CompareFiles["Binder.bcd", "Binder.bcd$"];
    CompareFiles["Rem.cm", "Rem.cm$"];
    CompareFiles["User.cm", "User.cm$$"];
    DeleteLocalFile["User.cm$"];
    DeleteLocalFile["Com.cm$"];
    DeleteLocalFile["Binder.bcd$"];
    DeleteLocalFile["Rem.cm$"];
    DeleteLocalFile["User.cm$$"];
    END;

  TimingTest: PROCEDURE [where: STRING, twice: BOOLEAN _ FALSE] =
    BEGIN
    localFile: STRING = "Compiler.image";
    IF isSapsford AND where # defaultServer THEN
      {WriteLine["... oops, Sapsford => no test"]; RETURN};
    Start[where];
    Store[localFile, remoteScratch1];
    Retrieve[localScratch, remoteScratch1];
    IF twice THEN Retrieve[localScratch, remoteScratch1];
    Delete[remoteScratch1];
    Stop[];
    CompareFiles[localFile, localScratch];
    DeleteLocalFile[localScratch];
    END;

  TimeTransfer: PROCEDURE [to: STRING] =
    BEGIN
    remoteFile: STRING = "<Mesa>Compiler.image";
    IF isSapsford AND to # defaultServer THEN
      {WriteLine["... oops, Sapsford => no test"]; RETURN};
    Start[to];
    Transfer[mesaServer, remoteFile,remoteScratch1];
    Retrieve[localScratch, remoteScratch1];
    Delete[remoteScratch1];
    Stop[];
    SingleRetrieve[mesaServer,localScratch2, remoteFile];
    CompareFiles[localScratch, localScratch2];
    DeleteLocalFile[localScratch];
    DeleteLocalFile[localScratch2];
    END;

AccessDeniedTester: PROCEDURE =
  BEGIN
  -- You have to create the files and turn off access to them by hand.
  IF isSapsford THEN
    {WriteLine["... oops, Sapsford => no test"]; RETURN};
  TestAccessDenied["Ivy","trash$", "YouCantSeeMe"];
  TestAccessDenied["Idun","trash$", "YouCantSeeMe"];
  TestAccessDeniedStar["Idun","trash$", "YouCantSeeMe"];
  TestAccessDeniedStar["Idun","trash$", "YouCantSee*"];
  END;

  TestAccessDenied: PROCEDURE [where, discard, remote: STRING] =
    BEGIN ENABLE FTPError =>
      BEGIN
      IF ftpError=requestedAccessDenied THEN
        BEGIN
        WriteChar[CR];
        WriteString["    Access denied: "];
        WriteLine[message];
        CONTINUE;
        END;
      END;
    SingleRetrieve[where,discard, remote];
    Runtime.CallDebugger["We didn't get Rejected."];
    END;

  TestAccessDeniedStar: PROCEDURE [where, discard, remote: STRING] =
    BEGIN
    Snarf: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN ENABLE FTPError =>
        BEGIN
        IF ftpError=requestedAccessDenied THEN
          BEGIN
          WriteChar[CR];
          WriteString["    Access denied: "];
          WriteLine[message];
          CONTINUE;
          END;
        END;
      Retrieve[discard,name];
      Runtime.CallDebugger["We didn't get Rejected."];
      END;
    Start[where,TRUE];
    WriteString["Multiple Retrieving "];
    WriteString[remote];
    WriteLine[" ..."];
    FTPEnumerateFiles[ftpuser, remote, retrieval, Snarf, NIL];
    Stop[TRUE];
    END;

NotFoundTester: PROCEDURE =
  BEGIN
  TestNotFound["ThisFileShouldntExist",enumeration];
  TestNotFound["ThisFileShouldntExist",retrieval];
  TestNotFound["ThisFileShouldntExist",deletion];
  TestNotFound["ThisFileShouldntExist",unspecified];
  TestNotFound["ThisFileShouldntExist*",enumeration];
  TestNotFound["ThisFileShouldntExist*",retrieval];
  TestNotFound["ThisFileShouldntExist*",deletion];
  TestNotFound["ThisFileShouldntExist*",unspecified];
  TestNotFoundStar["ThisFileShouldntExist",enumeration];
  TestNotFoundStar["ThisFileShouldntExist",retrieval];
  TestNotFoundStar["ThisFileShouldntExist",deletion];
  TestNotFoundStar["ThisFileShouldntExist",unspecified];
  TestNotFoundStar["ThisFileShouldntExist*",enumeration];
  TestNotFoundStar["ThisFileShouldntExist*",retrieval];
  TestNotFoundStar["ThisFileShouldntExist*",deletion];
  TestNotFoundStar["ThisFileShouldntExist*",unspecified];
  END;

  TestNotFound: PROCEDURE [remote: STRING, why: Intent] =
    BEGIN
    Snarf: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN
      Runtime.CallDebugger["We shoudn't find any files."];
      END;
    BEGIN ENABLE
      FTPError => IF ftpError=noSuchFile THEN { WriteLine[message]; CONTINUE; };
    SELECT why FROM
      enumeration => WriteString["List "];
      retrieval => WriteString["Retrieve "];
      deletion => WriteString["Delete "];
      unspecified => WriteString["Enumerate "];
      ENDCASE => ERROR;
    WriteString[remote];
    WriteString[" => "];
    SELECT why FROM
      retrieval => [] _ FTPRetrieveFile[ftpuser, "trash$", remote, unknown];
      deletion => FTPDeleteFile[ftpuser, remote];
      enumeration, unspecified => FTPEnumerateFiles[ftpuser, remote, why, Snarf, NIL];
      ENDCASE => ERROR;
    Runtime.CallDebugger["We shoudn't find any files."];
    END;
    END;

  TestNotFoundStar: PROCEDURE [remote: STRING, why: Intent] =
    BEGIN
    Snarf: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN
      Runtime.CallDebugger["We shoudn't find any files."];
      END;
    SELECT why FROM
      enumeration => WriteString["List* "];
      retrieval => WriteString["Retrieve* "];
      deletion => WriteString["Delete* "];
      unspecified => WriteString["Enumerate* "];
      ENDCASE => ERROR;
    WriteString[remote];
    WriteString[" => "];
    BEGIN ENABLE
      FTPError => IF ftpError=noSuchFile THEN
        BEGIN
        WriteLine[message];
        CONTINUE;
        END;
    FTPEnumerateFiles[ftpuser, remote, why, Snarf, NIL];
    Runtime.CallDebugger["We didn't get rejected."];
    END;
    END;

FunnyNameTester: PROCEDURE =
  BEGIN
  TestFunnyName["<ThisDirectoryDoesntExist>Foo",noSuchFile,enumeration];
  TestFunnyName["<ThisDirectoryDoesntExist>Foo",illegalFilename,retrieval];
  TestFunnyName["<ThisDirectoryDoesntExist>Foo",illegalFilename,deletion];
  TestFunnyName["<ThisDirectoryDoesntExist>Foo",noSuchFile,unspecified];
  TestFunnyNameStar["<ThisDirectoryDoesntExist>Foo",noSuchFile,enumeration];
  TestFunnyNameStar["<ThisDirectoryDoesntExist>Foo",illegalFilename,retrieval];
  TestFunnyNameStar["<ThisDirectoryDoesntExist>Foo",illegalFilename,deletion];
  TestFunnyNameStar["<ThisDirectoryDoesntExist>Foo",noSuchFile,unspecified];
  TestFunnyNameStar["<ThisDirectoryDoesntExist>Foo*",noSuchFile,enumeration];
  TestFunnyNameStar["<ThisDirectoryDoesntExist>Foo*",noSuchFile,retrieval];
  TestFunnyNameStar["<ThisDirectoryDoesntExist>Foo*",noSuchFile,deletion];
  TestFunnyNameStar["<ThisDirectoryDoesntExist>Foo*",noSuchFile,unspecified];
  TestFunnyName["Illegal character",illegalFilename,enumeration];
  TestFunnyName["Illegal character",illegalFilename,retrieval];
  TestFunnyName["Illegal character",illegalFilename,deletion];
  TestFunnyName["Illegal character",illegalFilename,unspecified];
  TestFunnyNameStar["Illegal character",illegalFilename,enumeration];
  TestFunnyNameStar["Illegal character",illegalFilename,retrieval];
  TestFunnyNameStar["Illegal character",illegalFilename,deletion];
  TestFunnyNameStar["Illegal character",illegalFilename,unspecified];
  END;

  TestFunnyName: PROCEDURE [remote: STRING, expected: FtpError, why: Intent] =
    BEGIN
    Snarf: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN
      Runtime.CallDebugger["We shoudn't find any files."];
      END;
    SELECT why FROM
      enumeration => WriteString["List "];
      retrieval => WriteString["Retrieve "];
      deletion => WriteString["Delete "];
      unspecified => WriteString["Enumerate "];
      ENDCASE => ERROR;
    WriteString[remote];
    WriteString[" => "];
    BEGIN ENABLE
      FTPError =>
        BEGIN
        WriteLine[message];
        IF ftpError=expected THEN CONTINUE;
        END;
    SELECT why FROM
      retrieval => [] _ FTPRetrieveFile[ftpuser, "trash$", remote, unknown];
      deletion => FTPDeleteFile[ftpuser, remote];
      enumeration, unspecified => FTPEnumerateFiles[ftpuser, remote, why, Snarf, NIL];
      ENDCASE => ERROR;
    Runtime.CallDebugger["We should have been rejected."];
    END;
    END;

  TestFunnyNameStar: PROCEDURE [remote: STRING, expected: FtpError, why: Intent] =
    BEGIN
    Snarf: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN
      Runtime.CallDebugger["We shoudn't find any files."];
      END;
    SELECT why FROM
      enumeration => WriteString["List* "];
      retrieval => WriteString["Retrieve* "];
      deletion => WriteString["Delete* "];
      unspecified => WriteString["Enumerate* "];
      ENDCASE => ERROR;
    WriteString[remote];
    WriteString[" => "];
    BEGIN ENABLE
      FTPError =>
        BEGIN
        WriteLine[message];
        IF ftpError=expected THEN CONTINUE;
        END;
    FTPEnumerateFiles[ftpuser, remote, why, Snarf, NIL];
    Runtime.CallDebugger["We should have been rejected."];
    END;
    END;

RejectTester: PROCEDURE =
  BEGIN
  FTPSetCredentials[ftpuser, primary, NIL, NIL];
  TestReject[credentialsMissing,"User name/pwd required"];
  FTPSetCredentials[ftpuser, primary, "Horse Shit", NIL];
  TestReject[noSuchPrimaryUser,"Invalid user name"];
  FTPSetCredentials[ftpuser, primary, user, "Horse Shit"];
  TestReject[incorrectPrimaryPassword,"Invalid user password"];
  FTPSetCredentials[ftpuser, primary, user, password];  -- put it back
  FTPSetCredentials[ftpuser, secondary, "Horse Shit", "Horse Shit"];
  TestReject[noSuchSecondaryUser,"Invalid connect name"];
  FTPSetCredentials[ftpuser, secondary, "Mesa", "Horse Shit"];
  TestReject[incorrectSecondaryPassword,"Invalid connect password"];
  END;

  TestReject: PROCEDURE [expected: FtpError, text: STRING] =
    BEGIN
    BEGIN ENABLE FTPError =>
      BEGIN
      IF ftpError=expected THEN
        BEGIN
        WriteString["    "];
        WriteString[text];
        WriteString[" (while listing) "];
        WriteLine[message];
        CONTINUE;
        END;
      END;
    List["Compiler.image"];
    Runtime.CallDebugger["We didn't get Rejected while listing."];
    END;
    BEGIN ENABLE FTPError =>
      BEGIN
      IF ftpError=expected THEN
        BEGIN
        WriteChar[CR];
        WriteString["    "];
        WriteString[text];
        WriteString[" (while reading) "];
        WriteLine[message];
        CONTINUE;
        END;
      END;
    Retrieve["Trash$", "Compiler.image"];
    Runtime.CallDebugger["We didn't get Rejected while retrieving."];
    END;
    BEGIN ENABLE FTPError =>
      BEGIN
      IF ftpError=expected THEN
        BEGIN
        WriteString["    "];
        WriteString[text];
        WriteString[" (while read*ing) "];
        WriteLine[message];
        CONTINUE;
        END;
      END;
    RetrieveStar["Trash$", "Compiler.image!*"];
    Runtime.CallDebugger["We didn't get Rejected while retrieving *."];
    END;
    BEGIN ENABLE FTPError =>
      BEGIN
      IF ftpError=expected THEN
        BEGIN
        WriteChar[CR];
        WriteString["    "];
        WriteString[text];
        WriteString[" (while storing) "];
        WriteLine[message];
        CONTINUE;
        END;
      END;
    Store["Compiler.image", "Please-Tell-HGM-About-This-$$$"];
    Runtime.CallDebugger["We didn't get Rejected while storing."];
    END;
    END;

UnwindTester: PROCEDURE =
  BEGIN
  Start[defaultServer];
  TestUnwind["*.mesa",enumeration];
  TestUnwind["*.mesa",retrieval];
  TestUnwind["*.mesa",deletion];
  TestUnwind["*.mesa",renaming];
  TestUnwind["*.mesa",unspecified];
  Stop[];
  END;

  TestUnwind: PROCEDURE [remote: STRING, why: Intent] =
    BEGIN
    GetOutOfHere: SIGNAL = CODE;
    Foo: PROCEDURE [x: UNSPECIFIED, name: STRING, y: VirtualFilename, info: FileInfo] =
      BEGIN
      SIGNAL GetOutOfHere;
      END;
    SELECT why FROM
      enumeration => WriteString["List "];
      retrieval => WriteString["Retrieve "];
      deletion => WriteString["Delete "];
      renaming => WriteString["Rename "];
      unspecified => WriteString["Enumerate "];
      ENDCASE => ERROR;
    WriteString[remote];
    WriteString[" => "];
    BEGIN ENABLE GetOutOfHere => { WriteLine[" UNWINDing..."]; CONTINUE; };
    FTPEnumerateFiles[ftpuser, remote, why, Foo, NIL];
    Runtime.CallDebugger["We didn't get UNWINDed."];
    END;
    END;

TestExtraRetrieve: PROCEDURE =
  BEGIN
    BEGIN ENABLE FTPError =>
      BEGIN
      IF ftpError=fileGroupDesignatorUnexpected THEN
        BEGIN
        WriteString["    Extra files on retrieve => "];
        WriteLine[message];
        CONTINUE;
        END;
      END;
    Retrieve[localScratch,remoteScratches];
    Runtime.CallDebugger["We didn't get Rejected while retrieving."];
    END;
  END;

TestExtraDelete: PROCEDURE =
  BEGIN
    BEGIN ENABLE FTPError =>
      BEGIN
      IF ftpError=fileGroupDesignatorUnexpected THEN
        BEGIN
        WriteString["    Extra files on delete => "];
        WriteLine[message];
        CONTINUE;
        END;
      END;
    Delete[remoteScratches];
    Runtime.CallDebugger["We didn't get Rejected while deleting."];
    END;
  END;

-- Local file system interactions

DeleteLocalFile: PROCEDURE [fileName: STRING] =
  BEGIN OPEN SegmentDefs;
  file: FileHandle _ NIL;
  file _ NewFile[fileName, Write, OldFileOnly ! FileNameError => CONTINUE];
  IF file#NIL THEN DestroyFile[file];
  END;

CompareFiles: PROCEDURE [one, two: STRING] =
  BEGIN
  pages: CARDINAL = 20;
  bufferSize: CARDINAL = pages*256;
  oneFile, twoFile: SegmentDefs.FileHandle;
  oneCreate, twoCreate: LONG CARDINAL;
  oneStream, twoStream: StreamDefs.StreamHandle;
  finger, length, words: LONG CARDINAL;
  oneBuffer: POINTER TO ARRAY [0..bufferSize) OF WORD;
  twoBuffer: POINTER TO ARRAY [0..bufferSize) OF WORD;
  n1, n2, tail: CARDINAL;
  StartTiming["Checking contents ..."];
  oneFile _ SegmentDefs.NewFile[one,SegmentDefs.Read, SegmentDefs.OldFileOnly];
  twoFile _ SegmentDefs.NewFile[two,SegmentDefs.Read];
  [read: , write: , create: oneCreate] _ SegmentDefs.GetFileTimes[oneFile];
  [read: , write: , create: twoCreate] _ SegmentDefs.GetFileTimes[twoFile];
  IF oneCreate#twoCreate THEN Runtime.CallDebugger["Create dates differ..."];
  IF SegmentDefs.GetEndOfFile[oneFile]#SegmentDefs.GetEndOfFile[twoFile] THEN
    Runtime.CallDebugger["File lengths differ."];
  oneStream _ StreamDefs.CreateByteStream[oneFile,SegmentDefs.Read];
  twoStream _ StreamDefs.CreateByteStream[twoFile,SegmentDefs.Read];
  IF StreamDefs.FileLength[oneStream]#StreamDefs.FileLength[twoStream] THEN
    Runtime.CallDebugger["engths differ."];
  length _ StreamDefs.GetPosition[oneStream];
  StreamDefs.SetPosition[oneStream,0];
  StreamDefs.SetPosition[twoStream,0];
  oneBuffer _ Storage.Pages[pages];
  twoBuffer _ Storage.Pages[pages];
  words _ length/2;
  FOR finger _ 0, finger+bufferSize WHILE words>finger+bufferSize DO
    n1 _ StreamDefs.ReadBlock[oneStream,oneBuffer,bufferSize];
    n2 _ StreamDefs.ReadBlock[twoStream,twoBuffer,bufferSize];
    IF n1#bufferSize OR n2#bufferSize THEN Runtime.CallDebugger["ReadBlock mixup."];
    FOR i: CARDINAL IN [0..bufferSize) DO
      IF oneBuffer[i]#twoBuffer[i] THEN Runtime.CallDebugger["Data words differ."];
      ENDLOOP;
    ENDLOOP;
  IF (tail _ Inline.LowHalf[words-finger])#0 THEN
    BEGIN
    n1 _ StreamDefs.ReadBlock[oneStream,oneBuffer,tail];
    n2 _ StreamDefs.ReadBlock[twoStream,twoBuffer,tail];
    IF n1#tail OR n2#tail THEN Runtime.CallDebugger["ReadBlock mixup."];
    FOR i: CARDINAL IN [0..tail) DO
      IF oneBuffer[i]#twoBuffer[i] THEN Runtime.CallDebugger["Data words differ."];
      ENDLOOP;
    END;
  IF words*2#length
  AND oneStream.get[oneStream]#twoStream.get[twoStream] THEN
    Runtime.CallDebugger["Data bytes differ."];
  oneStream.destroy[oneStream];
  twoStream.destroy[twoStream];
  Storage.FreePages[oneBuffer];
  Storage.FreePages[twoBuffer];
  StopTiming[" bytes",length];
  END;

-- Main line testing.......
  WriteLine["FTP Test kludge..."];
  WriteChar[CR];

  WriteLine["Basic tests ..."];
  Start[defaultServer];
  Stop[];
  Start[defaultServer];
  SimpleTest["User.cm"];  -- medium
  SimpleTest["Com.cm"];  -- small
  SimpleTest["Binder.bcd"];  -- reasonably large
  SimpleTest["Rem.cm"];  -- probably empty
  Stop[];
  WriteChar[CR];

  WriteLine["Use existing connection ..."];
  Start[defaultServer];
  Store["User.cm", remoteScratch1];
  Store["User.cm", remoteScratch1];
  Store["User.cm", remoteScratch1];
  Retrieve[localScratch, remoteScratch1];
  Retrieve[localScratch, remoteScratch1];
  Retrieve[localScratch, remoteScratch1];
  Stop[];
  WriteChar[CR];

  WriteLine["Make/break connection each time (pause between tries) ..."];
  Pause[10];
  SingleStore[defaultServer,"User.cm", remoteScratch1];
  Pause[10];
  SingleStore[defaultServer,"User.cm", remoteScratch1];
  Pause[10];
  SingleStore[defaultServer,"User.cm", remoteScratch1];
  Pause[10];
  SingleRetrieve[defaultServer,localScratch, remoteScratch1];
  Pause[10];
  SingleRetrieve[defaultServer,localScratch, remoteScratch1];
  Pause[10];
  SingleRetrieve[defaultServer,localScratch, remoteScratch1];
  Pause[10];
  WriteChar[CR];

  Start[defaultServer];
  FancyTest["User.cm"];  -- medium
  FancyTest["Com.cm"];  -- small
  FancyTest["Binder.bcd"];  -- reasonably large
  FancyTest["Rem.cm"];  -- probably empty

  SimpleDumpTest["User.cm"];  -- medium
  SimpleDumpTest["Com.cm"];  -- small
  SimpleDumpTest["Binder.bcd"];  -- reasonably large
  SimpleDumpTest["Rem.cm"];  -- probably empty
  FancyDumpTest[];

-- At this point, we have 8 versions of Scratch.2$, and 4 versions of Scratch.3$
  TestExtraRetrieve[];
  TestExtraDelete[];

  RetrieveStar[localScratch, remoteScratches];
  DeleteStar[remoteScratches];  -- Delete them all
  Stop[];
  WriteChar[CR];

-- Test hairy UNWIND cases
  WriteLine["Testing hairy UNWIND cases ..."];
  UnwindTester[];
  WriteChar[CR];

  WriteLine["Testing access denied ..."];
  AccessDeniedTester[];
  WriteChar[CR];

  WriteLine["Testing file not found (and UNWINDing) ..."];
  Start[defaultServer];
  NotFoundTester[];
  Stop[];
  WriteChar[CR];

  WriteLine["Testing funny file names ..."];
  Start[defaultServer];
  FunnyNameTester[];
  Stop[];
  WriteChar[CR];

  WriteLine["Testing credentials ..."];
  Start[mesaServer];
  RejectTester[];
  Stop[];
  WriteChar[CR];

  WriteLine["Testing other strange cases ..."];
  SingleStore[defaultServer,"TestFTP.bcd", remoteScratch1];  -- file is in use
  WriteChar[CR];

  WriteLine["Testing local disk full ..."];
  Start[mesaServer];
  BEGIN ENABLE FTPError =>
    BEGIN
    IF ftpError=noRoomForFile THEN
      BEGIN
      WriteChar[CR];
      WriteString["    Disk Full: "];
      WriteLine[message];
      CONTINUE;
      END;
    END;
  Retrieve["foo$0$", "<Mesa>Compiler.image"];
  Retrieve["foo$1$", "<Mesa>Compiler.image"];
  Retrieve["foo$2$", "<Mesa>Compiler.image"];
  Retrieve["foo$3$", "<Mesa>Compiler.image"];
  Retrieve["foo$4$", "<Mesa>Compiler.image"];
  Retrieve["foo$5$", "<Mesa>Compiler.image"];
  Retrieve["foo$6$", "<Mesa>Compiler.image"];
  Retrieve["foo$7$", "<Mesa>Compiler.image"];
  Retrieve["foo$8$", "<Mesa>Compiler.image"];
  Retrieve["foo$9$", "<Mesa>Compiler.image"];
  Runtime.CallDebugger["I give up, your disk is too big....."];
  END;
  Stop[];

  StartTiming["Deleting trashy files ..."];
  DeleteLocalFile["foo$0$"];
  DeleteLocalFile["foo$1$"];
  DeleteLocalFile["foo$2$"];
  DeleteLocalFile["foo$3$"];
  DeleteLocalFile["foo$4$"];
  DeleteLocalFile["foo$5$"];
  DeleteLocalFile["foo$6$"];
  DeleteLocalFile["foo$7$"];
  DeleteLocalFile["foo$8$"];
  DeleteLocalFile["foo$9$"];
  StopTiming[" done"];

  WriteLine["Testing remote disk full ..."];
  IF isSapsford THEN WriteLine["... oops, Sapsford => no test"]
  ELSE
    BEGIN
    Start["Iris"];  -- HGM is known to have a small allocation
    BEGIN ENABLE FTPError =>
      BEGIN
      IF ftpError=noRoomForFile THEN
        BEGIN
        WriteChar[CR];
        WriteString["    Disk Full: "];
        WriteLine[message];
        CONTINUE;
        END;
      END;
    THROUGH [0..6) DO Store["Compiler.image", "foo$0$"]; ENDLOOP;
    Runtime.CallDebugger["I give up, your allocation is too big....."];
    END;
    DeleteStar["foo$0$!*"];
    Stop[];
    END;

  WriteChar[CR];
  WriteChar[CR];
  WriteLine["Various timing tests ..."];
  WriteChar[CR];
  TimingTest["Idun"];
  WriteChar[CR];
  TimingTest["Ibis"];
  WriteChar[CR];
  TimingTest["Ivy"];
  WriteChar[CR];
  TimingTest["Isis"];
  WriteChar[CR];
  TimeTransfer[defaultServer];  -- Iris => Idun
  WriteChar[CR];
  TimeTransfer[mesaServer];  -- Iris => Iris


  WriteChar[CR];
  WriteChar[CR];
  WriteLine["Using Software checksums ..."];
  TimingTest[defaultServer,TRUE];
  WriteChar[CR];

  BEGIN
  config: SegmentDefs.MemoryConfig _ SegmentDefs.GetMemoryConfig[];
  IF config.AltoType=AltoIIXM
  AND (config.controlStore=RamandRom OR config.controlStore=Ram3k) THEN
    BEGIN
    WriteLine["Using Microcode checksums ..."];
    PupDefs.UseAltoChecksumMicrocode[];
    TimingTest[defaultServer,TRUE];
    WriteChar[CR];
    END;
  END;

  WriteLine["Using NULL checksums ..."];
  PupDefs.SetPupCheckit[FALSE];
  TimingTest[defaultServer,TRUE];
  WriteChar[CR];

  WriteChar[CR];
  ImageDefs.StopMesa[];

  END.
(635)