Problem solve Get help with specific problems with your technologies, process and projects.

Program to limit the maximum number of sessions permitted

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 just limiting it to 1 or more than one. Unfortunately, the LMTDEVSSN user profile attribute does not support that. This note provides the source of a CL program that may 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.


/***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 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)            */
/*                                                                  */
/***END OF SPECIFICATIONS********************************************/

             PGM       PARM(&MAX)

             DCL        VAR(&MAX) TYPE(*DEC) LEN(5 0)
             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  ')
             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     ')
                       /* 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      ' ' ')

/********************************************************************/
/*  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

Dig Deeper on RPG iSeries programming

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close