-- file: OthelloFTP.mesa last modified 19-Jun-82 13:52:10 by Taft
-- Edited by
-- Johnsson, October 2, 1979 9:50 PM
-- Sandman, October 11, 1979 8:33 AM
-- Gobbel, February 14, 1980 7:30 PM
-- Forrest, July 26, 1980 7:10 PM
-- Bruce, April 14, 1981 3:07 PM
DIRECTORY
Environment USING [bytesPerPage],
File USING [Capability, SetSize],
FTPDefs USING [
CredentialError, FileHandle, FileInfo, FilePrimitivesObject, FileSystem,
FileType, FTPCloseConnection, FTPCreateUser, FTPDestroyUser,
FTPEnumerateFiles, FTPError, FtpError, FTPFinalize, FTPInitialize,
FTPOpenConnection, FTPRetrieveFile, FTPSetCredentials,
FTPSetFilenameDefaults, FTPUser, Mode, PupCommunicationPrimitives,
VirtualFilename, VirtualFilenameObject],
FTPPrivateDefs,
Inline USING [BITNOT, LongCOPY],
OthelloDefs,
Space USING [
Create, defaultWindow, Handle, Kill, Map, mds, Pointer, Unmap],
String USING [AppendChar],
UserTerminal USING [CursorArray, GetCursorPattern, SetCursorPattern],
Volume USING [InsufficientSpace];
OthelloFTP: PROGRAM
IMPORTS File, FTPDefs, Inline, Space, String, UserTerminal, Volume
EXPORTS FTPPrivateDefs, OthelloDefs =
BEGIN OPEN FTPDefs;
-- global data
ftpuser: FTPUser ← NIL;
filePrimitives: FilePrimitivesObject ←
[CreateFileSystem: MyCreate, DestroyFileSystem: MyDestroy,
DecomposeFilename:, ComposeFilename:, InspectCredentials:,
EnumerateFiles:, OpenFile: MyOpen, ReadFile: MyRead,
WriteFile: MyWrite, CloseFile: MyClose, DeleteFile:, RenameFile:];
userName: PUBLIC STRING ← [40];
userPassword: PUBLIC STRING ← [20];
connectName: PUBLIC STRING ← [40];
connectPassword: PUBLIC STRING ← [20];
directory: PUBLIC STRING ← [60];
GiveMeFileInfo: SIGNAL RETURNS
[OthelloDefs.FTPDestination, LONG CARDINAL] = CODE;
GiveUp: ERROR [why: STRING] = CODE;
CredentialError: PUBLIC SIGNAL [ftpError: FTPDefs.FtpError, message: STRING] = CODE;
AppendMsg: PROC [s, msg: STRING] =
BEGIN
IF s = NIL THEN RETURN;
FOR i: CARDINAL IN [0..MIN[msg.length, s.maxlength - s.length]) DO
String.AppendChar[s, msg[i]]; ENDLOOP;
END;
Close: PUBLIC PROC [msg: STRING] RETURNS [BOOLEAN] =
BEGIN
ok: BOOLEAN ← TRUE;
FTPCloseConnection[ftpuser !
FTPError => { AppendMsg[msg, message]; ok ← FALSE; CONTINUE}];
FTPDestroyUser[ftpuser !
FTPError => { AppendMsg[msg, message]; ok ← FALSE; CONTINUE}];
FTPFinalize[];
ftpuser ← NIL;
RETURN[ok]
END;
FlipCursor: PROC =
BEGIN
c: UserTerminal.CursorArray;
i: CARDINAL;
c ← UserTerminal.GetCursorPattern[];
FOR i IN [0..LENGTH[c]) DO c[i] ← Inline.BITNOT[c[i]]; ENDLOOP;
UserTerminal.SetCursorPattern[c];
END;
Open: PUBLIC PROC
[server, remoteMsg: STRING] RETURNS [okay: BOOLEAN] =
BEGIN
okay ← TRUE;
IF ftpuser = NIL THEN
BEGIN
FTPInitialize[];
ftpuser ← FTPCreateUser[
@filePrimitives, PupCommunicationPrimitives[]];
END;
FTPOpenConnection[
ftpuser: ftpuser, host: server, purpose: files,
remoteInsignia: remoteMsg !
FTPError =>
{AppendMsg[remoteMsg, message]; okay ← FALSE; CONTINUE}];
IF ~okay THEN
{FTPDestroyUser[ftpuser]; FTPFinalize[]; ftpuser ← NIL};
RETURN[okay];
END;
PagesForBytes: PROC [bytes: LONG CARDINAL] RETURNS [LONG CARDINAL] =
BEGIN OPEN Environment;
RETURN[(bytes + bytesPerPage - 1)/bytesPerPage]
END;
Retrieve: PUBLIC PROC [
remoteFile, msg: STRING, destination: OthelloDefs.FTPDestination]
RETURNS [BOOLEAN] =
BEGIN
gotOne: BOOLEAN ← FALSE;
vName: VirtualFilenameObject ← [NIL, NIL, NIL, NIL];
GetOne: PROC [
UNSPECIFIED, aName: STRING, vName: VirtualFilename, info: FileInfo] =
BEGIN
[] ← FTPRetrieveFile[ftpuser, NIL, aName, unknown !
GiveMeFileInfo => RESUME [
destination, PagesForBytes[info.byteCount]]];
gotOne ← TRUE;
END;
BEGIN ENABLE FTPError => {
IF ftpError IN FTPDefs.CredentialError THEN
{ SIGNAL CredentialError[ftpError, message]; RETRY };
AppendMsg[msg, message]; GOTO notOK };
FTPSetCredentials[ftpuser, primary, userName, userPassword];
FTPSetCredentials[
ftpuser, secondary, connectName, connectPassword];
vName.directory ← directory;
FTPSetFilenameDefaults[ftpuser, primary, @vName];
FTPEnumerateFiles[
ftpuser, remoteFile, retrieval, GetOne, NIL !
GiveUp => {AppendMsg[msg, why]; GOTO notOK};
Volume.InsufficientSpace =>
{ AppendMsg[msg, "volume full"L]; GOTO notOK }];
END;
IF ~gotOne THEN AppendMsg[
msg, "can't get file- do you have access privileges for that file?"L];
RETURN[gotOne];
EXITS notOK => RETURN[FALSE];
END;
Enumerate: PUBLIC PROC [
remoteFile, msg: STRING,
proc: PROCEDURE [filename, creationDate, author: STRING]]
RETURNS [BOOLEAN] =
BEGIN
gotOne: BOOLEAN ← FALSE;
vName: VirtualFilenameObject ← [NIL, NIL, NIL, NIL];
EnumerateOne: PROC [
UNSPECIFIED, aName: STRING, vName: VirtualFilename, info: FileInfo] =
{ proc[filename: aName, creationDate: info.creationDate, author: info.author] };
BEGIN ENABLE FTPError => {
IF ftpError IN FTPDefs.CredentialError THEN
{ SIGNAL CredentialError[ftpError, message]; RETRY };
AppendMsg[msg, message]; GOTO notOK };
FTPSetCredentials[ftpuser, primary, userName, userPassword];
FTPSetCredentials[
ftpuser, secondary, connectName, connectPassword];
vName.directory ← directory;
FTPSetFilenameDefaults[ftpuser, primary, @vName];
FTPEnumerateFiles[
ftpuser, remoteFile, enumeration, EnumerateOne, NIL !
GiveUp => {AppendMsg[msg, why]; GOTO notOK}];
RETURN [TRUE];
END;
EXITS notOK => RETURN [FALSE];
END;
-- my File System
MyClose: PROC [FileSystem, FileHandle, BOOLEAN] = {};
MyCreate: PROC [CARDINAL] RETURNS [FileSystem] = {RETURN[NIL]};
MyDestroy: PROC [FileSystem] = {};
MyOpen: PROC [FileSystem, STRING, Mode, BOOLEAN, FileInfo]
RETURNS [FileHandle, FileType] = {RETURN[NIL, binary]};
MyRead: PROC [
FileSystem, FileHandle, PROC [UNSPECIFIED, POINTER, CARDINAL],
UNSPECIFIED] = {};
BufPages: CARDINAL = 8;
BufSize: CARDINAL = BufPages*Environment.bytesPerPage;
space: Space.Handle =
Space.Create[parent: Space.mds, size: BufPages];
MyWrite: PROC [
fileSystem: FileSystem, fileHandle: FileHandle,
receiveBlock: PROC
[UNSPECIFIED, POINTER, CARDINAL] RETURNS [CARDINAL],
receiveBlockData: UNSPECIFIED] =
BEGIN
buffer: POINTER = Space.Pointer[space];
destination: OthelloDefs.FTPDestination;
fileSize: LONG CARDINAL;
UserTerminal.SetCursorPattern[
-- cursor stolen from tools
[177B, 76077B, 40037B, 40017B, 70007B, 43703B, 40401B,
40400B, 400B, 100436B, 140421B, 160421B, 170036B,
174020B, 176020B, 177020B]];
[destination, fileSize] ← SIGNAL GiveMeFileInfo;
WITH destination SELECT FROM
pilotFileSystemWrite =>
BEGIN
left, rcount, count: CARDINAL; -- byte indices.
base: LONG CARDINAL ← 0;
File.SetSize[localFile, fileSize];
DO
Space.Map[space, [localFile, base]];
Space.Kill[space];
left ← BufSize;
count ← 0;
DO
rcount ← receiveBlock[
receiveBlockData, buffer + count/2, left/2];
count ← count + rcount;
left ← left - rcount;
IF left = 0 OR rcount = 0 THEN EXIT;
ENDLOOP;
base ← base + PagesForBytes[count];
IF rcount=0 THEN
-- Unused tail of last page must be zeroed, to simplify checksum checking
-- in microcode loader. Also, delete any unused pages, in case the
-- length hint was wrong.
BEGIN
Zero[buffer + count/2, (left MOD Environment.bytesPerPage)/2];
Space.Unmap[space];
IF fileSize#base THEN File.SetSize[localFile, base];
EXIT;
END;
Space.Unmap[space];
FlipCursor[];
ENDLOOP;
END;
string => {
ok: BOOLEAN ← TRUE;
Space.Map[space, Space.defaultWindow];
DO ENABLE UNWIND => Space.Unmap[space];
IF GetBuffer[buffer, receiveBlock, receiveBlockData] THEN EXIT;
ok ← FALSE;
ENDLOOP;
IF ok THEN {stringProc[buffer]; Space.Unmap[space]}
ELSE {Space.Unmap[space]; ERROR GiveUp["Command file too long!"L]}};
rawWrite =>
BEGIN
ENABLE UNWIND => Space.Unmap[space];
done: BOOLEAN ← FALSE;
GetPage: PROC RETURNS [LONG POINTER] =
BEGIN
rcount: CARDINAL; -- byte index.
count: CARDINAL ← 0; -- byte index.
WHILE ~done DO
rcount ← receiveBlock[
receiveBlockData, buffer + count/2,
(Environment.bytesPerPage - count)/2];
count ← count + rcount;
done ← rcount = 0;
-- Unused tail of last page must be zeroed, to simplify checksum checking
-- in microcode loader.
IF done THEN Zero[buffer + count/2, (Environment.bytesPerPage - count)/2];
IF count = Environment.bytesPerPage THEN {FlipCursor[]; EXIT}
ENDLOOP;
RETURN[IF done AND count = 0 THEN NIL ELSE buffer];
END;
Space.Map[space, Space.defaultWindow];
linkProc[GetPage];
WHILE ~done DO [] ← GetPage[]; ENDLOOP;
Space.Unmap[space];
END;
ENDCASE => ERROR;
END;
Zero: PRIVATE PROC [p: LONG POINTER, count: CARDINAL] =
{IF count#0 THEN {p↑ ← 0; Inline.LongCOPY[from: p, to: p+1, nwords: count-1]}};
GetBuffer: PROC [
buffer: POINTER,
receiveBlock: PROC [UNSPECIFIED, POINTER, CARDINAL] RETURNS [CARDINAL],
data: UNSPECIFIED]
RETURNS [done: BOOLEAN] =
BEGIN
stringOverhead: CARDINAL = SIZE[StringBody]*2;
stringSize: CARDINAL = BufSize-stringOverhead;
count, pages: CARDINAL ← 0; -- byte index.
next: CARDINAL ← Environment.bytesPerPage/2;
done ← FALSE;
WHILE ~done DO
rcount: CARDINAL ← receiveBlock[data, buffer+(count+stringOverhead)/2, next];
count ← count + rcount;
done ← rcount = 0;
IF count/Environment.bytesPerPage > pages THEN {
pages ← pages + 1; FlipCursor[]};
next ← MIN[next, (stringSize-count+1)/2];
IF done OR count = stringSize THEN EXIT;
ENDLOOP;
LOOPHOLE[buffer, STRING]↑ ← [maxlength: stringSize, length: count, text:];
END;
-- Dummys to keep FTP Happy
ServerFilesLoaded, ServerMailLoaded, UserMailLoaded: PUBLIC PROC =
{};
END.
-- November 13, 1979 10:16 AM By Forrest Changed to InitializeFTP once (and never Finalize), to use a bigger chunk in transfering (should use two buffers); increased size of directory string to 60 from 50; Add twiddle cursor hack since people were worried about ftp dying; export Server*loaded and UserMailLoaded to eliminate 3 modules from FTP
-- January 12, 1980 4:46 PM By Forrest Changed to used new Othello FTP and support calls to writing Raw Data
-- February 14, 1980 7:30 PM By Gobbel Notice if we didn't really retrieve any files
-- July 26, 1980 7:04 PM By Forrest Change name to OthelloFTP, export OthelloDefs
-- April 14, 1981 1:53 PM By Bruce Added string variant to dest; fixed AR4051
-- 24-Jan-82 15:55:14 Taft Retrieve raises resumable signal for credential errors
-- 4-Jun-82 17:36:46 Taft Add Enumerate
-- 17-Jun-82 16:56:30 Taft MyWrite zeroes unused tail of last page of file -- for benefit of microcode installation.
-- 18-Jun-82 8:36:54 Taft MyWrite pilotFileSystemWrite truncates unused pages from file.