Program to Limit Maximum Number of Sessions Permitted

Resolving The Problem

Many users ask if there is a way to limit the number of device sessions permitted for a user to some explicit number rather than limiting it to one or more than one. Unfortunately, prior to V6R1, neither the Limit device sessions (QLMTDEVSSN) system value nor the Limit device sessions (LMTDEVSSN) user profile attribute supports that. At V6R1, the QLMTDEVSSN system value was updated to allow a user to be limited to anywhere from 1 to 9 devices. This note provides the source of a CL program that can be used by the initial program of a user to provide the needed limitation. If a user whose sign-ons are to be constrained in this manner has no initial program, a simple two-statement program can be used to call the Q$$CHKSES program shown below. If an initial program already exists, add two additional records to that program. The two lines needed are explained in the source listing shown below.

Note: This code will not run as is. You must change a declaration statement before it will work.

The first statement for the declarations is as follows:

DCL VAR(&MAX) TYPE(*DEC) LEN(5 0)

As is when you run the program, you will get a MCH1202 unless you define the %MAX as (15 5).

If you change it to the following, the program will work:

DCL VAR(&MAX) TYPE(*DEC) LEN(15 5)

This has been tested, and it does work after the change.


/***START OF SPECIFICATIONS******************************************/
/* NAME: Q$$CHKSES                                                  */
/*                                                                  */
/* PURPOSE:  CHECKS THE NUMBER OF ACTIVE INTERACTIVE SESSIONS FOR   */
/*           A SPECIFIED USER.  IF THAT USER HAS MORE ACTIVE        */
/*           SESSIONS THAN DEFINED BY THE VALUE OF THE PARAMETER    */
/*           PASSED TO THIS PROGAM THEN THE USER IS SENT A BREAK    */
/*           MESSAGE NOTIFYING HIM OF THAT. WHEN HE SIGNS OFF THEN  */
/*           HIS JOB DOES A SIGNOFF AND HE GETS A NEW SIGNON SCREEN.*/
/*                                                                  */
/*           NOTE THAT THIS PROGRAM IS NOT SUPPORTED BY IBM         */
/*                .                                                 */
/*    THIS PROGRAM MAY CALLED VIA THE CALLING CALL SEQUENCE:        */
/*           CALL LIBNAM/Q$$CHKSES PARM($MAX)                       */
/*                                                                  */
/*           WHERE LIBNAM IS THE NAME OF THE LIBRARY                */
/*                 $MAX IS A DECIMAL VARIABLE FIELD.  THE FOLLOWING */
/*                 ILLUSTRATES CODE THAT MAY BE USED TO DEFINE THE  */
/*                 VARIABLE WITH A VALUE OF 2 AND THEN THE CALL TO  */
/*                 THIS PROGRAM:                                    */
/*                                                                  */
/*          DCL        VAR(&MAX) TYPE(*DEC) LEN(5 0) VALUE(2)       */
/*          CALL       PGM(PGMLIBX/Q$$CHKSES) PARM(&MAX)            */
/*                                                                  */
/*                                                                  */
/*    Note that 4 comment lines have been added which showed the    */
/*    number of embedded blanks that needed to be included in       */
/*    quoted strings.  Each 'b' in those example lines represent    */
/*    a blank.                                                      */
/***END OF SPECIFICATIONS********************************************/
                                                                       
             PGM       PARM(&MAX)                                      
                                                                       
             DCL VAR(&MAX) TYPE(*DEC) LEN(15 5)                   
             DCL        VAR(&USRNAME) TYPE(*CHAR) LEN(10)              
             DCL        VAR(&JOB) TYPE(*CHAR) LEN(10)                  
             DCL        VAR(&FORMAT) TYPE(*CHAR) LEN(8) +              
                          VALUE('JOBL0100')                            
                        /* FORMAT NAME FOR QUSLJOB API              */  
             DCL        VAR(&JOBNAME) TYPE(*CHAR) LEN(26) +            
                          VALUE('*ALL                *ALL  ')
                       /* VALUE('*ALLbbbbbbbbbbbbbbbb*ALLbb')  */          
             DCL        VAR(&STATUS) TYPE(*CHAR) LEN(10) VALUE(*ACTIVE)
             DCL        VAR(&JOBTYPE) TYPE(*CHAR) LEN(1) +              
                                       VALUE('I')                      
             DCL        VAR(&ERRCODE) TYPE(*CHAR) LEN(8) +              
                          VALUE(X'0000000000000000')                    
             DCL        VAR(&COUNT) TYPE(*DEC) LEN(5 0)                
                        /* LOOPING COUNTER                           */
             DCL        VAR(&USRSPC) TYPE(*CHAR) LEN(20) +
                          VALUE('XTEMPSPACEQTEMP     ')
                      /*  VALUE)'XTEMPSPACEQTEMPbbbbb')  */                
                       /* USER SPACE NAME TO GET INFORMATION         */
                                                                       
             DCL        VAR(&NUMENTB) TYPE(*CHAR) LEN(4) /* NUMBER +  
                          OF ENTRIES FROM LIST JOB SCHEDULE ENTRIES +  
                          IN BINARY FORM */                            
             DCL        VAR(&NUMENT) TYPE(*DEC) LEN(8 0) /* NUMBER +  
                          OF ENTRIES FROM LIST JOB SCHEDULE ENTRIES +  
                          IN DECIMAL FORM */                          
             DCL        VAR(&GENHDR) TYPE(*CHAR) LEN(140) /* GENERIC +
                          HEADER INFORMATION FROM THE USER SPACE */    
                                                                       
/********************************************************************/
/* CREATE THE USER SPACE                                            */
/********************************************************************/
PROCED1:                                                              
    CALL PGM(QUSCRTUS) PARM('XTEMPSPACEQTEMP     ' ' ' +
                       X'00000100' ' ' '*ALL      ' ' ')
 /* CALL PGM(QUSCRTUS) PARM('XTEMPSPACEQTEMPbbbbb'b'b' +
 /*                    X'00000100'b'b'b'*ALLbbbbbb'b'b')              
                                                                   
/********************************************************************/
/*  MONITOR FOR ERROR CAUSED BY SPACE ALREADY EXISTING              */
/********************************************************************/
             MONMSG     MSGID(CPF9870) +                                
                        EXEC(GOTO CMDLBL(PROCED2))                      
                                                                       
/********************************************************************/
/*  GET THE CURRENT USER NAME                                       */
/********************************************************************/
 PROCED2:    RTVJOBA    JOB(&JOB) USER(&USRNAME)                        
                                                                       
/********************************************************************/
/*  PUT RETRIEVED USERNAME INTO &JOBNAME VAR                        */
/********************************************************************/
             CHGVAR     VAR(%SST(&JOBNAME 11 10)) VALUE(&USRNAME)      
                                                                       
/********************************************************************/
/*  CALL THE API TO GET THE JOB INFORMATION                         */
/********************************************************************/
             CALL       PGM(QUSLJOB) PARM( +                          
                          &USRSPC &FORMAT &JOBNAME &STATUS +          
                          &ERRCODE &JOBTYPE X'00000000' X'00000000')  
             MONMSG     MSGID(CPF0000) +                              
                          EXEC(GOTO CMDLBL(ABORT))                    
                                                                     
/********************************************************************/
/*  READ THE GENERIC HEADER FROM THE USER SPACE                     */
/********************************************************************/
                CALL       PGM(QUSRTVUS) PARM(&USRSPC X'00000001' +  
                             X'0000008C' &GENHDR)                    
                CHGVAR     VAR(&NUMENTB) VALUE(%SST(&GENHDR 133 4))  
                CHGVAR     VAR(&NUMENT) VALUE(%BIN(&NUMENTB))        
                CHGVAR     VAR(&COUNT) VALUE(&NUMENT)                
/********************************************************************/
/*  CHECK IF NO JOBS FOUND, IF NOT THEN EXIT EARLY                  */
/*  THIS COULD HAPPEN IF THE PROGRAM WAS CALLED BY A BATCH JOB      */
/********************************************************************/
                  IF (&COUNT *NE 0) THEN( GOTO CHECKNUM)                
                                                                         
               SNDMSG     MSG('NO JOBS FOUND FOR SPECIFIED USER') +      
                            TOUSR(&USRNAME)                              
               GOTO ABORT                                            
                                                                         
/********************************************************************/  
/*  CHECK IF TOO MANY JOBS FOR THIS USER                            */  
/********************************************************************/  
  CHECKNUM:                                                              
                 IF   (&NUMENT *LE &MAX) THEN( GOTO CLEANUP)            
                                                                         
             SNDBRKMSG  MSG('TOO MANY INTERACTIVE SESSIONS. THIS ONE +
                       WILL AUTOMATICALLY END WHEN YOU PRESS ENTER') +
                                                    TOMSGQ(&JOB)        
                                                                       
             SIGNOFF                                                    
                                                                       
/********************************************************************/
/*  DELETE THE USER SPACE                                           */
/********************************************************************/
 CLEANUP:       DLTUSRSPC USRSPC(QTEMP/XTEMPSPACE)                      
                                                                       
                                                                       
/********************************************************************/
/*  MONITOR FOR ERROR CAUSED BY USER SPACE NOT EXISTING             */
/********************************************************************/
             MONMSG     MSGID(CPF2110) +                                
                          EXEC(GOTO CMDLBL(EXITPGM))                    
                GOTO CMDLBL(EXITPGM)                                  
                                                                       
 ABORT:      SNDMSG   MSG('JOB CHECK DID NOT COMPLETE SUCCESSFULLY') +
                          TOUSR(*SYSOPR)  
                             
             GOTO CMDLBL(CLEANUP)                                    
 EXITPGM:                                                              
                                                                                                                                                                                                                       
             ENDPGM