**
     **  Program . . : SEC101
     **  Description : Control Intrusion Detection Services - CPP
     **  Author  . . : Carsten Flensburg
     **
     **
     **
     **
     **  Compile options:
     **    CrtRpgMod  Module( SEC101 )
     **               DbgView( *LIST )
     **
     **    CrtPgm     Pgm( SEC101 )
     **               Module( SEC101 )
     **               ActGrp( *NEW )
     **
     **
     **-- Header specifications:  --------------------------------------------**
     H Option( *SrcStmt )

     **-- Api error data structure:
     D ERRC0100        Ds                  Qualified
     D  BytPro                       10i 0 Inz( %Size( ERRC0100 ))
     D  BytAvl                       10i 0 Inz
     D  MsgId                         7a
     D                                1a
     D  MsgDta                      128a
     **-- Global variables:
     D Status          s             10i 0
     D IdsSts          s             10a   Dim( 2 )
     **-- Global constants:
     D OFS_MSGDTA      c                   16
     D NULL            c                   ''

     **-- TCP/IP attributes:
     D TCPA0100        Ds                  Qualified
     D  BytRtn                       10u 0
     D  BytAvl                       10u 0
     D  StkSts                       10u 0
     D  ActTim                       10u 0
     D  LstStrD                       8a
     D  LstStrT                       6a
     D  LstEndD                       8a
     D  LstEndT                       6a
     D  StrJob                       10a
     D  StrUsr                       10a
     D  StrNbr                        6a
     D  StrJobInt                    16a
     D  EndJob                       10a
     D  EndUsr                       10a
     D  EndNbr                        6a
     D  EndJobInt                    16a
     D  OfsAddInf                    10u 0
     D  LenAddInf                    10u 0
     D  LmtMod                       10u 0

     **-- Control intrusion detection and prevention:
     D CtlIds          Pr                  ExtPgm( 'QTOQIDSC' )
     D  RqsFnc                       10i 0 Const
     D  Status                       10i 0
     D  Error                     32767a          Options( *VarSize )
     **-- Retrieve TCP/IP attributes:
     D RtvTcpA         Pr                  ExtProc( 'QtocRtvTCPA' )
     D  RcvVar                    32767a          Options( *VarSize )
     D  RcvVarLen                    10i 0 Const
     D  FmtNam                        8a   Const
     D  Error                     32767a          Options( *VarSize )
     **-- Send program message:
     D SndPgmMsg       Pr                  ExtPgm( 'QMHSNDPM' )
     D  MsgId                         7a   Const
     D  MsgFq                        20a   Const
     D  MsgDta                      128a   Const
     D  MsgDtaLen                    10i 0 Const
     D  MsgTyp                       10a   Const
     D  CalStkE                      10a   Const  Options( *VarSize )
     D  CalStkCtr                    10i 0 Const
     D  MsgKey                        4a
     D  Error                     32767a          Options( *VarSize )

     **-- Send completion message:
     D SndCmpMsg       Pr            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **-- Send escape message:
     D SndEscMsg       Pr            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgF                       10a   Const
     D  PxMsgDta                    512a   Const  Varying
     **
     D SEC101          Pr
     D  PxOption                     10i 0
     **
     D SEC101          Pi
     D  PxOption                     10i 0

      /Free

        RtvTcpA( TCPA0100: %Size( TCPA0100 ): 'TCPA0100': ERRC0100 );

        Select;
        When  ERRC0100.BytAvl  > *Zero;
          ExSr  EscApiErr;

        When  TCPA0100.StkSts <> 1;
          SndEscMsg( 'CPD337D': 'QCPFMSG': NULL );
        EndSl;

        IdsSts(1) = '*INACTIVE';
        IdsSts(2) = '*ACTIVE';

        CtlIds( PxOption: Status: ERRC0100 );

        If  ERRC0100.BytAvl > *Zero;
          ExSr  EscApiErr;
        Else;
          ExSr  PrcSts;
        EndIf;

        *InLr = *On;
        Return;


        BegSr  PrcSts;

          SndCmpMsg( 'Current IDS status is '         +
                      %TrimR( IdsSts( Status + 1 ))   +
                     '.'
                   );

        EndSr;

        BegSr  EscApiErr;

          If  ERRC0100.BytAvl < OFS_MSGDTA;
            ERRC0100.BytAvl = OFS_MSGDTA;
          EndIf;

          SndEscMsg( ERRC0100.MsgId
                   : 'QCPFMSG'
                   : %Subst( ERRC0100.MsgDta: 1: ERRC0100.BytAvl - OFS_MSGDTA )
                   );

        EndSr;

      /End-Free

     **-- Send completion message:
     P SndCmpMsg       B
     D                 Pi            10i 0
     D  PxMsgDta                    512a   Const  Varying
     **
     D MsgKey          s              4a

      /Free

        SndPgmMsg( 'CPF9897'
                 : 'QCPFMSG   *LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*COMP'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );

        If  ERRC0100.BytAvl > *Zero;
          Return  -1;

        Else;
          Return  0;

        EndIf;

      /End-Free

     P SndCmpMsg       E
     **-- Send escape message:
     P SndEscMsg       B
     D                 Pi            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgF                       10a   Const
     D  PxMsgDta                    512a   Const  Varying
     **
     D MsgKey          s              4a

      /Free

        SndPgmMsg( PxMsgId
                 : PxMsgF + '*LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*ESCAPE'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );

        If  ERRC0100.BytAvl > *Zero;
          Return  -1;

        Else;
          Return   0;
        EndIf;

      /End-Free

     P SndEscMsg       E