(*(***********************************************************************

:Program.    RexxHosts.mod
:Contents.   generic class for handling ARexx ports
:Author.     hartmut Goebel [hG]
:Copyright.  Copyright © 1992,1993 by hartmut Goebel
:Copyright.  for further information see PortHandle.doc
:Language.   Oberon-2
:Translator. Amiga Oberon V3.0
:Support.    Michael Balzer (orignal ARexxBox source in 'C')
:Version.    $VER: RexxHosts.mod 2.1 (4.11.93) Copyright © 1992,1993 by hartmut Goebel

(* $NilChk- $RangeChk- $CaseChk- $OvflChk- $ReturnChk- $ClearVars- *)
***********************************************************************)*)

MODULE RexxHosts;

IMPORT
  BT *:= BasicTypes,
  d  *:= Dos,
  e  *:= Exec,
  ms  := MoreStrings,
  P  *:= PublicPorts,
  pf  := Printf,
  rx *:= Rexx,
  rxs := RexxSysLib,
  RVI,
  str := Strings,
  y   := SYSTEM;

CONST
  versionString = "$VER: RexxHosts 2.1 (4.11.93) Copyright © 1992,1993 by hartmut Goebel";

TYPE
  RexxHostPtr * = POINTER TO RexxHost;
  RexxHost * = RECORD (P.PublicPortDesc)
    replies * : LONGINT;
    extension - : ARRAY 10 OF CHAR;
  END;

CONST
  HostClosingDown * = "Host closing down";

  errProgramNotFound * = rx.err10001;
  errNoFreeStore * = rx.err10003;
  errNotImplemented * = rx.err10015;

(****** RexxHost/Init *******************************************
*
*   NAME
*       Init -- initialize a RexxHost
*
*   SYNOPSIS
*       Init (VAR rxport: RexxHost;
*               basename: e.STRPTR;
*                default: ARRAY OF CHAR;
*              extension: ARRAY OF CHAR): BOOLEAN;
*
*   FUNCTION
*       Creates port for using as ARexx port and does the necesary
*       settings.
*
*       The port name will be uppercase and may get an extension number
*       (see Ports.InitPublic()).
*
*   INPUTS
*       rxport    - RexxHost to be initialized
*       basename  - points to a null terminated string
*       default   - name to be used if name is NIL or points to
*                   an empty string
*       extension - file name extension ARexx should use to find makros
*
*   RESULT
*       FALSE if initialization failed
*
*   SEE ALSO
*       Ports.InitPublic(), RexxHost.Uninit()
*
*******)

PROCEDURE Init * (VAR rxport: RexxHost;
                    basename: e.STRPTR; (* $CopyArrays- *)
                     default: ARRAY OF CHAR;
                   extension: ARRAY OF CHAR): BOOLEAN;
BEGIN
  COPY(extension,rxport.extension);
  RETURN P.Init(rxport,basename,default,0,{P.upperCase});
END Init;


(****** RexxHosts/RexxHost.ReplyMsg *********************************
*
*   NAME
*        RexxHost.ReplyMsg -- reply a rexx message from rexxmast   (method)
*
*   SYNOPSIS
*        (VAR rxh: RexxHost) Replymsg (rxmsg: rx.RexxMsgPtr;
*                                    primary: LONGINT;
*                                  secondary: e.ADDRESS;
*                                     result: BT.DynString);
*
*   FUNCTION
*        This is a PD ARexx routine provided by William S. Hawes.
*
*        It replies a given rexx message to the rexx master process,
*        filling in a primary and a secondary return code plus
*        optionally a supplied result string.
*
*        If the primary return code equals 0 the secondary return code
*        will become an ARexx string whichs value is take from result.
*        If result is NIL, secondary we be interpreted as Exec.STRPTR
*        and the ARexxstring will be creates from this value.
*
*        If primary is positive, secondary is interpreted as a LONGINT,
*        and used as secondary result code.
*
*        If primary is negative, secondary is interpreted as a Exec.STRPTR,
*        and an ARexx string will be creates from this value.
*
*        RC will become positive (or zero) in any case.
*
*        Creates an ARexx variable "RC2" for the secondary return code.
*        RC2 will only be assigned if the ARexx RESULT flag is set.
*
*   INPUTS
*        rexxmsg   - the rexx message to reply
*        primary   - the primary return code (rc)
*        secondary - the secondary return code (rc2)
*        result    - the result string
*
*   NOTES
*        The handling with primary and result/secondary is a bit tricky,
*        but needed for returning texts which are only Exec.STRPTR without
*        convering them to BT.DynArray.
*        So here is a small table how result ans secondary are interpreted:
*
*              primary | secondary   | result
*              --------+-------------+-------------
*                 0    |  ignored    | result text
*                 0    | result text |   NIL
*                > 0   | error code  | ignored
*                < 0   | error text  | ignored
*
*   SEE ALSO
*        RexxHost.SendCommand(), RexxHost.FreeCommand()
*
*******)

PROCEDURE (VAR rxh: RexxHost) ReplyMsg * (rxmsg: rx.RexxMsgPtr;
                                        primary: LONGINT;
                                      secondary: e.ADDRESS;
                                         result: BT.DynString);
VAR
  buf: ARRAY 16 OF CHAR;
  rc2: e.STRPTR;
BEGIN
  (* Ist OPTIONS RESULTS gesetzt? *)
  IF rx.rxfResult IN rx.ActionFlags(rxmsg.action) THEN
    (* Ja, also Resultat generieren *)

    IF primary = 0 THEN
      (* Primärer Resultcode = 0 bedeutet Resultat-String in result oder gar nix *)
      IF result = NIL THEN
        IF secondary # NIL THEN
          secondary := rxs.CreateArgstring(y.VAL(e.STRPTR,secondary)^,ms.CLength(secondary))
        END;
      ELSE
        secondary := rxs.CreateArgstring(result^,str.Length(result^))
      END;
    ELSE
     (* Primär # 0: Fehlercode in primary, Zweitcode _oder_ String in secondary *)
      IF primary > 0 THEN
        (* secondary ist Code *)
        pf.SPrintf1(buf,"%ld", secondary );
        rc2 := y.ADR(buf);
      ELSE
        (* secondary ist String *)
        primary := -primary;
        rc2 := y.VAL(e.STRPTR,secondary);
      END;

      (* Rexx-Variable setzen *)
      IF RVI.SetRexxVar(rxmsg,"RC2", rc2^, str.Length(rc2^))#0 THEN END;

      secondary := NIL;
    END
  ELSIF primary < 0 THEN
    (* User will zwar kein Result, aber Fehlercode darf nicht <0 sein *)
    primary := -primary;
  END;

  rxmsg.result1 := primary;
  rxmsg.result2 := secondary;
  e.ReplyMsg(rxmsg);
END ReplyMsg;


(****** RexxHosts/RexxHost.FreeCommand ******************
*
*   NAME
*       RexxHost.FreeCommand -- free the associated memory of a RexxMsg
*                                                                  (method)
*
*   SYNOPSIS
*       (VAR rxh: RexxHost) FreeCommand (rxmsg: rx.RexxMsgPtr);
*
*   FUNCTION
*       This is basically a PD ARexx routine provided by William S. Hawes.
*
*       It frees all memory associated with a particular (previuosly sent)
*       ARexx message structure (result2, arg[0] ans the message itself). It
*       will also close any stdin/stdout channels associated to that message.
*
*       You normally shouldn't have to bother with this one because the
*       dispatcher will call it for you.
*
*   INPUTS
*       rexxmsg - the rexx message to free
*
*   SEE ALSO
*       RexxHost.SendCommand()
*
*******)

PROCEDURE (VAR rxh: RexxHost) FreeCommand * (rxmsg: rx.RexxMsgPtr);
BEGIN
  IF (rxmsg.result1 = 0) & (rxmsg.result2 # 0) THEN
    rxs.DeleteArgstring(rxmsg.result2); END;

  IF rxmsg.stdin # NIL THEN
    d.OldClose(rxmsg.stdin); END;

  IF (rxmsg.stdout # NIL) & (rxmsg.stdout # rxmsg.stdin) THEN
    d.OldClose(rxmsg.stdout); END;

  rxs.DeleteArgstring(rxmsg.args[0]);
  rxs.DeleteRexxMsg(rxmsg);
END FreeCommand;


(****** RexxHosts/RexxHost.CreateCommand ******************
*
*   NAME
*       RexxHost.CreateCommand -- allocate & initialize RexxMsg
*                                 for a command                    (method)
*
*   SYNOPSIS
*       (VAR rxh: RexxHost) CreateCommand (command: ARRAY OF CHAR;
*                                       fh: d.FileHandlePtr): rx.RexxMsgPtr;
*   FUNCTION
*       This function will create a RexxMsg structure for the given
*       RexxHost, create an Argstring from the command string and
*       use that string to initialize the message as a rx.rxComm type
*       with rx.rxResult requested.
*
*       The file handle will be used for both input and output.
*
*       You can use this function to create a standard ARexx command
*       with the additional possibility to set some extra parameters
*       before sending the command to ARexx using RexxHost.MsgToRexx().
*
*   INPUTS
*       command - the command string
*       fh      - the input/output FileHandle (see dos.library/Open())
*
*   RESULTS
*       rexxmsg - a pointer to the new RexxMsg structure
*
*   SEE ALSO
*       RexxHost.MsgToRexx(), RexxHost.SendCommand(),
*       dos.library/Open()
*
********)

PROCEDURE (VAR rxh: RexxHost) CreateCommand * (buff: ARRAY OF CHAR;
                                        fh: d.FileHandlePtr): rx.RexxMsgPtr;
VAR
  rxCmdMsg: rx.RexxMsgPtr;
BEGIN
  rxCmdMsg := rxs.CreateRexxMsg(rxh.port,rxh.extension,rxh.name);
  IF rxCmdMsg = NIL THEN
    e.Permit();
    RETURN NIL;
  END;

  rxCmdMsg.args[0] := rxs.CreateArgstring(buff,str.Length(buff));
  IF rxCmdMsg.args[0] = NIL THEN
    rxs.DeleteRexxMsg(rxCmdMsg);
    e.Permit();
    RETURN NIL;
  END;

  rxCmdMsg.action := rx.rxComm + rx.rxResult;
  rxCmdMsg.stdin  := fh;
  rxCmdMsg.stdout := fh;
  RETURN rxCmdMsg;
END CreateCommand;


(****** RexxHosts/RexxHost.MsgToRexx ******************
*
*   NAME
*       RexxHost.MsgToRexx -- send a prepared RexxMsg to the
*                             ARexx server                         (method)
*
*   SYNOPSIS
*       (VAR rxh: RexxHost) MsgToRexx (rxmsg: rx.RexxMsgPtr): rx.RexxMsgPtr;
*
*   FUNCTION
*       MsgToRexx just sends the given RexxMsg to the ARexx
*       server process without changing any fields of the Msg.
*       It will also increment the counter for outstanding replies
*       in the RexxHost structure.
*
*       You can use this function together with CreateCommand()
*       to easily create customizable command messages for Rexx.
*
*   INPUTS
*       rxmsg - an initialized ARexx message
*
*   RESULTS
*       msg - the same as rexxmessage, just for easy further processing
*
*   SEE ALSO
*       RexxHost.CreateCommand(), RexxHost.SendCommand()
*
*******)

PROCEDURE (VAR rxh: RexxHost) MsgToRexx * (rxCmdMsg: rx.RexxMsgPtr): rx.RexxMsgPtr;
VAR
  rexxport: e.MsgPortPtr;
BEGIN
  e.Forbid();

  rexxport := e.FindPort(rx.rxsDir);
  IF rexxport = NIL THEN
    e.Permit();
    RETURN NIL;
  END;

  e.PutMsg(rexxport, rxCmdMsg);
  e.Permit();

  INC(rxh.replies);
  RETURN rxCmdMsg;
END MsgToRexx;


(****** RexxHosts/RexxHost.HandleResult ******************
*
*   NAME
*       RexxHost.HandleResult -- handle sent messages when replied
*                                from ARexx                (abstact method)
*
*   SYNOPSIS
*       (VAR rxh: RexxHost) HandleResult (rxmsg: rx.RexxMsgPtr);
*
*   FUNCTION
*       none.
*
*       This method can be overwritten in a subclass to handle
*       messages replied from ARexx. So you can put out error
*       messages, make statistics or what ever you want.
*
*       The method MUST NOT rely the rxmsg. This is done by the
*       functions which call HandleResult.
*
*   INPUTS
*       rxmsg - an initialized ARexx message
*
*   SEE ALSO
*       RexxHost.Handle(), RexxHost.Uninit(), RexxHost.FreeCommand()
*
*******)

PROCEDURE (VAR rxh: RexxHost) HandleResult * (rxCmdMsg: rx.RexxMsgPtr);
END HandleResult;


(****** RexxHosts/RexxHost.SendCommand ******************
*
*   NAME
*       RexxHost.SendCommand -- invoke rexx command script         (method)
*
*   SYNOPSIS
*       (VAR rxh: RexxHost) SendCommand (command: ARRAY OF CHAR;
*                              filehandle: d.FileHandlePtr): rx.RexxMsgPtr;
*
*   FUNCTION
*       This is basically a PD ARexx routine provided by William
*       S. Hawes.
*
*       This function sends the given command string to the ARexx
*       master process for execution as an ARexx command. The
*       command string contains the file name of the ARexx script
*       to be started. If the filehandle is not NIL, it will be
*       used as stdin and stdout for the Rexx script. If it is
*       NIL, the Rexx program will use stdin/stdout of the
*       calling process.
*
*       If necessary, the extension (see Init()) will be added
*       to the file name.
*
*       Messages sent using this function will be replied to by
*       the ARexx master process as soon as the execution of the
*       command script stops. The application MUST NOT close
*       it's messageport before all replies have been received!
*       To simplify things, RexxHost does this book-keeping for you.
*       RexxHost.Uninit() will wait for all missing replies to
*       arrive before closing down the messageport.
*
*       The dispatcher will automagically detect any replies,
*       count them and do a RexxHost.FreeCommand() for each
*       reply, so you don't have to bother with this either.
*
*       Internally, this function is implemented using the two
*       more atomic functions RexxHost.CreateCommand() and
*       RexxHost.MsgToRexx().
*
*   INPUTS
*       command    - the file name of the ARexx script
*       filehandle - Filehandle for stdin/stdout or NIL
*
*   RESULTS
*       rexxmsg - the sent rexx message structure (for comparisons)
*
*   SEE ALSO
*       RexxHost.FreeCommand(), RexxHost.Uninit(), RexxHost.Handle()
*       RexxHost.CreateCommand(), RexxHost.MsgToRexx()
*
********)

PROCEDURE (VAR rxh: RexxHost) SendCommand * (buff: ARRAY OF CHAR;
                                             fh: d.FileHandlePtr): rx.RexxMsgPtr;
VAR
  rcm: rx.RexxMsgPtr;
BEGIN
  rcm := rxh.CreateCommand(buff, fh);
  IF rcm # NIL THEN
    RETURN rxh.MsgToRexx(rcm);
  ELSE
    RETURN NIL;
  END;
END SendCommand;


(****** RexxHosts/RexxHost.HandleCommand ******************
*
*   NAME
*        RexxHost.HandleCommand -- handle rexx command message     (method)
*
*   SYNOPSIS
*        (VAR rxh: RexxHost) HandleCommand (rxmsg: rx.RexxMsgPtr);
*
*   FUNCTION
*        Sets the messages primary result to 10 (error), the secondary
*        error code to 15 (not implemented) and replies the message.
*
*        In subclasses this method should handle the ARexx command suplied in
*        arg[0] and execute it.
*
*        HandleCommand MUST reply the message (e.g. using RexxHost.ReplyMsg()).
*
*   INPUTS
*        msg - the rexx message to be handled
*
*   SEE ALSO
*        RexxHost.Handle(), RexxHost.ReplyMsg();
*
*******)

PROCEDURE (VAR rxh: RexxHost) HandleCommand * (rxmsg: rx.RexxMsgPtr);
BEGIN
  rxh.ReplyMsg(rxmsg,rx.error,errNotImplemented,NIL);
END HandleCommand;


(****** RexxHosts/RexxHost.HandleFunction ******************
*
*   NAME
*        RexxHost.HandleFunction -- handle rexx function message   (method)
*
*   SYNOPSIS
*        (VAR rxh: RexxHost) HandleFunction (rxmsg: rx.RexxMsgPtr);
*
*   FUNCTION
*        Sets the messages primary result to 5 (warn), the secondary
*        error code to 1 (program not found) and replies the message.
*
*        In subclasses this method should handle the ARexx function call
*        according to the ARexx documentation.
*
*        HandleFunction MUST reply the message (e.g. using RexxHost.ReplyMsg()).
*
*   INPUTS
*        msg - the rexx message to be handled
*
*   SEE ALSO
*        RexxHost.Handle(), RexxHost.ReplyMsg()
*
*******)

PROCEDURE (VAR rxh: RexxHost) HandleFunction * (rxmsg: rx.RexxMsgPtr);
BEGIN
  rxh.ReplyMsg(rxmsg,rx.warn,errProgramNotFound,NIL);
END HandleFunction;


(****** RexxHosts/RexxHost.Uninit ******************
*
*   NAME
*       RexxHost.Uninit -- close and free RexxHost                 (method)
*
*   SYNOPSIS
*       (VAR rxh: RexxHost) Uninit ();
*
*   FUNCTION
*       Waits until replies for all pending ARexx commands have
*       been received and then closes the ARexx port and frees
*       all memory associated with that RexxHost structure.
*
*       All messages sent to a closing host will be replied
*       immediately with an error "Host closing down".
*
*   SEE ALSO
*       Init(), RexxHost.SendCommand()
*
********)

PROCEDURE (VAR rxh: RexxHost) Uninit *;
VAR
  rexxmsg: rx.RexxMsgPtr;
BEGIN
  IF rxh.port # NIL THEN
    (* Port abmelden *)
    e.RemPort(rxh.port);

    (* auf noch ausstehende Replies warten *)
    WHILE rxh.replies > 0 DO
      e.WaitPort( rxh.port );
      LOOP
        rexxmsg := e.GetMsg(rxh.port);
        IF rexxmsg = NIL THEN EXIT; END;
        IF rexxmsg.node.node.type = e.replyMsg THEN
          rxh.HandleResult(rexxmsg);
          rxh.FreeCommand(rexxmsg);
          DEC(rxh.replies);
        ELSE
          rxh.ReplyMsg(rexxmsg,-20, y.ADR(HostClosingDown),NIL);
        END;
      END;
    END;

    (* MsgPort leeren *)
    e.Forbid();
    LOOP
      rexxmsg := e.GetMsg(rxh.port);
      IF rexxmsg = NIL THEN EXIT; END;
      rxh.ReplyMsg(rexxmsg,-20, y.ADR(HostClosingDown),NIL);
    END;
    e.Permit();
    e.DeleteMsgPort(rxh.port);
  END;
END Uninit;


(****** RexxHosts/RexxHost.Handle ******************
*
*   NAME
*       RexxHost.Handle -- get ARexx command from RexxHost and
*                          execute it via RexxPort.HandleCommand() (method)
*
*   SYNOPSIS
*        (VAR rxh: RexxHost) Handle ();
*
*   FUNCTION
*        Fetches all queued messages from the given RexxHost's
*        message port and calls RexxHost.HandleCommand for each message
*        of type rxComm.
*
*        If a reply for some previously (with RexxHost.SendCommand())
*        sent command comes in, the counter variable for still outstanding
*        replies will be decreased by one and the RexxMsg and it's
*        associated memory will be freed by RexxHost.FreeCommand().
*
*        In a subclass, you should just check for the signal of the host's
*        message port and call Handle() without actually getting the
*        message. All work will be done by the dispatcher ans HandleCommand().
*
*   SEE ALSO
*        RexxHost.HandleCommand(), RexxHost.SendCommand(), Init(),
*
*******)

PROCEDURE (VAR rxh: RexxHost) Handle * ();
VAR
  rexxmsg: rx.RexxMsgPtr;
BEGIN
 LOOP
   rexxmsg := e.GetMsg(rxh.port);
   IF rexxmsg = NIL THEN EXIT; END;
   IF rexxmsg.node.node.type = e.replyMsg THEN
     (* ein Reply von einem unserer Kommandos *)
     rxh.HandleResult(rexxmsg);
     rxh.FreeCommand(rexxmsg);
     DEC(rxh.replies);
   ELSIF (rx.ActionCode(rexxmsg.action) = rx.rxComm) (* ein Kommando *)
         & (rexxmsg.args[0] # NIL) THEN
      rxh.HandleCommand(rexxmsg);
   ELSIF (rx.ActionCode(rexxmsg.action) = rx.rxFunc)
         & (rexxmsg.args[0] # NIL) THEN
      rxh.HandleFunction(rexxmsg);
   ELSE
     e.ReplyMsg(rexxmsg);
   END;
 END;
END Handle;


PROCEDURE IsARexxReply*(msg: e.MessagePtr): BOOLEAN;
BEGIN RETURN (msg # NIL) & (msg.node.type = e.replyMsg); END IsARexxReply;

(* support function to kepp Add/RemFuncHost short *)
PROCEDURE SendFunctionToRexx (rxh: RexxHost; action: LONGINT; arg1: LONGINT): BOOLEAN;
VAR
  msg: rx.RexxMsgPtr;
  port: e.MsgPortPtr;
BEGIN
  msg := rxs.CreateRexxMsg(rxh.port, rxh.extension, rxh.name);
  IF msg = NIL THEN RETURN FALSE; END;

  (* we don't expect a reply so we don't increase the count
   * of outstanding messages.
   *)
  msg.action  := action+rx.rxfNonRet;
  msg.args[0] := rxh.port.node.name;
  msg.args[1] := y.VAL(e.LSTRPTR,arg1);

  (* Find the port *)
  e.Forbid();
  port := e.FindPort("REXX");
  IF port # NIL THEN
    e.PutMsg(port, msg);
    e.Permit();
    RETURN TRUE; (* okay *)
  END;
  (* no port, clean up... *)
  e.Permit();
  rxs.ClearRexxMsg(msg, 16);
  rxs.DeleteRexxMsg(msg);
  RETURN FALSE;
END SendFunctionToRexx;

(*
 * AddFuncHost -- Adds the context's port name to the Library List
 *                as a function host with the given priority.
 *)

PROCEDURE AddFuncHost * (rxh: RexxHost; priority: LONGINT): BOOLEAN;
BEGIN
  RETURN SendFunctionToRexx(rxh, rx.rxAddFH, priority);
END AddFuncHost;

(*
 * RemFuncHost -- Remove the context's port name from the Library List.
 *)

PROCEDURE RemFuncHost * (rxh: RexxHost): BOOLEAN;
BEGIN
  RETURN SendFunctionToRexx(rxh, rx.rxRemLib, 0);
END RemFuncHost;

(*
 * AddFuncLib -- Adds the context's port name to the Library List
 *               as a function host with the given priority.
 *)

PROCEDURE AddFuncLib * (rxh: RexxHost; priority: LONGINT): BOOLEAN;
BEGIN
  RETURN SendFunctionToRexx(rxh, rx.rxAddLib, priority);
END AddFuncLib;

(*
 * RemFuncLib -- Remove the context's port name from the Library List.
 *)

PROCEDURE RemFuncLib * (rxh: RexxHost): BOOLEAN;
BEGIN
  RETURN SendFunctionToRexx(rxh, rx.rxRemLib, 0);
END RemFuncLib;

(*
 * SetARexxLastError -- Uses RVI to set an error string in a calling
 *                      ARexx program.  The string is stored in the
 *                      variable <appname>.LASTERROR.  Will only work
 *                      if RVI is #defined -- you must also link to
 *                      the rexxvars.o file.
 *)
(*
PROCEDURE SetLastError(rxh: RexxHost; msg: rx.RexxMsgPtr;
                            error: e.STRPTR): BOOLEAN;
  IF (rxh = NIL) OR  (msg = NIL) OR (error = NIL) THEN
    RETURN FALSE;
  ELSIF ~ CheckRexxMsg (msg) THEN
    RETURN FALSE;
  END;
  RETURN SetRexxVar( msg, context->error_name, error, strlen( error ) ) == 0 ;
END SetLastError(rxh: RexxHost; msg: rx.RexxMsgPtr;
*)

END RexxHosts.