[Indigo]<Mesa>FTP>TestFTP.mesa!1

-- 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.