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