× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Hi JD,

On a hunch, I decided to do a little googling with your name and found a
posting I had missed in the past from 2001.  It included the source of
your working exit program:
http://archive.midrange.com/midrange-l/200103/msg00908.html

Hmmm... that's an older version of the one I'm using now. Here's an updated copy that might work better (or worse, who knows) than that one. I don't remember if the version I posted 5 years ago had bugs that I discovered later :)

Keep in mind that a lot of the code in this exit program is customized to work the way my company wants it. Your company may want theirs to act a little differently...

You'll also see the code herein that I used to test the auto-signon when the device name is 'SCOTT' and comes from IP address 192.168.5.71, it signs on as me, automatically...


      **         Telnet Device Initialization Exit Program
      **
      **   --------------------------------------------------------
      **                 This Program Was Written By
      **
      **            ///////        ///////        ////  ///
      **          ////           ////            //// ///
      **          //////        ////            //////
      **             ////      ////            //// ///
      **        ///////   //   ///////   //   ////   ///  //
      **
      **                M a r c h   5 t h ,   2 0 0 1
      **   ---------------------------------------------------------
      **
      **  CHG JMB 05-14-2003  Added RF13-15
      **  CHG SCK 01-09-2004  Added code to disconnect existing session
      **        if device name is same, and coming from same ip addr.
      **        (only activated for RF terms for now)
      **  CHG SCK 09-10-2006  Clean up code, convert to /FREE
      **
      **  This prorgram is run by OS/400 as an "exit program".   It
      **  is used to figure out which device names to assign to incoming
      **  TELNET clients.  (People connecting via TCP/IP)
      **
      **  To Compile:
      **     CRTBNDRPG ISOTELIR4 SRCFILE(xxx/QRPGLESRC) DBGVIEW(*LIST)
      **
      **  To Install:
      **       ** ONLY DO THIS IF ITS NOT ALREADY INSTALLED! **
      **       ** USE WRKREGINF TO FOR THIS EXITPNT TO SEE.  **
      **     ADDEXITPGM EXITPNT(QIBM_QTG_DEVINIT) FORMAT(INIT0100)
      **           PGMNBR(*LOW) PGM(xxx/ISOTELIR4)
      **
      **  WARNING:  Make sure that only trusted users have the ability
      **     to change/recompile this program!  A user with the ability
      **     to change this program can make it possible to log on as any
      **     other user without a password!
      **
     H OPTION(*SRCSTMT) DFTACTGRP(*NO) ACTGRP(*NEW) USRPRF(*OWNER)

      **
      **  This works like *ENTRY PLIST
      **
     D ISOTELIR4       PR                  ExtPgm('ISOTELIR4')
     D   peUser                            likeds(UserDescription_t)
     D   peDev                             likeds(DevDescription_t)
     D   peConn                            likeds(ConnDescription_t)
     D   peEnvOpt                 32767A   options(*varsize)
     D   peEnvLen                    10I 0
     D   peAllowConn                  1A
     D   peAutoSignOn                 1A
     D ISOTELIR4       PI
     D   peUser                            likeds(UserDescription_t)
     D   peDev                             likeds(DevDescription_t)
     D   peConn                            likeds(ConnDescription_t)
     D   peEnvOpt                 32767A   options(*varsize)
     D   peEnvLen                    10I 0
     D   peAllowConn                  1A
     D   peAutoSignOn                 1A

      ** API to convert binary IP address to "dotted"
     D AF_INET         C                   2
     D inet_ntoa       PR              *   ExtProc('inet_ntoa')
     D  ulong_addr                   10U 0 VALUE
     D inet_addr       PR            10U 0 ExtProc('inet_addr')
     D  dotted                         *   value options(*string)

      ** Execute Command API
     D QCMDEXC         PR                  ExtPgm('QCMDEXC')
     D   Command                  32702A   const options(*varsize)
     D   Length                      15P 5 const

      ** Check if device is active
     D IsActiveDevice  PR             1N
     D   peObject                    10A   const

      ** Kill active session
     D KillActive      PR
     D   peDevd                      10A   const
     D   peAddr                      15A   const

     D UserDescription_t...
     D                 ds                  qualified
     D                                     based(Template)
     D   Len                         10I 0
     D   Profile                     10A
     D   Curlib                      10A
     D   Program                     10A
     D   Menu                        10A

     D DevDescription_t...
     D                 ds                  qualified
     D                                     based(Template)
     D   Name                        10A
     D   Format                       8A
     D                                2A
     D   AttrOff                     10I 0
     D   AttrLen                     10I 0

     D ConnDescription_t...
     D                 ds                  qualified
     D                                     based(Template)
     D    Len                        10I 0
     D    Addr                       20A
     D    ValidPW                     1A
     D    WrkStnType                 12A
     D    SSLConn                     1A
     D    ServerIP                   20A
     D    ClientAuth                  1A
     D                                3A
     D    CrtRC                      10I 0
     D    CrtOff                     10I 0
     D    CrtLen                     10I 0

     D DispAttr        DS                  qualified
     D                                     based(p_DispAttr)
     D   KeyboardID                   3A
     D                                1A
     D   CodePage                    10I 0
     D   CharSet                     10I 0

     D IP              ds                  based(p_IP)
     D                                     qualified
     D    Len                         3I 0
     D    Family                      3I 0
     D    Port                        5U 0
     D    Addr                       10U 0

     D wkConnIP        S             16A
     D wkLowRF         s             10U 0
     D wkHighRF        s             10U 0
     D wkRFNo          s              2S 0
     D wkDevNo         s              4S 0

      /free

           // **************************************************
           //  Make sure the parameters have sane values.
           // **************************************************

           peAllowConn = *ON;
           peAutoSignOn = *OFF;

           if ( %parms < 7 );
               *inlr = *on;
               return;
           endif;

           if (peConn.Len < 24);
               *inlr = *on;
               return;
           endif;

           p_DispAttr = %addr(peDev) + peDev.AttrOff;
           p_IP       = %addr(peConn.Addr);

           if ( IP.Len < 8);
               *inlr = *on;
               return;
           endif;

           // FIXME: This should be upgraded to handle both
           //          IPv4 and IPv6.

           if ( IP.Family <> AF_INET );
               *inlr = *on;
               return;
           endif;


           // **************************************************
           //  If the 5250 emulator supports "auto-signon"
           //  it can submit the userid/password as variables
           //  during the connection process.
           //
           //  Notes:
           //  - This is for "auto-signon" only.  The normal
           //        green-screen signon screen has not yet
           //        been displayed to the user.
           //
           //  - peConn.ValidPW relates to whether i5/OS
           //        thinks the submitted password was valid
           //
           //  - Our company does not allow profiles that start
           //        with Q to auto-signon because all of the
           //        IBM profiles (QSYSOPR, QSECOFR, QUSER, etc)
           //        start with Q.
           //
           //   WARNING: When peAutoSignOn is *ON, the system
           //            does not validate the password! That
           //            means that anyone who can change this
           //            program to set peAutoSignOn to *ON
           //            can log on under any account he likes
           //            without a valid password!
           // **************************************************

           if ( peUser.Len>39 and peUser.Profile<>*blanks );

                if ( peConn.ValidPW='1' or peConn.ValidPW='2');
                     peAutoSignOn = *On;
                endif;

                if ( %subst(peUser.Profile:1:1) = 'Q' );
                     peAutoSignOn = *Off;
                endif;
            endif;


           // **************************************************
           //  Configure device names
           //
           //  - Mike (who uses IP 192.168.5.66) should always
           //      get device W6.
           //
           //  - RF terminals should be given the name RFnn
           //      if the same IP address is already connected,
           //      kill the previous connection.
           // **************************************************

           wkConnIP = %str(inet_ntoa(IP.Addr));
           wkLowRF  = inet_addr('192.168.5.193');
           wkHighRF = inet_addr('192.168.5.239');

           select;
           when ( wkConnIP = '192.168.5.66' );

              peDev.Name = 'W6';

           when ( IP.Addr>=wkLowRF  and IP.Addr<=wkHighRF );
              wkRFno = (IP.Addr - wkLowRF) + 1;
              peDev.Name = 'RF' + %char( (IP.Addr - wkLowRF) + 1 );
              KillActive( peDev.Name : wkConnIP );

           endsl;

           // **************************************************
           //  The Seagull JWalk clients that we use for the
           //  TrustedLink EDI/400 and Kronos software always
           //  use these attributes.
           //
           //  KLUDGE ALERT:  It's possible for ANY terminal
           //    to use these parameters.  If we buy one that
           //    does, we'll have to change the way we detect
           //    JWALK clients!
           // **************************************************

           if ( peDev.Name = *blanks
                   and DispAttr.KeyboardID = 'INB'
                   and DispAttr.CodePage = 500
                   and DispAttr.CharSet = 697
                   and peConn.WrkStnType = 'IBM-3477-FC' );

               peAllowConn = *off;

               for wkDevNo = 1 to 100;
                  peDev.Name = 'JWALK' + %editc(wkDevNo:'X');
                  if (not IsActiveDevice(peDev.Name));
                      peAllowConn = *on;
                      leave;
                  endif;
               endfor;
           endif;

           // **************************************************
           //   Safety Net:  If a device is already active
           //   with the given name, fall back to *blanks
           //   ( which results in a QPADEVxxxx name )
           // **************************************************
           if (peDev.Name <> *blanks);
              if (isActiveDevice(peDev.Name));
                   peDev.Name = *blanks;
              endif;
           endif;

           // **************************************************
           //   If a device named SCOTT logs on from Scott
           //   Klement's PC, automatically sign it on under
           //   the KLEMSCOT user profile
           // **************************************************

           if ( wkConnIP='192.168.5.71' and peDev.Name='SCOTT' );
               peUser.Profile = 'KLEMSCOT';
               peAutoSignOn = *ON;
           endif;

           *inlr = *on;
           return;

      /end-free

      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      *  Check to see if a device name is available for us to use.
      *  Usually, if its unavailable its because the device is already
      *  in use (thus the procedure name)
      *
      *  Note that if an error occurs, we will return *OFF (device not
      *  active).   This will, essentially, cause the device to fall
      *  back to a QPADEVxxxx device name, thanks to the "Safety Net"
      *  coded above.
      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P IsActiveDevice  B
     D IsActiveDevice  PI             1N
     D   peObject                    10A   const

      ** Create User Space API
     D QUSCRTUS        PR                  ExtPgm('QUSCRTUS')
     D   UsrSpc                      20A   CONST
     D   ExtAttr                     10A   CONST
     D   InitialSize                 10I 0 CONST
     D   InitialVal                   1A   CONST
     D   PublicAuth                  10A   CONST
     D   Text                        50A   CONST
     D   Replace                     10A   CONST
     D   ErrorCode                32767A   options(*varsize)

      ** Retrieve Pointer to User Space API
     D QUSPTRUS        PR                  ExtPgm('QUSPTRUS')
     D   peUsrSpc                    20A   CONST
     D   pePointer                     *

      ** API Error Code Structure
     D ErrorCode       DS                  qualified
     D  BytesProv                    10I 0 INZ(%size(ErrorCode))
     D  BytesAvail                   10I 0 INZ(0)

      ** List Configuration Descriptions API
     D QDCLCFGD        PR                  ExtPgm('QDCLCFGD')
     D   QualUsrSpc                  20A   const
     D   Format                       8A   const
     D   CfgDescType                 10A   const
     D   ObjQualif                   40A   const
     D   StatQualif                  20A   const
     D   ErrorCode                32767A   options(*varsize)

      ** (Generic) Structure for API List Headers
     D ListHdr         DS                   BASED(p_ListHdr)
     D                                      qualified
     D   Offset                      10I 0 overlay(ListHdr:125)
     D   Count                       10I 0 overlay(ListHdr:133)
     D   Size                        10I 0 overlay(ListHdr:137)

      ** List Entries for List Cfg Desc API
     D dsCfg           DS                  based(p_Cfg)
     D                                     qualified
     D   Status                      10I 0
     D   Name                        10A
     D   Category                    10A
     D   HRStat                      20A
     D   Text                        50A
     D   Job                         10A
     d   User                        10A
     d   JobNbr                       6A
     D   Passthru                    10A
     D   APIFmt                       8A
     D   CmdSuf                       4A

     D wwEntry         S             10I 0
     D MY_USRSPC       C                   'ISOTELIR4 QTEMP'

      /free
           // **************************************************
           //   Create a 16k user space in QTEMP
           // **************************************************

           QUSCRTUS( MY_USRSPC
                   : 'ISOTELIR4'
                   : 16 * 1024
                   : x'00'
                   : '*ALL'
                   : *blanks
                   : '*YES'
                   : ErrorCode );

           if (ErrorCode.BytesAvail > 0);
               return *OFF;
           endif;

           // **************************************************
           //   List the configuration description to the
           //   user space
           // **************************************************

           QDCLCFGD( MY_USRSPC
                   : 'CFGD0200'
                   : '*DEVD'
                   : peObject
                   : '*GE       *VARYOFF'
                   : ErrorCode );

           if (ErrorCode.BytesAvail > 0);
               return *OFF;
           endif;

           // **************************************************
           //  Make sure we found some existing devices
           // **************************************************

           QUSPTRUS('ISOTELIR4 QTEMP': p_ListHdr );

           if (ListHdr.Count < 1);
               return  *OFF;
           endif;

           ListHdr.Count = ListHdr.Count - 1;


           // **************************************************
           //   Search the list for the given device
           // **************************************************

           for wwEntry = 0 to ListHdr.Count;

               p_Cfg = p_ListHdr + ListHdr.Offset
                     + (wwEntry * ListHdr.Size);

               if ( dsCfg.Name = peObject );

                     //  Status:  0 = Varied Off
                     //          20 = Vary On Pending
                     //          30 = Varied On

                     if ( dsCfg.Status <> 0
                            and dsCfg.Status <> 20
                            and dsCfg.Status <> 30
                            and dsCfg.Job    <> *blanks );
                          return *ON;
                     else;
                          return *OFF;
                     endif;

               endif;

           endfor;

           return *OFF;
      /end-free
     P                 E


      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      *  This checks to see if there's already an active terminal with
      *  the same name from the same IP address.
      *
      *  If there is, it kills the existing terminal so that the new
      *  session can use it's device name.
      *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     P KillActive      B
     D KillActive      PI
     D   peDevd                      10A   const
     D   peAddr                      15A   const

      ** Retrieve Device Info API:
     D QDCRDEVD        PR                  ExtPgm('QDCRDEVD')
     D  RcvVar                    32767A   options(*varsize)
     D  RcvVarLen                    10I 0 const
     D  Format                        8A   const
     D  Device                       10A   const
     D  ErrorCode                 32767A   options(*varsize)

      ** API Error Code Structure
     D ErrorCode       DS                  qualified
     D  BytesProv                    10I 0 INZ(%size(ErrorCode))
     D  BytesAvail                   10I 0 INZ(0)

     D dsDev           ds           937    qualified
     D                              859A
     D   Port                         5U 0
     D   Addr                        10U 0
     D                               12A
     D   Dotted                      15A
     D   JobName                     10A
     D   User                        10A
     D   JobNbr                       6A

     D wwCmd           s            200A   varying
      /free

         if  IsActiveDevice( peDevd ) = *OFF;
            return;
         endif;

         QDCRDEVD( dsDev
                 : %size(dsDev)
                 : 'DEVD0600'
                 : peDevd
                 : ErrorCode );

         if (ErrorCode.BytesAvail > 0);
             return;
         endif;

         if ( peAddr = dsDev.Dotted );

              wwCmd = 'ENDTCPCNN PROTOCOL(*TCP) '
                    +    'LCLINTNETA(''192.168.5.4'') '
                    +    'LCLPORT(23) '
                    +    'RMTINTNETA(''' + %trim(dsDev.dotted) + ''') '
                    +    'RMTPORT(' + %char(dsDev.Port) + ')';

              monitor;
                 QCMDEXC( wwCmd: %len(wwCmd) );
              on-error;
                 return;
              endmon;

         endif;

         wwCmd = 'DLYJOB DLY(1)';
         QCMDEXC(wwCmd: %len(wwCmd));
         return;

      /end-free
     P                 E


As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:
Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.