Unit RemoteU ;
Interface
    uses Dos,           (* Standard Turbo Pascal Unit *)
         KGlobals,
         Packets,
         SendRecv ;
    Procedure RemoteProc (var Instring : String) ;
Implementation
(* ----------------------------------------------------------------- *)
(*  RemoteProc - Remote procedure.                                   *)
(* ----------------------------------------------------------------- *)
Procedure RemoteProc (var Instring : String) ;
Const
    Gsubtype : String[18] =  ' CDEFHIJKLMPQRTUVW' ;
TYPE
    RemoteCommandindex = (
                  rem_zero,
                  rem_kermit,
                  rem_cwd,
                  rem_directory,
                  rem_erase,
                  rem_finish,
                  rem_help,
                  rem_login,
                  rem_journal,
                  rem_copy,
                  rem_logout,
                  rem_message,
                  rem_program,
                  rem_query,
                  rem_rename,
                  rem_type,
                  rem_usage,
                  rem_variable,
                  rem_who);
Var
    ErrorMsg : String ;
    Rem_CommandTable : String[255] ;
    Rem_Command : String ;
    Tempstring : String ;
    Index : integer ;
    Receiving : boolean ;
    Retries : integer ;
    j,CharCount,Bit8 : integer ;
    i,i1,i2,i3 : integer ;
(* ----------------------------------------------------------------------- *)
Procedure AddParmString ;
var i,ix : integer ;
    Begin (* Add parms *)
    If length(instring) > 0 then
         Begin (* add parameter *)
         ix := Pos(';',instring) - 1 ;
         if ix <= 0 then ix := length(instring) ;
         SendData[OutdataCount+1] := ix + $20 ;
         For i := 1 to ix do
              SendData[OutdataCount+1+i] := ord(instring[i]) ;
         OutdataCount := OutdataCount + ix + 1 ;
         Instring := copy(instring,ix+1,length(instring)-ix);
         If Instring[1] = ';' then
              Instring := copy(instring,2,length(instring)-1);
         End ;
    End ; (* Add parms *)

(* *********************************************************************** *)
Begin (* RemoteProc *)
rem_commandtable  := concat('bad       ',
                       'KERMIT    ',
                       'CWD       ',
                       'DIRECTORY ',
                       'ERASE     ',
                       'FINISH    ',
                       'HELP      ',
                       'LOGIN     ',
                       'JOURNAL   ',
                       'COPY      ',
                       'LOGOUT    ',
                       'MESSAGE   ',
                       'PROGRAM   ',
                       'QUERY     ',
                       'RENAME    ',
                       'TYPE      ',
                       'USAGE     ',
                       'VARIABLE  ',
                       'WHO       ') ;
    rem_command := ' ' + Uppercase(GETTOKEN(instring));
    if rem_command = ' HOST' then
         Begin (* Host Command *)
         End   (* Host Command *)
                             else
         Begin (* Generic Kermit Commands *)
         index := POS(rem_command,rem_commandtable) div 10 ;
         if index = 0 then
              Begin (* list commands *)
              Writeln (rem_command,' - Invalid REMOTE command. ');
              Writeln('    Valid REMOTE Commands are as follows: ');
              Writeln('KERMIT    command       - command for other kermit');
              Writeln('CWD       directory     - Change Working Directory');
              Writeln('DIRECTORY filespec      - Directory               ');
              Writeln('ERASE     filespec      - Erase (delete) a file   ');
              Writeln('FINISH                  - Terminate Kermit server ');
              Writeln('HELP      keywords      - Help from server        ');
              Writeln('LOGIN     userid        - Login                   ');
              Writeln('JOURNAL   command       - Transaction Logging     ');
              Writeln('COPY      filespec      - Copy file               ');
              Writeln('LOGOUT                  - Logout the remote host  ');
              Writeln('MESSAGE   destination   - Message                 ');
              Writeln('PROGRAM   program-name  - Program execution       ');
              Writeln('QUERY                   - Query server status     ');
              Writeln('RENAME    old-filespec  - Rename file             ');
              Writeln('TYPE      filespec      - Type (list) file        ');
              Writeln('USAGE     area          - Disk Usage Query        ');
              Writeln('VARIABLE  command       - Set or Query a Variable ');
              Writeln('WHO       userid        - Who is logged in        ');
              End   (* list commands *)
                      else
              Begin (* Issue Remote command Request *)
    (* Send Init Packet *)
  OutPacketType := Ord('I');
    PutInitPacket ;
    SendPacket ;
    STATE := R ;
    RECEIVING := TRUE ;
    BreakState := NoBreak ;
    RETRIES := 10 ;       (* Up to 10 retries allowed. *)

    WHILE RECEIVING DO  CASE STATE OF

(* R ------ Initial receive State ------- *)
(* Valid types  - Y *)
R : BEGIN (* Initial Receive State  *)
    If ( Not RecvPacket) or (InPacketType=Ord('N')) then Resendit(10)
                                                    else
         Begin (* Send Request *)
         If InPacketType=Ord('Y') then GetInitPacket ;
         If NoEcho  then waitxon := false ;
         OutPacketType := Ord('G') ;
         SendData[1] := Ord(GSubtype[index]) ;
         OutDataCount :=  1 ;
         OUTSEQ   := 0 ;
         IF OUTSEQ >= 64 THEN OUTSEQ := 0;
         Case RemoteCommandIndex(index) of
     rem_zero:   ;
     rem_kermit:   Begin (* remote kermit command *)
                   OutPacketType := Ord('K') ;
                   OutDataCount :=  0 ;
                   AddParmString;
                   End ; (* remote kermit command *)

      rem_cwd:     Begin (* Change Working Directory *)
                   AddParmString;
                   Writeln (' Enter Password ') ;
                   Readln(instring);
                   AddParmString ;
                   End ; (* Change Working Directory *)
rem_directory:     AddParmString;
    rem_erase:     AddParmString;
   rem_finish:     AddParmString;
     rem_help:     AddParmString;
    rem_login:     Begin (* Login *)
                   AddParmString;
                   Writeln (' Enter Password ') ;
                   Readln(instring);
                   AddParmString ;
                   Writeln (' Enter Account Number ') ;
                   Readln(instring);
                   AddParmString ;
                   End ; (* Login *)
  rem_journal:     Begin (* Journal *)
                   AddParmString;
                   Writeln (' Enter Journal Argument ') ;
                   Readln(instring);
                   AddParmString ;
                   End ; (* Jounral *)
     rem_copy:     Begin (* Copy file *)
                   AddParmString;
                   Writeln (' Enter destination ') ;
                   Readln(instring);
                   AddParmString ;
                   End ; (* Copy file *)
   rem_logout:     AddparmString;
  rem_message:     Begin (* Message *)
                   AddParmString;
                   Writeln (' Enter Message text ') ;
                   Readln(instring);
                   AddParmString ;
                   End ; (* Message *)
  rem_program:     Begin (* Program *)
                   AddParmString;
                   Writeln (' Enter Program commands ') ;
                   Readln(instring);
                   AddParmString ;
                   End ; (* Program *)
    rem_query:     ;
   rem_rename:     Begin (* Rename file *)
                   AddParmString;
                   Writeln (' Enter New Name ') ;
                   Readln(instring);
                   AddParmString ;
                   End ; (* Rename file *)
     rem_type:     AddParmString;
    rem_usage:     AddParmString;
 rem_variable:     Begin (* Variable *)
                   If length(instring) < 1 then
                        begin (* get command *)
                        Writeln (' QUERY assumed. ') ;
                        instring := 'QUERY';
                        end ; (* get next argument *)
                   AddParmString;
                   If length(instring) < 1 then
                        begin (* get next argument *)
                        Writeln (' Enter First Argument ') ;
                        Readln(instring);
                        end ; (* get next argument *)
                   AddParmString ;
                   If length(instring) < 1 then
                        begin (* get next argument *)
                        Writeln (' Enter Second Argument ') ;
                        Readln(instring);
                        end ; (* get next argument *)
                   AddParmString ;
                   End ; (* Variable *)
      rem_who:     Begin (* Who  *)
                   AddParmString;
                   Writeln (' Enter Options ') ;
                   Readln(instring);
                   AddParmString ;
                   End ; (* Who *)
         End ; (* Case *)

         SendPacket ;
         STATE := RF ;
         End ; (* Send Request *)

    END ; (* Initial Receive State  *)


    (* RF ----- Receive Filename State ------- *)
    (* Valid received msg type  : S,Z,F,B     *)
    RF: IF (NOT RECVPACKET) OR (InPacketType=Ord('N')) then  ReSendit(10)
                                                       else
        (* Get a packet *)
        IF (InPacketType = Ord('Y')) or (InPacketType=Ord('E')) then
              BEGIN (* Got simple reply  *)
              For i := 1 to InDataCount do
                   Write(Chr(RecvData[i])) ;
              Writeln(' ');
              RECEIVING := false ;
              (* check for date or time setting *)
              For i := 1 to InDataCount do  tempstring[i] := Chr(RecvData[i]);
              tempstring[0] := Chr(InDataCount) ;
              If  Pos('DATE' ,Tempstring )= 1 then
                   Begin (* set date *)
                   Val(copy(tempstring,6,2),i1,i) ;
                   Val(copy(tempstring,9,2),i2,i) ;
                   Val(copy(tempstring,12,2),i3,i) ;
                   SetDate(i3+1900,i1,i2);
                   End ; (* set date *)
              If  Pos('TIME' ,Tempstring )= 1 then
                   Begin (* set time *)
                   Val(copy(tempstring,6,2),i1,i) ;
                   Val(copy(tempstring,9,2),i2,i) ;
                   Val(copy(tempstring,12,2),i3,i) ;
                   SetTime(i1,i2,i3,00) ;
                   End ; (* set time *)
              END   (* Got simple reply *)
                                   else
        IF InPacketType = Ord('S') then
              Begin
              GetInitPacket;
              PutInitPacket;
              OutPacketType := Ord('Y');
              SendPacket;
              End
                                   else
        IF (InPacketType = Ord('X')) or (InPacketType = Ord('F')) then
              BEGIN (* Got file header *)
              For i := 1 to InDataCount do
                   Write(Chr(RecvData[i])) ;
              Writeln(' ');
              STATE := RD ;
              SendPacketType('Y');
              END   (* Got file header *)
                                   else
         BEGIN (* Not S,F,B,Z packet *)
         STATE := A ;   (* ABORT if not a S,F,B,Z type packet *)
         ABORT := NOT_SFBZ ;
         END ; (* Not S,F,B,Z packet *)


    (* RD ----- Receive Data State ------- *)
    (* Valid received msg type  : D,Z      *)
    RD: IF (NOT RECVPACKET) OR (InPacketType=Ord('N')) then ReSendit(10)
                                                       else
        (* Got a good packet *)
        IF InPacketType = Ord('D') then
              BEGIN (* Receive data *)
        (*    WRITELN ('RECEIVE data ');  *)
              I := 1 ;
              WHILE I <= InDataCount DO
                 BEGIN (* Write Data to file  *)
                   IF (RepChar<>$20)and (RecvData[I]=RepChar) then
                        BEGIN (* Repeat char   *)
                        I := I+1 ;
                        charcount := RecvData[I] - 32 ;
                        I := I + 1 ;
                        For j := 1 to charcount - 1 do
                             Write(Chr(RecvData[i]));
                        END ;  (* Repeat char  *)
                   IF (Bit8Quote<>$20) and (RecvData[I]=Bit8Quote) then
                        BEGIN (* 8TH BIT QUOTING  *)
                        I := I+1 ;
                        BIT8 := $80 ;
                        END   (* 8TH BIT QUOTING  *)
                                                                   else
                        BIT8 := 0 ;
                   IF RecvData[I] = rCntrlQuote then
                        BEGIN (* CONTROL character *)
                        I := I+1 ;
                        IF RecvData[I] = $3F then   (* Make it a del *)
                                                   RecvData[I] := $7F
                                             else
                        IF RecvData[I] >= 64 then   (* Make it a control *)
                                          RecvData[I] := RecvData[I] - 64 ;

                       END ; (* CONTROL character *)
                   RecvData[I] := RecvData[I] + BIT8 ;
                   Write(Chr(RecvData[i])) ;
                   I := I + 1 ;
                 END ; (* Write Data to File *)
              Case Breakstate of
                   NoBreak : SendPacketType('Y');
                   BC : RECEIVING:=false ;
                   BE : SendPacketType('N') ;
                   BX : BreakAck('X') ;
                   BZ : BreakAck('Z') ;
               End; (* Case BreakState *)
              END   (* Receive data *)
                              else
         IF (InPacketType = Ord('F')) or (InPacketType=Ord('X')) then
              BEGIN (* repeat *)
              OutSeq := OutSeq - 1 ;
              SendPacketType('Y') ;
              END   (* repeat *)
                                                                   else
         IF InPacketType = Ord('Z') then SendPacketType('Y')
                                    else
         IF InPacketType = Ord('B') then State := C
                                    else
         BEGIN (* Not D,Z packet *)
         STATE := A;   (* ABORT - Type not  D,Z, *)
         ABORT := NOT_DZ ;
         END ; (* Not D,Z packet *)

 
    (* C ----- COMPLETED  State ------- *)
     C:  BEGIN (* COMPLETED Receiving *)
         SendPacketType('Y');
         RECEIVING := FALSE ;
         END ; (* COMPLETED Receiving *)

    (* A ----- A B O R T  State ------- *)
     A:  BEGIN (* Abort Sending *)
         RECEIVING := FALSE ;
         (* SEND ERROR packet *)
         OutSeq   := 0 ;
         ErrorMsg :=' Abort while receiving data' ;
         OutDataCount := length(ErrorMsg);
         for i := 1 to length(ErrorMsg) do
              SendData[i] := Ord(ErrorMsg[i]) ;
         OutPacketType := Ord('E');
         SENDPACKET ;
         END ; (* Abort Sending *)
 
         END ; (* CASE of STATE *)
              End ; (* Issue Remote command Request *)
         End  ;  (* Generic Kermit Commands *)
End ; (* RemoteProc *)
End. (* Remote Unit *)