|
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...
midrange.com
** 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 mailing list archive is Copyright 1997-2025 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.
