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