-- TestFTP.mesa
-- HGM,  October 18, 1980  1:21 PM  
-- 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,
    FTPSetBufferSize],
  PupDefs USING [
    UseAltoChecksumMicrocode, UseNullChecksumMicrocode,
    UsePrincOpsChecksumMicrocode, UseSoftwareChecksumMicrocode],
  Inline USING [LowHalf],
  ImageDefs USING [StopMesa],
  Put USING [CR, Char, Line, LongDecimal, Text],
  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 [BcplToMesaString, EquivalentStrings],
  Storage USING [Pages, FreePages],
  Window USING [Handle];

TestFTP: PROGRAM
  IMPORTS
    Inline, ImageDefs, Put, Runtime, SegmentDefs, StringDefs, StreamDefs, Storage,
    FTPDefs, PupDefs =
  BEGIN OPEN 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[];

  wh: Window.Handle = NIL;

  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;

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

  StartTiming: PROCEDURE [s: STRING] = BEGIN Put.Text[wh, s]; when _ clock^; END;

  StopTiming: PROCEDURE [s: STRING, bytes: LONG CARDINAL _ 0] =
    BEGIN
    ms: LONG CARDINAL _ LONG[clock^ - when]*msPerTick;
    IF bytes # 0 THEN Put.LongDecimal[wh, bytes];
    Put.Text[wh, s];
    Put.Text[wh, ", "];
    Put.LongDecimal[wh, ms];
    Put.Text[wh, " ms"];
    IF bytes # 0 THEN
      BEGIN
      Put.Text[wh, ", "];
      Put.LongDecimal[wh, 8*(bytes*1000/ms)];
      Put.Text[wh, " bits/sec"];
      END;
    Put.Line[wh, "."];
    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 "];
      Put.Text[wh, server];
      Put.Text[wh, " ..."];
      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"]; Put.Line[wh, 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
      Put.Text[wh, "  "];
      Put.Text[wh, name];
      IF info.creationDate # NIL THEN
	BEGIN
	THROUGH [name.length..25) DO Put.Char[wh, ' ]; ENDLOOP;
	Put.Text[wh, info.creationDate];
	END;
      Put.CR[wh];
      END;
    StartTiming["Listing "];
    Put.Text[wh, remote];
    Put.Line[wh, " ..."];
    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
      Put.Text[wh, "  "];
      Put.Text[wh, name];
      IF info.creationDate # NIL THEN
	BEGIN
	THROUGH [name.length..25) DO Put.Char[wh, ' ]; ENDLOOP;
	Put.Text[wh, info.creationDate];
	END;
      Put.CR[wh];
      END;
    StartTiming["Listing "];
    Put.Text[wh, remote];
    Put.Line[wh, " ..."];
    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 Put.Text[wh, "  "]; Put.Line[wh, name]; END;
    StartTiming["Listing contents of "];
    Put.Text[wh, remote];
    Put.Line[wh, " ..."];
    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 Put.Text[wh, "  "]; Retrieve[discard, name]; END;
    Put.Text[wh, "Multiple Retrieving "];
    Put.Text[wh, remote];
    Put.Line[wh, " ..."];
    FTPEnumerateFiles[ftpuser, remote, retrieval, Snarf, NIL];
    Put.Line[wh, "End of Multiple Retrieve."];
    END;

  Retrieve: PROCEDURE [local, remote: STRING] =
    BEGIN
    bc: LONG CARDINAL;
    StartTiming[local];
    Put.Text[wh, " <= ["];
    Put.Text[wh, currentServer];
    Put.Text[wh, "]"];
    Put.Text[wh, remote];
    Put.Text[wh, " ... "];
    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: "];
    Put.Text[wh, local];
    Put.Text[wh, " <= ["];
    Put.Text[wh, server];
    Put.Text[wh, "]"];
    Put.Text[wh, remote];
    Put.Text[wh, " ... "];
    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];
    Put.Text[wh, " => ["];
    Put.Text[wh, currentServer];
    Put.Text[wh, "]"];
    Put.Text[wh, remote];
    Put.Text[wh, " ... "];
    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];
    Put.Text[wh, " => ["];
    Put.Text[wh, server];
    Put.Text[wh, "]"];
    Put.Text[wh, remote];
    Put.Text[wh, " ... "];
    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 Put.Text[wh, "  "]; Delete[name]; END;
    Put.Text[wh, "Multiple Delete of "];
    Put.Text[wh, remote];
    Put.Line[wh, " ..."];
    FTPEnumerateFiles[ftpuser, remote, deletion, Kill, NIL];
    Put.Line[wh, "End of deleting."];
    END;

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

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

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

  StopDumping: PROCEDURE =
    BEGIN FTPEndDumpFile[ftpuser]; Put.Line[wh, "End of Dumping."]; END;

  Load: PROCEDURE [local, remote: STRING] =
    BEGIN
    Loader: PROCEDURE [x: UNSPECIFIED, name: STRING, y, z: UNSPECIFIED] =
      BEGIN
      Put.Text[wh, "  "];
      IF local # NIL THEN Retrieve[local, name] -- all into one

      ELSE Retrieve[name, name]; -- use name from dump file

      END;
    Put.Text[wh, "Loading "];
    Put.Text[wh, remote];
    Put.Line[wh, " ..."];
    FTPInventoryDumpFile[ftpuser, remote, retrieval, Loader, NIL];
    Put.Line[wh, "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];
    Put.Line[wh, serverText];
    StartTiming["Transfer: ["];
    Put.Text[wh, from];
    Put.Text[wh, "]"];
    Put.Text[wh, source];
    Put.Text[wh, " => ["];
    Put.Text[wh, currentServer];
    Put.Text[wh, "]"];
    Put.Text[wh, destination];
    Put.Text[wh, " ... "];
    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];
    Put.Text[wh, "Remote name is: "];
    Put.Line[wh, 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];
    Put.Text[wh, "  "];
    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 {
      Put.Line[wh, "... 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;

  BufferTest: PROCEDURE [pages: CARDINAL] =
    BEGIN
    localFile: STRING = "Compiler.image";
    FTPSetBufferSize[pages];
    Start[defaultServer];
    Store[localFile, remoteScratch1];
    Retrieve[localScratch, remoteScratch1];
    Retrieve[localScratch, remoteScratch1];
    Delete[remoteScratch1];
    CompareFiles[localFile, localScratch];
    DeleteLocalFile[localScratch];
    Stop[];
    END;

  TimeTransfer: PROCEDURE [to: STRING] =
    BEGIN
    remoteFile: STRING = "<Mesa>Compiler.image";
    IF isSapsford AND to # defaultServer THEN {
      Put.Line[wh, "... 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 {Put.Line[wh, "... 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
	  Put.CR[wh];
	  Put.Text[wh, "    Access denied: "];
	  Put.Line[wh, 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
	    Put.CR[wh];
	    Put.Text[wh, "    Access denied: "];
	    Put.Line[wh, message];
	    CONTINUE;
	    END;
	  END;
      Retrieve[discard, name];
      Runtime.CallDebugger["We didn't get Rejected."];
      END;
    Start[where, TRUE];
    Put.Text[wh, "Multiple Retrieving "];
    Put.Text[wh, remote];
    Put.Line[wh, " ..."];
    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 {Put.Line[wh, message]; CONTINUE; };
    SELECT why FROM
      enumeration => Put.Text[wh, "List "];
      retrieval => Put.Text[wh, "Retrieve "];
      deletion => Put.Text[wh, "Delete "];
      unspecified => Put.Text[wh, "Enumerate "];
      ENDCASE => ERROR;
    Put.Text[wh, remote];
    Put.Text[wh, " => "];
    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 => Put.Text[wh, "List* "];
      retrieval => Put.Text[wh, "Retrieve* "];
      deletion => Put.Text[wh, "Delete* "];
      unspecified => Put.Text[wh, "Enumerate* "];
      ENDCASE => ERROR;
    Put.Text[wh, remote];
    Put.Text[wh, " => "];
    BEGIN
    ENABLE
      FTPError =>
	IF ftpError = noSuchFile THEN BEGIN Put.Line[wh, 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 => Put.Text[wh, "List "];
      retrieval => Put.Text[wh, "Retrieve "];
      deletion => Put.Text[wh, "Delete "];
      unspecified => Put.Text[wh, "Enumerate "];
      ENDCASE => ERROR;
    Put.Text[wh, remote];
    Put.Text[wh, " => "];
    BEGIN
    ENABLE
      FTPError =>
	BEGIN Put.Line[wh, 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 => Put.Text[wh, "List* "];
      retrieval => Put.Text[wh, "Retrieve* "];
      deletion => Put.Text[wh, "Delete* "];
      unspecified => Put.Text[wh, "Enumerate* "];
      ENDCASE => ERROR;
    Put.Text[wh, remote];
    Put.Text[wh, " => "];
    BEGIN
    ENABLE
      FTPError =>
	BEGIN Put.Line[wh, 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
	  Put.Text[wh, "    "];
	  Put.Text[wh, text];
	  Put.Text[wh, " (while listing) "];
	  Put.Line[wh, 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
	  Put.CR[wh];
	  Put.Text[wh, "    "];
	  Put.Text[wh, text];
	  Put.Text[wh, " (while reading) "];
	  Put.Line[wh, 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
	  Put.Text[wh, "    "];
	  Put.Text[wh, text];
	  Put.Text[wh, " (while read*ing) "];
	  Put.Line[wh, 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
	  Put.CR[wh];
	  Put.Text[wh, "    "];
	  Put.Text[wh, text];
	  Put.Text[wh, " (while storing) "];
	  Put.Line[wh, message];
	  CONTINUE;
	  END;
	END;
    Store["Compiler.image", "Please-Tell-HGM-About-This-$$$"];
    Runtime.CallDebugger["We didn't get Rejected while storing."];
    END;
    END;

  VersionTester: PROCEDURE =
    BEGIN
    VersionTest["User.cm", "Version$!1"];
    Delete["Version$!1"];
    VersionTest["User.cm", "Version$!1"];
    VersionTest["Binder.bcd", "Version$!2"];
    VersionTest["Com.cm", "Version$!3"];
    VersionTest["User.cm", "Version$!4"];
    VersionTest["Com.cm", "Version$!1"];
    VersionTest["Com.cm", "Version$!4"];
    List["Version$"];
    Delete["Version$!1"];
    Delete["Version$!2"];
    Delete["Version$!3"];
    Delete["Version$!4"];
    END;

  VersionTest: PROCEDURE [localFile, remoteFile: STRING] =
    BEGIN
    Store[localFile, remoteFile];
    Retrieve[localScratch, remoteFile];
    List[remoteFile];
    CompareFiles[localFile, localScratch];
    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 => Put.Text[wh, "List "];
      retrieval => Put.Text[wh, "Retrieve "];
      deletion => Put.Text[wh, "Delete "];
      renaming => Put.Text[wh, "Rename "];
      unspecified => Put.Text[wh, "Enumerate "];
      ENDCASE => ERROR;
    Put.Text[wh, remote];
    Put.Text[wh, " => "];
    BEGIN
    ENABLE GetOutOfHere => {Put.Line[wh, " 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
	  Put.Text[wh, "    Extra files on retrieve => "];
	  Put.Line[wh, 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
	  Put.Text[wh, "    Extra files on delete => "];
	  Put.Line[wh, 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;

  TestSpeed: PROCEDURE =
    BEGIN
    Put.CR[wh];
    TimingTest["Idun"];
    Put.CR[wh];
    TimingTest["Ibis"];
    Put.CR[wh];
    TimingTest["Ivy"];
    Put.CR[wh];
    TimingTest["Isis"];
    Put.CR[wh];
    TimeTransfer[defaultServer]; -- Iris => Idun
    Put.CR[wh];
    TimeTransfer[mesaServer]; -- Iris => Iris

    END;

  TestChecksums: PROCEDURE =
    BEGIN
    config: SegmentDefs.MemoryConfig _ SegmentDefs.GetMemoryConfig[];
    Put.Line[wh, "Using NULL checksums ..."];
    PupDefs.UseNullChecksumMicrocode[];
    TimingTest[defaultServer, TRUE];
    Put.CR[wh];
    Put.Line[wh, "Using Software checksums ..."];
    PupDefs.UseSoftwareChecksumMicrocode[];
    TimingTest[defaultServer, TRUE];
    Put.CR[wh];
    IF config.AltoType = AltoIIXM AND
      (config.controlStore = RamandRom OR config.controlStore = Ram3k) THEN
      BEGIN
      Put.Line[wh, "Using (Alto) Microcode checksums ..."];
      PupDefs.UseAltoChecksumMicrocode[];
      TimingTest[defaultServer, TRUE];
      Put.CR[wh];
      END;
    IF config.AltoType = D0 OR config.AltoType = Dorado THEN
      BEGIN
      Put.Line[wh, "Using Microcode checksums ..."];
      PupDefs.UsePrincOpsChecksumMicrocode[];
      TimingTest[defaultServer, TRUE];
      Put.CR[wh];
      END;
    END;

  TestBufferSizes: PROCEDURE =
    BEGIN
    FTPInitialize[];
    Put.Line[wh, "Using 1 page buffers ..."];
    BufferTest[1];
    Put.CR[wh];
    Put.Line[wh, "Using default (4 page) buffers ..."];
    BufferTest[0];
    Put.CR[wh];
    Put.Line[wh, "Using 10 page buffers ..."];
    BufferTest[10];
    Put.CR[wh];
    Put.Line[wh, "Using 25 page buffers ..."];
    BufferTest[25];
    Put.CR[wh];
    FTPFinalize[];
    END;

  -- Main line testing.......

  Put.Line[wh, "FTP Test kludge..."];
  Put.CR[wh];

  Put.CR[wh];
  Put.Line[wh, "Testing checksum options ..."];
  TestChecksums[];

  Put.CR[wh];
  Put.Line[wh, "Testing buffer sizes ..."];
  TestBufferSizes[];

  Put.CR[wh];
  Put.CR[wh];
  Put.Line[wh, "Various timing tests ..."];
  TestSpeed[];
  Put.CR[wh];

  Put.Line[wh, "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[];
  Put.CR[wh];

  Put.Line[wh, "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[];
  Put.CR[wh];

  Put.Line[wh, "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];
  Put.CR[wh];

  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[];
  Put.CR[wh];

  -- Test hairy UNWIND cases
  Put.Line[wh, "Testing hairy UNWIND cases ..."];
  UnwindTester[];
  Put.CR[wh];

  Put.Line[wh, "Testing access denied ..."];
  AccessDeniedTester[];
  Put.CR[wh];

  Put.Line[wh, "Testing file not found (and UNWINDing) ..."];
  Start[defaultServer];
  NotFoundTester[];
  Stop[];
  Put.CR[wh];

  Put.Line[wh, "Testing funny file names ..."];
  Start[defaultServer];
  FunnyNameTester[];
  Stop[];
  Put.CR[wh];

  Put.Line[wh, "Testing credentials ..."];
  Start[mesaServer];
  RejectTester[];
  Stop[];
  Put.CR[wh];

  Put.Line[wh, "Testing version overwriting ..."];
  Start[defaultServer];
  VersionTester[];
  Stop[];
  Put.CR[wh];

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

  Put.Line[wh, "Testing local disk full ..."];
  Start[mesaServer];
  BEGIN
  ENABLE
    FTPError =>
      BEGIN
      IF ftpError = noRoomForFile THEN
	BEGIN
	Put.CR[wh];
	Put.Text[wh, "    Disk Full: "];
	Put.Line[wh, 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"];

  Put.Line[wh, "Testing remote disk full ..."];
  IF isSapsford THEN Put.Line[wh, "... 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
	  Put.CR[wh];
	  Put.Text[wh, "    Disk Full: "];
	  Put.Line[wh, 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;

  Put.CR[wh];
  ImageDefs.StopMesa[];

  END.