-- FTPServerFiles.mesa  
--  HGM March 2, 1981  6:13 PM, NIL trap problems
--  HGM July 31, 1980  5:27 PM  

-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  FTPDefs,
  FTPPrivateDefs;

FTPServerFiles: PROGRAM
  IMPORTS FTPDefs, FTPPrivateDefs
  EXPORTS FTPPrivateDefs
  SHARES FTPDefs, FTPPrivateDefs =
  BEGIN OPEN FTPDefs, FTPPrivateDefs;

  -- **********************!  Constants  !***********************

  ftpsystem: POINTER TO FTPSystem = LocateFtpSystemObject[];

  -- **********************!  Module Presence Test Procedure  !***********************

  ServerFilesLoaded: PUBLIC PROCEDURE =
    BEGIN
    -- report in
    ftpsystem.serverFilesLoaded ← TRUE;
    END;

  -- **********************!  File Commands  !***********************

  PTFDirectory: PUBLIC PROCEDURE [ftpserver: FTPServer] =
    BEGIN OPEN ftpserver, ftpserver.ftplistener;
    -- EnumerateFiles appendage
    PutFilename: PROCEDURE [
      unused: UNSPECIFIED, file: STRING, fileInfo: FileInfo] =
      BEGIN
      -- record at least one file
      atLeastOneFile ← TRUE;
      -- send notice of coming property list
      PutCommand[ftper, markHereIsPropertyList, 0];
      -- construct property list containing absolute and virtual filenames and file information
      ResetPropertyList[propertyList];
      WriteFilename[
	file, propertyList, filePrimitives, ftpserver.fileSystem, DESCRIPTOR[NIL,0]];
      WriteFileInfo[propertyList, fileInfo];
      -- send property list
      PutPropertyList[ftper, propertyList];
      END;
    -- local constants
    files: STRING = [maxStringLength];
    -- local variables
    atLeastOneFile: BOOLEAN ← FALSE;
    -- receive property list and EOC
    GetPropertyList[ftper, propertyList];
    GetEOC[ftper];
    -- extract filename from property list
    ReadFilename[files, propertyList, filePrimitives, ftpserver.fileSystem];
    -- enumerate files
    filePrimitives.EnumerateFiles[
      ftpserver.fileSystem, files, enumeration, PutFilename, NIL];
    IF ~atLeastOneFile THEN Abort[noSuchFile];
    -- send EOC
    PutEOC[ftper];
    END;

  PTFStore: PUBLIC PROCEDURE [ftpserver: FTPServer, mark: Byte] =
    BEGIN OPEN ftpserver, ftpserver.ftplistener;
    -- Note:  Implements both Store and NewStore.
    -- local constants
    file: STRING = [maxStringLength];
    -- local variables
    fileHandle: FileHandle;
    successful: BOOLEAN;
    closing: BOOLEAN ← FALSE;
    fileInfoObject: FileInfoObject ← [binary, 8, 0, NIL, NIL, NIL, NIL];
    -- receive property list and EOC
    GetPropertyList[ftper, propertyList];
    GetEOC[ftper];
    -- extract filename from property list
    ReadFilename[file, propertyList, filePrimitives, ftpserver.fileSystem];
    -- setup info for OpenFile
    ReadFileInfo[propertyList, @fileInfoObject];
    -- open file for write
    [fileHandle, ] ← filePrimitives.OpenFile[
      ftpserver.fileSystem, file, write, FALSE, @fileInfoObject];
    BEGIN
    ENABLE
      UNWIND =>
	IF ~closing THEN
	  filePrimitives.CloseFile[ftpserver.fileSystem, fileHandle, TRUE];
    -- send Yes or property list and EOC
    IF mark = markStore THEN PutCommandAndEOC[ftper, markYes, 0]
    ELSE
      BEGIN
      -- send notice of coming property list
      PutCommand[ftper, markHereIsPropertyList, 0];
      -- construct property list containing absolute and virtual filenames
      ResetPropertyList[propertyList];
      WriteFilename[
	file, propertyList, filePrimitives, ftpserver.fileSystem, DESCRIPTOR[NIL,0]];
      -- send property list and EOC
      PutPropertyList[ftper, propertyList];
      PutEOC[ftper];
      END;
    -- receive file
    GetSpecificCommand[ftper, markHereIsFile];
    filePrimitives.WriteFile[
      ftpserver.fileSystem, fileHandle, ReceiveBlock, ftper !
      FTPError =>
	-- Skip over rest of file if disk full or such
	IF ftpError ~IN CommunicationError THEN [] ← GetAnswerAndEOC[ftper]];
    -- receive end-of-file indicator
    successful ← GetAnswerAndEOC[ftper];
    -- close the file
    closing ← TRUE;
    filePrimitives.CloseFile[ftpserver.fileSystem, fileHandle, ~successful];
    -- acknowledge [un]successful transmission with Yes/No and EOC
    IF successful THEN PutCommandAndEOC[ftper, markYes, 0]
    ELSE PutCommandAndEOC[ftper, markNo, codeStoreNotCompleted];
    END; -- enable
    END;

  PTFRetrieve: PUBLIC PROCEDURE [ftpserver: FTPServer] =
    BEGIN OPEN ftpserver, ftpserver.ftplistener;
    -- EnumerateFiles appendage
    RetrieveSingleFile: PROCEDURE [
      unused: UNSPECIFIED, file: STRING, fileInfo: FileInfo] =
      BEGIN
      -- local variables
      fileHandle: FileHandle;
      accepted: BOOLEAN;
      -- record at least one file
      atLeastOneFile ← TRUE;
      -- open file for read
      [fileHandle, fileInfo.fileType] ← filePrimitives.OpenFile[
	ftpserver.fileSystem, file, read, TRUE, fileInfo];
      BEGIN
      ENABLE
	UNWIND =>
	  filePrimitives.CloseFile[ftpserver.fileSystem, fileHandle, TRUE];
      -- send notice of coming property list
      PutCommand[ftper, markHereIsPropertyList, 0];
      -- construct property list containing absolute and virtual filenames and file information
      ResetPropertyList[propertyList];
      WriteFilename[
	file, propertyList, filePrimitives, ftpserver.fileSystem, DESCRIPTOR[NIL,0]];
      WriteFileInfo[propertyList, fileInfo];
      -- send property list and EOC
      PutPropertyList[ftper, propertyList];
      PutEOC[ftper];
      -- send file if accepted by remote user process
      IF accepted ← GetAnswerAndEOC[ftper] THEN
	BEGIN
	PutCommand[ftper, markHereIsFile, 0];
	filePrimitives.ReadFile[
	  ftpserver.fileSystem, fileHandle, SendBlock, ftper];
	PutCommand[ftper, markYes, 0];
	END;
      END; -- enable
      -- close the file
      filePrimitives.CloseFile[ftpserver.fileSystem, fileHandle, ~accepted];
      END;
    -- local variables
    atLeastOneFile: BOOLEAN ← FALSE;
    files: STRING = [maxStringLength];
    -- receive property list and EOC
    GetPropertyList[ftper, propertyList];
    GetEOC[ftper];
    -- extract filename from property list
    ReadFilename[files, propertyList, filePrimitives, ftpserver.fileSystem];
    -- retrieve files
    filePrimitives.EnumerateFiles[
      ftpserver.fileSystem, files, retrieval, RetrieveSingleFile, NIL];
    IF ~atLeastOneFile THEN Abort[noSuchFile];
    -- send EOC
    PutEOC[ftper];
    END;

  PTFDelete: PUBLIC PROCEDURE [ftpserver: FTPServer] =
    BEGIN OPEN ftpserver, ftpserver.ftplistener;
    -- EnumerateFiles appendage
    DeleteSingleFile: PROCEDURE [
      unused: UNSPECIFIED, file: STRING, fileInfo: FileInfo] =
      BEGIN
      -- local variables
      -- record at least one file
      atLeastOneFile ← TRUE;
      -- send notice of coming property list
      PutCommand[ftper, markHereIsPropertyList, 0];
      -- construct property list containing absolute and virtual filenames and file information
      ResetPropertyList[propertyList];
      WriteFilename[
	file, propertyList, filePrimitives, ftpserver.fileSystem, DESCRIPTOR[NIL,0]];
      WriteFileInfo[propertyList, fileInfo];
      -- send property list and EOC
      PutPropertyList[ftper, propertyList];
      PutEOC[ftper];
      -- delete file if accepted by remote user process
      IF GetAnswerAndEOC[ftper] THEN
	BEGIN
	filePrimitives.DeleteFile[ftpserver.fileSystem, file];
	PutCommand[ftper, markYes, 0];
	END;
      END;
    -- local constants
    files: STRING = [maxStringLength];
    -- local variables
    atLeastOneFile: BOOLEAN ← FALSE;
    -- receive property list and EOC
    GetPropertyList[ftper, propertyList];
    GetEOC[ftper];
    -- extract filename from property list
    ReadFilename[files, propertyList, filePrimitives, ftpserver.fileSystem];
    -- delete files
    filePrimitives.EnumerateFiles[
      ftpserver.fileSystem, files, deletion, DeleteSingleFile, NIL];
    IF ~atLeastOneFile THEN Abort[noSuchFile];
    -- send EOC
    PutEOC[ftper];
    END;

  PTFRename: PUBLIC PROCEDURE [ftpserver: FTPServer] =
    BEGIN OPEN ftpserver, ftpserver.ftplistener;
    -- local constants
    currentFile: STRING = [maxStringLength];
    newFile: STRING = [maxStringLength];
    -- receive property list and extract file's current name
    GetPropertyList[ftper, propertyList];
    ReadFilename[currentFile, propertyList, filePrimitives, ftpserver.fileSystem];
    -- receive property list and extract file's new name
    GetPropertyList[ftper, propertyList];
    ReadFilename[newFile, propertyList, filePrimitives, ftpserver.fileSystem];
    -- receive EOC
    GetEOC[ftper];
    -- rename file
    filePrimitives.RenameFile[ftpserver.fileSystem, currentFile, newFile];
    -- send Yes and EOC
    PutCommandAndEOC[ftper, markYes, 0];
    END;

  -- **********************!  Main Program  !***********************

  -- no operation

  END. -- of FTPServerFiles