-- Grapevine:  FTP server using VMDefs --

-- [Indigo]<Grapevine>MS>FTPServer.mesa

-- Randy Gobbel		22-May-81 13:50:58 --
-- Andrew Birrell	 5-Mar-82  8:54:25 --
-- Mark Johnson		May 28, 1981  2:09 PM --

DIRECTORY
AltoFile	USING[ CloseDirectory, DEfile, DirHandle, DVPtr, Enumerate,
		       OpenDirectory, sysDirFP ],
BodyDefs	USING[ maxRNameLength, RName ],
FTPDefs,
LogDefs		USING[ WriteLogEntry ],
NameInfoDefs	USING[ Authenticate, AuthenticateInfo, IsMemberClosure,
		       Membership ],
PolicyDefs	USING [CheckOperation, EndOperation],
PupDefs		USING[ AppendMyName, ParsePupAddressConstant, PupAddress ],
Storage		USING[ Free, String ],
String		USING[ AppendChar, AppendNumber,
		       AppendString, EquivalentStrings ],
Time		USING[ Append, Packed, Unpack ],
TimeExtraDefs	USING[ PackedTimeFromString ],
VMDefs		USING[ AbandonFile, CantOpen, CantReadBackingStore,
		       CantWriteBackingStore, CloseFile, DestroyFile,
		       Error, FileHandle, FileTime, GetFileLength, GetFileTimes,
		       MarkStart, OpenFile, Page, pageSize, Position,
		       ReadPage, Release, SetCreationTime, SetFileLength,
		       UsePage, WaitFile ],
VMSpecial	USING[ OpenAltoFileFromFP, QuickAndDirtyAltoRename ];

FTPServer: PROGRAM
   IMPORTS AltoFile, FTPDefs, LogDefs, NameInfoDefs, PolicyDefs, PupDefs,
           Storage, String, Time, TimeExtraDefs, VMDefs, VMSpecial =

BEGIN

WhoIsHe: SIGNAL RETURNS[ net, host: [0..256) ] = CODE;
--communication between LogAction and Backstop --

LogAction: PROC[user: BodyDefs.RName, file: STRING,
                action: { read, write, rename, delete }] =
   BEGIN
   log: STRING = [128];
   String.AppendString[log, "FTP server: "L];
   BEGIN
      net, host: [0..256);
      [net, host] _ SIGNAL WhoIsHe;
      String.AppendNumber[log, net, 8];
      String.AppendChar[log, '#];
      String.AppendNumber[log, host, 8];
   END;
   String.AppendChar[log, ' ];
   String.AppendString[log, user];
   String.AppendString[log, SELECT action FROM
                              read =>   " reading "L,
                              write =>  " writing "L,
                              rename => " renaming "L,
                              delete => " deleting "L
                            ENDCASE => ERROR];
   String.AppendString[log, file];
   LogDefs.WriteLogEntry[log];
   END;

MyCreate: PROC[bufferSize: CARDINAL]
          RETURNS[fileSystem: FTPDefs.FileSystem] =
   BEGIN
   real: BodyDefs.RName = Storage.String[BodyDefs.maxRNameLength];
   RETURN[LOOPHOLE[real]];
   END;

MyDestroy: PROC[ fileSystem: FTPDefs.FileSystem ] =
   { Storage.Free[fileSystem] };

MyDecompose: PROC[ fileSystem: FTPDefs.FileSystem,
                   absoluteFilename: STRING,
                   virtualFilename: FTPDefs.VirtualFilename ] =
   BEGIN
   virtualFilename.device.length _ 0;
   virtualFilename.directory.length _ 0;
   virtualFilename.name.length _ 0;
   String.AppendString[virtualFilename.name, absoluteFilename];
   virtualFilename.version.length _ 0;
   END;

MyCompose: PROC[ fileSystem: FTPDefs.FileSystem,
                 absoluteFilename: STRING,
                 virtualFilename: FTPDefs.VirtualFilename ] =
   BEGIN
   IF virtualFilename.device.length = 0
   AND virtualFilename.directory.length = 0
   AND  virtualFilename.name.length = 0
   AND virtualFilename.version.length = 0
   THEN NULL -- that's what the spec says! --
   ELSE BEGIN
        absoluteFilename.length _ 0;
        String.AppendString[absoluteFilename, virtualFilename.name];
        END;
   END;

DefaultReg: PROC[name: BodyDefs.RName] =
   BEGIN
   default: STRING = ".pa"L;
   FOR i: CARDINAL DECREASING IN [0..name.length)
   DO IF name[i] = '. THEN EXIT;
   REPEAT
   FINISHED =>
      IF name.length + default.length <= name.maxlength
      THEN String.AppendString[name, default];
   ENDLOOP;
   END;

MyInspectCredentials: PROC[ fileSystem: FTPDefs.FileSystem,
                            status: FTPDefs.Status,
                            user, password: STRING ] =
   BEGIN
   real: BodyDefs.RName = LOOPHOLE[fileSystem];
   IF status = primary
   THEN BEGIN
        outcome: NameInfoDefs.AuthenticateInfo;
        IF user = NIL OR user.length > BodyDefs.maxRNameLength
        THEN { real.length _ 0; outcome _ notFound }
        ELSE BEGIN
	     IF password = NIL THEN outcome _ badPwd
	     ELSE BEGIN
                  real.length _ 0; String.AppendString[real, user];
                  DefaultReg[real];
                  outcome _ NameInfoDefs.Authenticate[real, password];
		  END;
             END;
        IF outcome # individual
        THEN BEGIN
             error: FTPDefs.FtpError = SELECT outcome FROM
                 notFound, group => noSuchPrimaryUser,
                 badPwd =>          incorrectPrimaryPassword,
                 allDown =>         unidentifiedTransientError,
               ENDCASE => ERROR;
             string: STRING = SELECT outcome FROM
                 notFound => "Incorrect registry or user name"L,
                 group =>    "Can't login as a group"L,
                 badPwd =>   "Incorrect password"L,
                 allDown =>  "Can't reach any authentication server",
               ENDCASE => ERROR;
             real.length _ 0;
             ERROR FTPDefs.FTPError[error, string];
             END;
        END;
   END;

CheckAccess: PROC[ user: BodyDefs.RName, why: {list, read, write},
                   file: STRING ] =
   BEGIN
   info: NameInfoDefs.Membership;
   IF user = NIL OR user.length = 0
   THEN ERROR FTPDefs.FTPError[credentialsMissing,
                               "No valid user/password given"L];
   IF why # list AND String.EquivalentStrings[file, "Heap.data"L]
   THEN FTPDefs.FTPError[requestedAccessDenied,
                         "'Heap.data' is private!"L];
   IF why # read AND String.EquivalentStrings[file, "GV.log"L]
   THEN info _ NameInfoDefs.IsMemberClosure["LogReaders^.ms"L, user];
   IF info # yes
   THEN info _ NameInfoDefs.IsMemberClosure["Transport^.ms"L, user];
   SELECT info FROM
     yes => NULL;
     no, notGroup =>
       ERROR FTPDefs.FTPError[requestedAccessDenied,
                              "You're not allowed access to this server"L];
     allDown =>
       ERROR FTPDefs.FTPError[requestedAccessDenied,
                              "Can't contact access control server"L];
   ENDCASE => ERROR;
   END;

OpenVMFile: PROC[file: STRING,
                 action: {read, write, delete, enumerate}]
            RETURNS[handle: VMDefs.FileHandle] =
   BEGIN
   ENABLE VMDefs.CantOpen => SELECT reason FROM
       notFound =>
         ERROR FTPDefs.FTPError[noSuchFile, "File does not exist"L];
       alreadyExists =>
         ERROR FTPDefs.FTPError[fileAlreadyExists, "File already exists"L];
       accessDenied =>
         ERROR FTPDefs.FTPError[requestedAccessDenied,
                                "File not available at present"L];
       illegalFileName =>
         ERROR FTPDefs.FTPError[illegalFilename,
                                "Illegal file title"L];
     ENDCASE =>
       ERROR FTPDefs.FTPError[unidentifiedPermanentError,
                              "Unidentified ""CantOpen"" from VM"L];
   handle _ VMDefs.OpenFile[
      options: SELECT action FROM
                 read, enumerate => oldReadOnly,
                 write => oldOrNew,
                 delete => old,
               ENDCASE => ERROR,
      name: file, cacheFraction: 2 ];
   END;

GetInfo: PROC[handle: VMDefs.FileHandle, info: FTPDefs.FileInfo] =
   BEGIN
   IF info = NIL THEN RETURN;
   BEGIN
      length: VMDefs.Position = VMDefs.GetFileLength[handle];
      info.byteCount _ LONG[length.page] * 2*VMDefs.pageSize + length.byte;
   END;
   info.fileType _ binary;
   info.byteSize _ 8;
   BEGIN
      Append: PROC[s: STRING, t: Time.Packed] =
         BEGIN
         IF s # NIL
         THEN { s.length _ 0; Time.Append[s, Time.Unpack[t], TRUE] };
         END;
      create, write, read: Time.Packed;
      [create: LOOPHOLE[create, VMDefs.FileTime],
       read: LOOPHOLE[read, VMDefs.FileTime],
       write: LOOPHOLE[write, VMDefs.FileTime]] _ VMDefs.GetFileTimes[handle];
      Append[info.creationDate, create];
      Append[info.writeDate, write];
      Append[info.readDate, read];
   END;
   END;
   

MyEnumerateFiles: PROC[ fileSystem: FTPDefs.FileSystem,
               files: STRING, intent: FTPDefs.EnumerateFilesIntent,
               processFile: PROC[UNSPECIFIED,STRING,FTPDefs.FileInfo],
               processFileData: UNSPECIFIED ] =
   BEGIN
   real: BodyDefs.RName = LOOPHOLE[fileSystem];
   creation: STRING = [22]; -- 31-Oct-83 25:61:61 BST --
   write:    STRING = [22]; -- 1234567890123456789012 --
   read:     STRING = [22];
   fileInfoObject: FTPDefs.FileInfoObject _ [
      fileType: binary, byteSize: 8, byteCount: 0,
      creationDate: creation, writeDate: write, readDate: read,
      author: NIL ];
   SingleFile: PROC[entry: AltoFile.DVPtr, name: STRING] RETURNS[BOOLEAN] =
      BEGIN
      IF entry.type = AltoFile.DEfile
      THEN BEGIN
           handle: VMDefs.FileHandle = VMSpecial.OpenAltoFileFromFP[
                      [entry.fp.serial,entry.fp.leaderDA],FALSE,0];
           GetInfo[handle, @fileInfoObject];
           VMDefs.AbandonFile[handle];
           processFile[processFileData, name, @fileInfoObject];
           END;
      RETURN[FALSE]
      END;
   CheckAccess[real, list, files];
   IF intent = enumeration AND files.length = 1 AND files[0] = '*
   THEN BEGIN
        h: AltoFile.DirHandle = AltoFile.OpenDirectory[AltoFile.sysDirFP];
        [] _ AltoFile.Enumerate[h, SingleFile ! UNWIND =>
                                AltoFile.CloseDirectory[h] ];
        AltoFile.CloseDirectory[h];
        END
   ELSE BEGIN
        IF intent = enumeration
        THEN BEGIN
             handle: VMDefs.FileHandle = OpenVMFile[files, enumerate];
             GetInfo[handle, @fileInfoObject];
             VMDefs.CloseFile[handle];
             END;
        processFile[processFileData, files, @fileInfoObject];
        END;
   END;

MyOpenFile: PROC[ fileSystem: FTPDefs.FileSystem,
               file: STRING, mode: FTPDefs.Mode, fileTypePlease: BOOLEAN,
               info: FTPDefs.FileInfo ]
            RETURNS[ fileHandle: FTPDefs.FileHandle,
                     fileType: FTPDefs.FileType] =
   BEGIN
   real: BodyDefs.RName = LOOPHOLE[fileSystem];
   SELECT mode  FROM
     read =>
        BEGIN
        handle: VMDefs.FileHandle;
        CheckAccess[real, read, file];
        handle _ OpenVMFile[file, read];
        LogAction[real, file, read];
        GetInfo[handle, info];
        fileType _ binary;
        fileHandle _ LOOPHOLE[handle]; 
        END;
     write =>
        BEGIN
        CheckAccess[real, write, file];
        fileHandle _ LOOPHOLE[ OpenVMFile[file, write] ];
        LogAction[real, file, write];
        IF info # NIL AND info.creationDate # NIL
        AND info.creationDate.length > 0
        THEN VMDefs.SetCreationTime[file: LOOPHOLE[fileHandle],
              create: TimeExtraDefs.PackedTimeFromString[info.creationDate]
              ];
        END;
     ENDCASE =>
        ERROR FTPDefs.FTPError[requestedAccessDenied,
                               "Unexpected access mode"L];
   END;

MyReadFile: PROC[fileSystem: FTPDefs.FileSystem,
               fileHandle: FTPDefs.FileHandle,
               sendBlock: PROC[UNSPECIFIED,POINTER,CARDINAL],
               sendBlockData: UNSPECIFIED ] =
   BEGIN
   handle: VMDefs.FileHandle = LOOPHOLE[fileHandle];
   length: VMDefs.Position = VMDefs.GetFileLength[handle];
   FOR p: CARDINAL IN [0..length.page) --complete pages--
   DO page: VMDefs.Page = VMDefs.ReadPage[ [handle,p], 2 ];
      sendBlock[sendBlockData, page, 2*VMDefs.pageSize !
                UNWIND => VMDefs.Release[page] ];
      VMDefs.Release[page];
   ENDLOOP;
   IF length.byte > 0
   THEN --partial page--
        BEGIN
        page: VMDefs.Page = VMDefs.ReadPage[ [handle, length.page], 0 ];
        sendBlock[sendBlockData, page, length.byte !
                  UNWIND => VMDefs.Release[page] ];
        VMDefs.Release[page];
        END;
   END;

MyWriteFile: PROC[fileSystem: FTPDefs.FileSystem,
               fileHandle: FTPDefs.FileHandle,
               receiveBlock: PROC[UNSPECIFIED,POINTER,CARDINAL]
                             RETURNS[CARDINAL],
               receiveBlockData: UNSPECIFIED ] =
   BEGIN
   handle: VMDefs.FileHandle = LOOPHOLE[fileHandle];
   pos: VMDefs.Position _ [0,0];
   page: VMDefs.Page _ VMDefs.UsePage[ [handle, pos.page] ];
   DO ENABLE UNWIND => IF page # NIL THEN VMDefs.Release[page];
      amount: CARDINAL = receiveBlock[receiveBlockData, page+(pos.byte/2),
                                      VMDefs.pageSize-(pos.byte/2) ];
      IF amount = 0 THEN EXIT;
      pos.byte _ pos.byte + amount;
      IF amount MOD 2 # 0
      THEN BEGIN
           temp: UNSPECIFIED;
           IF receiveBlock[receiveBlockData, @temp, SIZE[UNSPECIFIED]] = 0
           THEN EXIT
           ELSE ERROR FTPDefs.FTPError[requestedAccessDenied,
                          "Odd-byte block boundary not implemented"L];
           END;
      IF pos.byte >= 2 * VMDefs.pageSize
      THEN BEGIN
           IF pos.byte > 2 * VMDefs.pageSize THEN ERROR;
           VMDefs.MarkStart[page];
           VMDefs.Release[page]; page _ NIL;
           pos.page _ pos.page+1; pos.byte _ 0;
           page _ VMDefs.UsePage[ [handle, pos.page] ];
           END;
   ENDLOOP;
   IF pos.byte > 0 THEN VMDefs.MarkStart[page];
   VMDefs.Release[page];
   VMDefs.WaitFile[handle];
   VMDefs.SetFileLength[handle, pos];
   END;

MyCloseFile: PROC[fileSystem: FTPDefs.FileSystem,
               fileHandle: FTPDefs.FileHandle,
               aborted: BOOLEAN ] =
   BEGIN
   VMDefs.CloseFile[LOOPHOLE[fileHandle]];
   END;

MyDeleteFile: PROC[fileSystem: FTPDefs.FileSystem, file: STRING] =
   BEGIN
   real: BodyDefs.RName = LOOPHOLE[fileSystem];
   handle: VMDefs.FileHandle;
   CheckAccess[real, write, file];
   handle _ OpenVMFile[file, delete];
   LogAction[real, file, delete];
   VMDefs.DestroyFile[handle];
   END;

MyRenameFile: PROC[fileSystem: FTPDefs.FileSystem,
                   currentFile, newFile: STRING] =
   BEGIN
   real: BodyDefs.RName = LOOPHOLE[fileSystem];
   CheckAccess[real, write, newFile];
   CheckAccess[real, read, currentFile];
   LogAction[real, currentFile, rename];
   IF NOT VMSpecial.QuickAndDirtyAltoRename[old: currentFile, new: newFile]
   THEN ERROR FTPDefs.FTPError[requestedAccessDenied,
          "source of rename doesn't exist or destination already exists"L];
   END;


-- Backstop and Filter for listeners --

Backstop: FTPDefs.BackstopServer _
   BEGIN
   addr: PupDefs.PupAddress;
   IF NOT PupDefs.ParsePupAddressConstant[ @addr, originOfRequest ]
   THEN BEGIN addr.net _ [0]; addr.host _ [0]; END;
   localInsignia.length _ 0;
   String.AppendString[localInsignia, "Grapevine FTP server on host "L];
   PupDefs.AppendMyName[localInsignia];
   server[ !
      FTPDefs.FTPError => SELECT ftpError FROM
          IN FTPDefs.CommunicationError,
          IN FTPDefs.ProtocolError => CONTINUE;
          IN FTPDefs.UnidentifiedError => CONTINUE;
        ENDCASE => RESUME;
      WhoIsHe => RESUME[addr.net, addr.host];
      VMDefs.Error => SELECT reason FROM
        io =>
          ERROR FTPDefs.FTPError[fileDataError,
                                 "Unrecoverable i/o error"L];
        resources =>
          ERROR FTPDefs.FTPError[noRoomForFile,
                                 "Backing store full"L];
        ENDCASE =>
       ERROR FTPDefs.FTPError[unidentifiedPermanentError,
                              "Unidentified ""VMDefs.Error"""L];
      VMDefs.CantWriteBackingStore =>
          ERROR FTPDefs.FTPError[fileDataError,
                                 "Can't write page to backing store"L];
      VMDefs.CantReadBackingStore =>
          ERROR FTPDefs.FTPError[fileDataError,
                                 "Can't read page from backing store"L];
     ];
   PolicyDefs.EndOperation[FTP];
   END;

Filter: PROC[from: STRING, purpose: FTPDefs.Purpose] =
   BEGIN
   IF NOT PolicyDefs.CheckOperation[FTP]
   THEN BEGIN
        LogDefs.WriteLogEntry["Rejected FTP connection"L];
        ERROR FTPDefs.RejectThisConnection["Server full"L];
        END;
   END;


-- Initialization --

myFilePrimitives: FTPDefs.FilePrimitivesObject _ [
   CreateFileSystem:   MyCreate,
   DestroyFileSystem:  MyDestroy,
   DecomposeFilename:  MyDecompose,
   ComposeFilename:    MyCompose,
   InspectCredentials: MyInspectCredentials,
   EnumerateFiles:     MyEnumerateFiles,
   OpenFile:           MyOpenFile,
   ReadFile:           MyReadFile,
   WriteFile:          MyWriteFile,
   CloseFile:          MyCloseFile,
   DeleteFile:         MyDeleteFile,
   RenameFile:         MyRenameFile
   ];

FTPDefs.FTPInitialize[];
FTPDefs.FTPCatchUnidentifiedErrors[FALSE];

[] _ FTPDefs.FTPCreateListener[
        --purpose--      files,
        --file system--  @myFilePrimitives,
        --mail system--  NIL,
        --comm system--  FTPDefs.PupCommunicationPrimitives[],
        --backstop--     @Backstop,
        --backstopData-- 0,
        --filter--       Filter];

END.