z/OS 1.4 Telnet LU Selection Exit

The communications Server for z/OS 1.4 includes a number of improvements to the TN3270 server. The changes include an exit that provides extra flexibility in selecting LU names for connecting clients.

My site has been using the mainframe telnet for a while and I am generally happy with the LU selection process, particularly after LU pooling was added. One feature that was missing however, was the ability to restrict a client to a fixed number of sessions. Allowing users to inadvertently start many sessions can use all the LUs in a pool and prevent other users from connecting. I therefore decided to investigate if the new exit could solve this problem.

The first thing to note about the exit is that it is not one global exit that serves all LUGROUPs, but a separate exit for each LUROUP. The exit name being the LUGROUP name.

For example:

    LUGROUP LUG01,EXIT ENDLUGROUP

This parameter defines an LUGROUP named LUG01. The exit keyword indicates that the LUGROUP is not a normal pool but an exit that is called whenever the selection process selects this LUGROUP for a client connection. In this example, no LUs are defined for the LUGROUP. LUs can be added to the command as for a normal LUGROUP:

    LUGROUP LUG02,EXIT LUG001..LUG010 ENDLUGROUP

The terminals LUG001 through LUG010 are not used in the selection process. They are passed to the exit, however, and can serve as seeds for terminal names, for example. As for the normal LUGROUP statement a range of LUs can be passed or one or more single LU name can be passed.

While allowing multiple exits might seem to add great flexibility, I believe this implementation is flawed. I would much prefer to have a single exit and have the LUGROUP name passed as one of the parameters - when writing system exits, less is more.

Input to Exit

The input to the exit is a function code in register 0 and a parameter list address in register 1. The manuals document only four functions but a fifth was added by PQ70887. The full list is:

        01 - Assign LU
        02 - Unassign LU
        03 - Inact LU
        04 - Act LU
        05 - LU in use

Function 05 is used to indicate that the LU selected is already in use and a different name should be selected. To prevent a selection loop, a flag is set in the parameter list when no more chances to select are allowed.

The parameter list contains a number of items that identify the server and client. The list also includes a pointer to a data structure describing the LU names present on the LUGROUP statement, if any. IBM does not ship a DSECT for the parameter list but my effort follows:

     TXPARAM  DSECT  
     TXLUNAME DS    CL8                LU Name  
     TXFLAGS  DS    CL4                Flags  
     TXPRINT  EQU   X'80'                 80 .... LU is a Printer  
     TXLAST   EQU   X'40'                 40 .... Last Chance  
     TXIPV6   EQU   X'20'                 20 .... IPV6 Connection  
     TXCLIP   DS    CL16               Client IP Address  
     TXCLPORT DS    CL4                Client Port Number  
     TXDSIP   DS    CL16               Destination IP Address  
     TXDSPORT DS    CL4                Destination Port  
     TXLINKNM DS    CL16               Link Name  
     TXCRTUSR DS    CL8                Userid from client certificate  
     TXHOSTPT DS    CL4                -> Hostname structure  
     TXNETID  DS    CL8                Application Netid  
     TXAPPL   DS    CL8                Application Name  
     TXLOGUSR DS    CL8                Userid from logon panel  
     TXGRPPT  DS    CL4                -> LU Group Structure  

There are a couple of points of interest here. First, IP addresses are passed in 16 byte long fields. For IPv4 addresses they are passed in hex in the last four bytes of the sixteen. The flags field is not documented in the current manuals. The Last Chance flag is used with function 05 to indicate that no more selection chances are available. The IPV6 flag indicates that the connection is from an IPv6 client - this does not appear to have been implemented yet, but is obviously on the way.

Problems with the exit

There are, in my opinion, a number of problems with the way IBM has implemented the exit:

Sample Exit

The best way to get started with this exit is to examine a sample. Unfortunately, IBM has not provided one. So, here is my first attempt.

This is a table driven exit that derives the LU names from the IP address of the client and/or the sequence number of the LU in the pool. When possible an LU is reused by the same client if it reconnects. The number of sessions a client can create can be restricted.

You can also download the source code. The usual restrictions apply to this code - use at your own risk !

*---------------------------------------------------------------------*
* z/OS Telnet LU Group Exit                                           *
* -------------------------                                           *
*                                                                     *
*   This exit is called when a client connects to the z/OS telnet     *
*   server and the LUGROUP is mapped to an exit. The function of      *
*   the exit is to return the LU name that is to be used for the      *
*   session.                                                          *
*                                                                     *
*   On Entry:   R0  - Function Code: 01 - Assign LU                   *
*                                    02 - Unassign LU                 *
*                                    03 - Inact LU                    *
*                                    04 - Act LU                      *
*                                    05 - LU Name in use              *
*                                                                     *
*               R1  - Address of parameter list                       *
*                                                                     *
*               R13 - Address of 72 byte save area                    *
*                                                                     *
*               R14 - Return Address                                  *
*                                                                     *
*               R15 - Address of entry point of routine               *
*                                                                     *
*   Entry to the exit is serialized by telnet. This routine need      *
*   not be reentrant.                                                 *
*                                                                     *
*   Function:  This exit is used to create LU names based on the IP   *
*              address of the client that is connecting. The LU name  *
*              is built from a template which includes special        *
*              characters that are substituted by parts of the IP     *
*              address or the LU sequence number.                     *
*                                                                     *
*              In addition, clients can be prevented from starting    *
*              more than a defined number of sessions.                *
*                                                                     *
* Author: Nigel Thomas - Royal Oman Police - April 2003               *
*---------------------------------------------------------------------*
* Maintenence Log                                                     *
*                                                                     *
* 10/05/2003 - Fixed to correctly return RC=8                         *
*---------------------------------------------------------------------*
TNEXIT   CSECT
TNEXIT   RMODE ANY
TNEXIT   AMODE 31
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
MAXLU    EQU   2000                 Maximum size of LU table
         SPACE
         STM   R14,R12,12(R13)
         LR    R12,R15
         USING TNEXIT,R12
         LR    R11,R1
         USING TXPARAM,R11
         LR    R3,R0                Save Function Code
         SPACE
*---------------------------------------------------------------------*
* Check if this is the first call, if so we need to do some stuff     *
*---------------------------------------------------------------------*
         SPACE
         CLI   FIRSTIN,C'Y'         Is this the first call ?
         BNE   MAINLINE             No, skip
         SPACE
         MVI   FIRSTIN,C'N'         Set first time flag off
         LA    R4,MAPCON            -> Map tab constants
         ST    R4,MAPTAB            Tuck away
         SPACE
*---------------------------------------------------------------------*
* Get the storage for the LU Table                                    *
*---------------------------------------------------------------------*
         SPACE
         LA    R2,MAXLU             Get Maximum LU Count
         MH    R2,=AL2(LUENTRYL)    Get Length Required
         STORAGE OBTAIN,LENGTH=(R2),ADDR=(R4),LOC=31
         ST    R4,LUTAB             Store LU Table address
         ST    R4,LUFREE            Store LU Free Address
         MVI   0(R4),X'FF'          Mark the end of table
         LA    R4,0(R4,R2)          -> end of LU Table
         ST    R4,LULAST            Save
MAINLINE DS    0H
*---------------------------------------------------------------------*
* Check the function code and branch to the appropriate routine       *
*---------------------------------------------------------------------*
         SPACE
         C     R3,=F'1'             Is the function too Low ?
         BL    EXIT8                Yes, throw out
         C     R3,=F'5'             Is the function too high ?
         BH    EXIT8                Yes, throw out
         BCTR  R3,0                 Down by one
         SLL   R3,2                 Times 4
         B     GOFUNC(R3)
GOFUNC   DS    0H
         B     ASSIGN               01 - Assign an LU
         B     RELEASE              02 - Un-Assign an LU
         B     INACT                03 - Inactivate an LU
         B     ACTIVATE             04 - Activate an LU
         B     INUSE                05 - LU inuse
         EJECT
ASSIGN   DS    0H
*---------------------------------------------------------------------*
* Assign an LU name to a client                                       *
*---------------------------------------------------------------------*
         SPACE
*---------------------------------------------------------------------*
* Sanity check - Make sure address is IPV4                            *
*---------------------------------------------------------------------*
         TM    TXFLAGS,TXIPV6       IPV6 Address passed ?
         BO    EXIT8                Yes, not in my house John !
         SPACE
*---------------------------------------------------------------------*
* Find the map entry for this request                                 *
*---------------------------------------------------------------------*
         SPACE
         MVC   IPADDR,TXCLIP+12     Isolate IPV4 address
         L     R5,MAPTAB            -> IP Mapping table
         USING MAPENTRY,R5
GETMAP   DS    0H
         CLI   MAPIP,X'FF'          End of map table ?
         BE    EXIT8                Yes can't help then
         L     R6,IPADDR            Get Client IP Address
         N     R6,MAPMASK           Mask out the wild cards
         C     R6,MAPIP             Do we have a match ?
         BE    GOTMAP               Yes, go process
         LA    R5,MAPENTL(,R5)      -> Next Map entry
         B     GETMAP               Keep Looking
         SPACE
GOTMAP   DS    0H
*---------------------------------------------------------------------*
* Count how many LU sessions the client has already                   *
*---------------------------------------------------------------------*
         SPACE
         BAL   R9,COUNTIP           Go count LU's for this guy
         C     R6,MAPSESSN          Already at Max Session count ?
         BE    EXIT8                Yes, fail request
*---------------------------------------------------------------------*
* Allocate an LU to the new session based on the MAP entry            *
*---------------------------------------------------------------------*
         SPACE
         LTR   R4,R7                Is there an old entry we can use ?
         BZ    ADDLU                No, we must create a new entry
         SPACE
         USING LUENTRY,R4
         MVC   TXLUNAME,LUNAME      Move LU name from Table entry
         MVI   LUSTATUS,LUINUSE     Mark entry in use
         B     EXIT0                Make a clean getaway
         SPACE
ADDLU    DS    0H
         L     R6,MAPHIGH           Get Current number in pool
         C     R6,MAPMAX            Already at maximum ?
         BNL   FINDFREE             Yes, find a free entry
         SPACE
*---------------------------------------------------------------------*
* Add a new LU entry to the table                                     *
*---------------------------------------------------------------------*
         SPACE
         LA    R6,1(,R6)            Bump by one
         ST    R6,MAPHIGH           Save new high count
         L     R4,LUFREE            -> Free Lu slot
         MVC   LUNAME,MAPTEMP       Move in template name
         MVC   LUADDR,IPADDR        Move in IP Address
         MVI   LUSTATUS,LUINUSE     Mark as in use
         ST    R6,LUNUM             Put sequence number in LU entry
         ST    R5,LUMAP             Save address of map entry
         LA    R7,LUENTRYL(,R4)     -> New free entry
         C     R7,LULAST            Have we run out of LU entries ?
         BNL   EXIT8                Yes, can't add any more
         ST    R7,LUFREE            Save away
         MVI   0(R7),X'FF'          Mark as last entry
         SPACE
         BAL   R9,BUILDLU           Go Build LU name from template
         SPACE
         MVC   TXLUNAME,LUNAME      Move name to parameter list
         B     EXIT0                All done
         SPACE
*---------------------------------------------------------------------*
* The pool is full. We will search for an available entry in this     *
* pool and steal it for our client.                                   *
*---------------------------------------------------------------------*
FINDFREE DS    0H
         L     R4,LUTAB             -> LU Table
FIND1    DS    0H
         CLI   LUNAME,X'FF'         End of table ?
         BE    EXIT8                Yes, ooops - can't help
         C     R5,LUMAP             Is this entry for our pool ?
         BNE   FIND2                No, Search on
         TM    LUSTATUS,LUINACT     Is LU marked inactive ?
         BO    FIND2                Yes, can't use
         TM    LUSTATUS,LUINUSE     Is LU in use ?
         BO    FIND2                Yes, Can't use either
         SPACE
         MVC   LUADDR,IPADDR        Steal this one
         MVC   LUNAME,MAPTEMP       Move in LU name template
         MVI   LUSTATUS,LUINUSE     Mark as in use
         L     R6,LUNUM             Get LU Sequence Number
*---------------------------------------------------------------------*
* Build the new name for the LU entry we just stole.                  *
*---------------------------------------------------------------------*
         BAL   R9,BUILDLU           Go Build LU name from template
         MVC   TXLUNAME,LUNAME      Move name to parameter list
         B     EXIT0                exit
         SPACE
FIND2    DS    0H
         LA    R4,LUENTRYL(,R4)     -> Next LU Entry
         B     FIND1                Keep Searching
         DROP  R4
         EJECT
*---------------------------------------------------------------------*
* Un-Assign an LU name from a client                                  *
*---------------------------------------------------------------------*
RELEASE  DS    0H
         BAL   R9,FINDLU            Find LU in table
         LTR   R4,R4                Was it found ?
         BZ    EXIT0                no, return
         USING LUENTRY,R4
         MVI   LUSTATUS,X'00'       Mark as Free and Active
         B     EXIT0                Go back
         DROP  R4
         EJECT
*---------------------------------------------------------------------*
* An LU has been inactivated                                          *
*---------------------------------------------------------------------*
INACT    DS    0H
         BAL   R9,FINDLU            Find LU in table
         LTR   R4,R4                Was it found ?
         BZ    EXIT0                no, return
         USING LUENTRY,R4
         MVI   LUSTATUS,LUINACT     Mark as Inactive
         B     EXIT0                Go back
         DROP  R4
         EJECT
*---------------------------------------------------------------------*
* An LU has been activated.                                           *
*---------------------------------------------------------------------*
ACTIVATE DS    0H
         BAL   R9,FINDLU            Find LU in table
         LTR   R4,R4                Was it found ?
         BZ    EXIT0                no, return
         USING LUENTRY,R4
         MVI   LUSTATUS,X'00'       Mark as Free and Active
         B     EXIT0                Go back
         DROP  R4
         EJECT
*---------------------------------------------------------------------*
* An LU request has been rejected because the LU is inuse.            *
*   This should not happen, but, hey ho. We will mark the LU as       *
*   inactive and try to allocate a different LU name                  *
*---------------------------------------------------------------------*
INUSE    DS    0H
         BAL   R9,FINDLU            Find LU in table
         LTR   R4,R4                Was it found ?
         BZ    EXIT0                no, return (Should not happen)
         USING LUENTRY,R4
         MVI   LUSTATUS,LUINACT     Mark as Inactice
         TM    TXFLAGS,TXLAST       Have I missed the boat ?
         BNO   ASSIGN               No, try to assign another LU
         B     EXIT0                Go back, no more we can do
         DROP  R4
         EJECT
EXIT0    DS    0H
         SR    R15,R15              Zero return Code
         B     RETURN
EXIT8    DS    0H
         LA    R15,8                Set RC to 8
RETURN   DS    0H
         L     R14,12(R13)          Get return address
         LM    R0,R12,20(R13)       Restore R0 to R12
         BR    R14                  Go from whence we came
         EJECT
COUNTIP  DS    0H
*---------------------------------------------------------------------*
* Count how many telnet sessions an IP address currently has. At the  *
* same time, make a note of any free LU's for the same address.       *
*   On exit: R6 - count of lus in use                                 *
*            R7 - Address of free LU for this IP                      *
*---------------------------------------------------------------------*
         SPACE
         SR    R6,R6                Zero Count
         SR    R7,R7                Zero Count
         L     R4,LUTAB             -> LU Table
         USING LUENTRY,R4
IPCOUNT1 DS    0H
         CLI   LUNAME,X'FF'         End of table ?
         BER   R9                   Yes, return to caller
         CLC   LUADDR,IPADDR        Is this LU for our client ?
         BNE   IPCOUNT3             No, skip it
         TM    LUSTATUS,LUINUSE     Is this LU in use ?
         BNO   IPCOUNT2             No, don't count it
         LA    R6,1(,R6)            Yes, bump count by one
         B     IPCOUNT3             Bump on
IPCOUNT2 DS    0H
         TM    LUSTATUS,LUINACT     Is LU Inactive ?
         BO    IPCOUNT3             Yes, don't reuse it
         LTR   R7,R7                Have we saved an LU already ?
         BNZ   IPCOUNT3             Yes, keep the one we have
         LR    R7,R4                No, tuck entry away
IPCOUNT3 DS    0H
         LA    R4,LUENTRYL(,R4)     -> Next entry
         B     IPCOUNT1             Keep on counting
         DROP  R4
         EJECT
FINDLU   DS    0H
*---------------------------------------------------------------------*
* Find the LU table entry for the LU name in the exit parameter list. *
*   On exit: R4 - Address of LU entry or zero                         *
*---------------------------------------------------------------------*
         SPACE
         SR    R4,R4                Zero LU Address
         L     R4,LUTAB             -> LU Table
         USING LUENTRY,R4
FINDLU1  DS    0H
         CLI   LUNAME,X'FF'         End of table ?
         BNE   FINDLU2              Yes, go back
         SR    R4,R4                Clear LU address
         BR    R9                   Return to caller
FINDLU2  DS    0H
         CLC   LUNAME,TXLUNAME      Match on LU name ?
         BER   R9                   Yes, go back with Addr in R4
         SPACE
         LA    R4,LUENTRYL(,R4)     -> Next LU table entry
         B     FINDLU1              Keep Looking
         EJECT
*---------------------------------------------------------------------*
* Buildlu: This routine builds the LU name from the LU template using *
*          the IP address and/or the LU sequence number.              *
*                                                                     *
*          Input: R4 - LU Entry                                       *
*                 R5 - Map Entry Address                              *
*                 R6 - Sequence Number                                *
*                 R9 - Return Address                                 *
*                                                                     *
*          The template can contain a number of mask characters:      *
*                                                                     *
*              'N' - Replace with Sequence number                     *
*              'X' - Replace with 2nd octet of IP                     *
*              'Y' - Replace with 3rd octet of IP                     *
*              'Z' - Replace with 4th octet of IP                     *
*                                                                     *
*          Any other character is left un-modified.                   *
*                                                                     *
*          For example a template could be : 'TXXYYZZZ'               *
*                                                                     *
*---------------------------------------------------------------------*
BUILDLU  DS    0H
         USING LUENTRY,R4
         LA    R2,0                 R2 is item to move
         LA    R1,MASKTAB           -> Mask Character
         SPACE
BUILD1   DS    0H
         LR    R7,R2                Get item Index
         SLL   R7,2                 Times four
         B     BUILD2(R7)
BUILD2   DS    0H
         B     BUILD6               Sequence Number
         B     BUILD3               2nd IP Octet
         B     BUILD4               3rd IP Octet
         B     BUILD5               4th IP Octet
         SPACE
BUILD3   DS    0H
         SR    R6,R6
         IC    R6,IPADDR+1          Get 2nd Octet
         B     BUILD6
         SPACE
BUILD4   DS    0H
         SR    R6,R6
         IC    R6,IPADDR+2          Get 3rd Octet
         B     BUILD6
         SPACE
BUILD5   DS    0H
         SR    R6,R6
         IC    R6,IPADDR+3          Get 4th Octet
         B     BUILD6
         SPACE
BUILD6   DS    0H
         CVD   R6,PWK               Convert LU number to decimal
         UNPK  PSTR,PWK+4(4)        Make Printable
         OI    PSTR+7,X'F0'         Correct the sign
*---------------------------------------------------------------------*
* Replace all the mask characters in the template with the number     *
*---------------------------------------------------------------------*
         SPACE
         LA    R7,PSTR+7            -> last digit to move
         LA    R8,LUNAME+7          -> First posn to move to
         LA    R10,8                Maximum of eight positions
BUILD7   DS    0H
         CLC   0(1,R8),0(R1)        Is this the mask character ?
         BNE   BUILD8               no, Skip back a position
         MVC   0(1,R8),0(R7)        Move in Digit
         BCTR  R7,0                 -> Previous byte to move
BUILD8   DS    0H
         BCTR  R8,0                 -> Previous position in LU
         BCT   R10,BUILD7           Keep on moving
         SPACE
         C     R2,=F'3'             Last Mask to move ?
         BER   R9                   Yes, return to caller
         LA    R2,1(,R2)            Update mask index
         LA    R1,1(,R1)            -> Next mask character
         B     BUILD1               Go process next mask index
         DROP  R4
         EJECT
*
* Variables
*
         DC    C'Variable start here---->'
PWK      DS    D                    Working Storage
PSTR     DS    CL8                  Working Storage
MAPTAB   DS    A                    Address of IP to Template table
LUTAB    DS    A                    Address of LU Name table
LUFREE   DS    A                    Address of free slot in table
LULAST   DS    A                    Address of last LU entry
FIRSTIN  DC    C'Y'                 Init Required Flag
IPADDR   DS    F                    Client IP Address
*
*
*--------------------------------------------------------------------
*
* Template Mapping Table:
*
*   This table is used to map an IP address to a specific MAP entry.
*   The match is done from top to bottom and the first entry to match
*   is used.
*
*
* The table contains the following items:
*
*    IP Address: IP Address to be matched
*    Mask Value: Mask to be used to match IP address
*    Template:   The template to use to create the LU name.
*    Max Count:  Maximum LUs in pool
*    Max Sess:   Number of sessions allowed
*    High Count: Current highest number in use
*
* The end of table is indicated by an X'FF' value in the first byte
* of the IP address
*
*
*  Max Sessions Per client ----------------------------------+
*                                                            |
*  Size of Pool ---------------------------------------+     |
*                                                      |     |
MAPCON   DS    0F                                      v     v
         DC    X'0A010000',X'FFFFFF00',CL8'TXXYYNNN',F'30',F'2',F'0'
         DC    X'0A010200',X'00000000',CL8'TXXYYNNN',F'20',F'1',F'0'
         DC    X'FFFFFFFF',X'FFFFFFFF',CL8'The End ',F'0',F'0',F'0'
*
*--------------------------------------------------------------------
         SPACE
MASKTAB  DC    C'NXYZ'            Template Mask Characters
         LTORG
*
*  LU Exit Routine - Parameter List
*
*
*    Note: If the IPV6 flag is on the IP fields contain a 16 byte
*          IP address in hex. If the flag is not on, a four byte
*          IPV4 address is contained in the last four bytes of the
*          IP fields.
*
TXPARAM  DSECT
TXLUNAME DS    CL8                LU Name
TXFLAGS  DS    CL4                Flags
TXPRINT  EQU   X'80'                 80 .... LU is a Printer
TXLAST   EQU   X'40'                 40 .... Last Chance
TXIPV6   EQU   X'20'                 20 .... IPV6 Connection
TXCLIP   DS    CL16               Client IP Address
TXCLPORT DS    CL4                Client Port Number
TXDSIP   DS    CL16               Destination IP Address
TXDSPORT DS    CL4                Destination Port
TXLINKNM DS    CL16               Link Name
TXCRTUSR DS    CL8                Userid from client certificate
TXHOSTPT DS    CL4                -> Hostname structure
TXNETID  DS    CL8                Application Netid
TXAPPL   DS    CL8                Application Name
TXLOGUSR DS    CL8                Userid from logon panel
TXGRPPT  DS    CL4                -> LU Group Structure
         SPACE
MAPENTRY DSECT
MAPIP    DS    XL4                IP Address to mask
MAPMASK  DS    XL4                Network mask
MAPTEMP  DS    CL8                LU Name template
MAPMAX   DS    F                  Maximum number of LUs in pool
MAPSESSN DS    F                  Number of sessions allowed
MAPHIGH  DS    F                  Highest LU Number Assigned
MAPENTL  EQU   *-MAPIP
         SPACE
LUENTRY  DSECT
LUNAME   DS    CL8                LU Name
LUADDR   DS    XL4                Client IP Address
LUNUM    DS    XL4                LU Number within Pool
LUMAP    DS    XL4                Address of map entry
LUSTATUS DS    XL1                LU Status:
LUINUSE  EQU   X'80'                80 - In use
LUINACT  EQU   X'40'                40 - Inactive (Not available)
LUSPARE  DS    CL3                ** Reserved **
LUENTRYL EQU   *-LUNAME
         END