|
On Mon, 19 Mar 2001, Emanuele Salvador wrote: > Thanks to all for answers. > The telnet session are started by Telxon PTC radio-devices, and > request a mere tn5250 emulation on DOS. > The problem resides in some users who tends to create too much new > sessions on the fly. > I'd like to have better control over them, but still need some > QPADEVs free for the PTCs. > I thought there was some way, based on IP or MAC address, to assign a > name to PTC sessions. > > Thanks again, > Emanuele Salvador > > For my Telxon PTC-960SL terminals, I'm using a "telnet device initialization exit program" to assign names to the devices. This is a program that runs on the AS/400 when the PTC connects, and assigns a device name, etc. Here's a link to the relevant online manual: http://publib.boulder.ibm.com:80/cgi-bin/bookmgr/BOOKS/qb3anl03/E.5.1 Here's my program (written in RPG IV at V4R5) in case that's useful to you: ** Telnet Device Initialization Exit Program ** ** 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(LIBSOR/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(LIBRARY/ISOTELIR4) ** H OPTION(*SRCSTMT) DFTACTGRP(*NO) ACTGRP(*NEW) ** This IBM-supplied proc converts an IP address to the ** "dotted octet" format (192.168.5.1 is dotted octet) D inet_ntoa PR * ExtProc('inet_ntoa') D ulong_addr 10U 0 VALUE ** This program executes a CL command D Cmd PR ExtPgm('QCMDEXC') D Command 200A const D Length 15P 5 const ** Local sub-procedure to determine if a device is available ** for us to use. (i.e. Is the device already in use?) D IsActiveDevice PR 1N D peObject 10A const ** Parameters D peUserDscInfo S 1A D peDevDscInfo S 1A D peCnnDscInfo S 1A D peEnvOpt S 1A D peEnvOptLen S 10I 0 D peAllowConn S 1A D peAutoSignOn S 1A ** Local (module-level) variables D wkConnIP S 16A ** User Description Info Structure D p_UserDscInfo S * inz(*NULL) D dsUserDscInfo DS based(p_UserDscInfo) D dsUserLen 10I 0 D dsUserProfile 10A D dsUserCurLib 10A D dsUserProgram 10A D dsUserMenu 10A ** Device Description Info Structure D p_DevDscInfo S * inz(*NULL) D dsDevDscInfo DS based(p_DevDscInfo) D dsDevName 10A D dsDevFormat 8A D dsDevReserved 2A D dsDevAttrOff 10I 0 D dsDevAttrLen 10I 0 ** Display Device Description Information Structure ** (fields specific to displays as opposed to printers) D p_DDDI S * inz(*NULL) D dsDDDI DS based(p_DDDI) D dsDDDIkbid 3A D dsDDDIreserv 1A D dsDDDIcodepg 10I 0 D dsDDDIchrset 10I 0 ** Connection Description Info structure D p_CnnDscInfo S * inz(*NULL) D dsCnnDscInfo DS based(p_CnnDscInfo) D dsCnnLen 10I 0 D dsCnnAddr 20A D dsCnnPWvalid 1A D dsCnnWStype 12A ** Internet Protocol (IP) address structure D p_Addr S * D dsAddr DS based(p_Addr) D dsAddrLen 3I 0 D dsAddrFamily 3I 0 D dsAddrPort 5U 0 D dsAddrIP 10U 0 c *entry plist c parm peUserDscInfo c parm peDevDscInfo c parm peCnnDscInfo c parm peEnvOpt c parm peEnvOptLen c parm peAllowConn c parm peAutoSignOn c eval p_UserDscInfo = %addr(peUserDscInfo) c eval p_DevDscInfo = %addr(peDevDscInfo) c eval p_CnnDscInfo = %addr(peCnnDscInfo) C* If less than 24 bytes were passed, abort before we do any damage c if dsCnnLen < 24 c callp(E) Cmd('SNDMSG MSG(''ISOTELIR4: Not enough'+ c ' connection information!'')' + c ' TOUSR(KLEMSCOT)':200) c eval *inlr = *on c return c endif C* Display Info & IP Addr structures depend upon info found in C* the Device Desc and Conn Desc structures. Set them based C* on the passed values. c eval p_DDDI = p_DevDscInfo + dsDevAttrOff c eval p_Addr = %addr(dsCnnAddr) C* Abort program if IP address info is weird or not there. c if dsAddrLen < 8 c callp(E) Cmd('SNDMSG MSG(''Address is only ' + c %trim(%editc(dsAddrLen:'N')) + c ' bytes long!'') TOUSR(KLEMSCOT)':200) c eval *inlr = *on c return c endif c if dsAddrFamily <> 2 c callp(E) Cmd('SNDMSG MSG(''Address is not ' + c 'in IP v4 format!'') TOUSR(KLEMSCOT)': c 200) c eval *inlr = *on c return c endif C* Get IP address in dotted-decimal format c eval wkConnIP = %str(inet_ntoa(dsAddrIP)) C* This fancy code will assign the first session from Scott's PC C* at home to 'W3', the 2nd to 'W7', the 3rd to 'A5' and the C* remainder to QPADEVxxxx C* C* This is mainly here for example code. (manually forcing the C* device name to be set is pointless w/RUMBA 2000, Linux tn5250, C* newer versions of Client Access, etc) c if wkConnIP = '192.168.0.1' c eval dsDevName = 'W3' c if IsActiveDevice(dsDevName) c eval dsDevName = 'W7' c if IsActiveDevice(dsDevName) c eval dsDevName = 'A5' c endif c endif c endif C* Assign device names for Misc IP addresses. C* (Also see "Safety Net" below) c select C* MMM's PC c when wkConnIP = '192.168.5.66' c eval dsDevName = 'W6' C* RF Terminals c when wkConnIP = '192.168.5.193' c eval dsDevName = 'RF1' c when wkConnIP = '192.168.5.194' c eval dsDevName = 'RF2' c when wkConnIP = '192.168.5.195' c eval dsDevName = 'RF3' c when wkConnIP = '192.168.5.196' c eval dsDevName = 'RF4' c when wkConnIP = '192.168.5.197' c eval dsDevName = 'RF5' c when wkConnIP = '192.168.5.198' c eval dsDevName = 'RF6' c when wkConnIP = '192.168.5.199' c eval dsDevName = 'RF7' c when wkConnIP = '192.168.5.200' c eval dsDevName = 'RF8' c when wkConnIP = '192.168.5.201' c eval dsDevName = 'RF9' c when wkConnIP = '192.168.5.202' c eval dsDevName = 'RF10' c endsl C* This is a "Safety Net". If our device name is C* active (or unavailable) fall back to QPADEVxxxx by setting the C* device name to *blanks c if dsDevName <> *blanks c if IsActiveDevice(dsDevName) c eval dsDevName = *blanks c endif c endif c eval *inlr = *on c return P*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ P* Check to see if a device name is available for us to use. P* Usually, if its unavailable its because the device is already P* in use (thus the procedure name) P* P* Note that if an error occurs, we will return *OFF (device not P* active). This will, essentially, cause the device to fall P* back to a QPADEVxxxx device name, thanks to the "Safety Net" P* coded above. P*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ P IsActiveDevice B D IsActiveDevice PI 1N D peObject 10A const ** Create User Space API D CrtUsrSpc PR ExtPgm('QUSCRTUS') D peUsrSpc 20A CONST D peExtAtr 10A CONST D peInitSiz 10I 0 CONST D peInitVal 1A CONST D pePubAuth 10A CONST D peText 50A CONST D peReplace 10A CONST D peErrors 256A ** Retrieve Pointer to User Space API D RtvPtrUS PR ExtPgm('QUSPTRUS') D peUsrSpc 20A CONST D pePointer * ** API Error Code Structure D dsEC DS D dsECBytesP 1 4I 0 INZ(256) D dsECBytesA 5 8I 0 INZ(0) D dsECMsgID 9 15 D dsECReserv 16 16 D dsECMsgDta 17 256 ** List Configuration Descriptions API D ListCfgDesc 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 256A ** (Generic) Structure for API List Headers D p_UsrSpc S * D dsLH DS BASED(p_UsrSpc) D* Filler D dsLHFill1 103A D* Status (I=Incomplete,C=Complete D* F=Partially Complete) D dsLHStatus 1A D* Filler D dsLHFill2 12A D* Header Offset D dsLHHdrOff 10I 0 D* Header Size D dsLHHdrSiz 10I 0 D* List Offset D dsLHLstOff 10I 0 D* List Size D dsLHLstSiz 10I 0 D* Count of Entries in List D dsLHEntCnt 10I 0 D* Size of a single entry D dsLHEntSiz 10I 0 ** List Entries for List Cfg Desc API D p_Cfg S * D dsCfg DS based(p_Cfg) D dsCfgStatus 10I 0 D dsCfgName 10A D dsCfgCatg 10A D dsCfgHRStat 20A D dsCfgText 50A D dsCfgJob 10A d dsCfgUser 10A d dsCfgNbr 6A D dsCfgPasThr 10A D dsCfgAPIFmt 8A D dsCfgCmdSuf 4A ** Local (procedure-level) variables D wwEntry S 10I 0 C* create a user space & get a pointer to it c callp CrtUsrSpc('ISOTELIR4 QTEMP':'USRSPC': c 16*1024: x'00':'*ALL': *blanks: c '*YES': dsEC) c if dsECBytesA > 0 c return *OFF c endif c callp RtvPtrUS('ISOTELIR4 QTEMP': p_UsrSpc) C* dump config descriptions into this user space c callp ListCfgDesc('ISOTELIR4 QTEMP': c 'CFGD0200': '*DEVD': peObject: c '*GE *VARYOFF': dsEC) c if dsECBytesA > 0 c return *OFF c endif c if dsLHEntCnt < 1 c return *OFF c endif C* Find our description in the user space if C* its in there... c do dsLHEntCnt wwEntry c eval p_Cfg = p_UsrSpc + dsLHLstOff + c ((wwEntry-1)*dsLHEntSiz) c if dsCfgName = peObject c if (dsCfgStatus<>20 and dsCfgStatus<>30 c and dsCfgStatus<>0) c or dsCfgJob <> *blanks c return *ON c leave c else c return *OFF c leave c endif c endif c enddo c return *OFF P E +--- | This is the Midrange System Mailing List! | To submit a new message, send your mail to MIDRANGE-L@midrange.com. | To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com. | To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: david@midrange.com +---
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.
midrange.com
