Link to home
Start Free TrialLog in
Avatar of Matthew Roessner
Matthew Roessner

asked on

iSeries FTP Exit Program

I would like to create a FTP exit program that checks to see if a user is a member of a group. If the user is a member of the group, the user is allowed to log in and the logon activity is logged.  If the user is not a member of a group, then the user is not allowed to log in and that information is logged to a denial log file.

For some reason, when I attempt to do a RTVUSRPRF within the CL - the FTP logon process is broken and no one is allowed to log in.

Does anyone know how I can achieve what I want to do?  I have attached the code for my CL...

The exit program I am using is: QIBM_QTMF_SVR_LOGON (TCPL0100)

             Pgm        (  &P_AppID &P_User &P_UserLen &P_Pwd &P_PwdLen +      
                          &P_IP &P_IPLen &P_RtnOut &P_UserOut &P_PwdOut +      
                          &P_LibOut  )                                          
                                                                               
  /* Paramaters for exit point interface format TCPL0100            */          
                                                                               
  /* Input Parms */                                                            
             DCL        &P_AppID     *CHAR   4 /* Application ID +              
                          (%BIN)     */                                        
                                       /* 1 = FTP                   */          
             DCL        &P_User      *CHAR 999 /* User +                        
                          ID                   */                              
             DCL        &P_UserLen   *CHAR   4 /* User ID Length +              
                          (%BIN)     */                                        
             DCL        &P_Pwd       *CHAR 999 /* +                            
                          Password                  */                          
             DCL        &P_PwdLen    *CHAR   4 /* Password length +            
                          (%BIN)    */                                          
             DCL        &P_IP        *CHAR  15 /* Requester IP +                
                          Address      */                                      
             DCL        &P_IPLen     *CHAR   4 /* IP Address length +          
                          (%BIN) */                                            
                                                                               
  /* Output parms */                                                            
             DCL        &P_RtnOut    *CHAR   4 /* Return Code +                
                          OUT           */                                      
                                       /* Values are:               */          
                                       /* 0=Reject                  */          
                                       /* 1=Accept, W/USRPRF CURLIB */          
                                       /* 2=Accept, W/ &P_LIbOut    */          
                                       /* 3=Accept, W/USRPRF CURLIB */          
                                       /*          AND &P_UserOut   */          
                                       /*          AND &P_PwdOut    */          
                                       /* 4=Accept, W/ &P_LibOut    */          
                                       /*          AND &P_UserOut   */          
                                       /*          AND &P_PwdOut    */          
                                       /* 5=Accept, W/USRPRF CURLIB */          
                                       /*          AND &P_UserOut   */          
                                       /*          PASSWORD BYPASS  */          
                                       /* 6=Accept, W/ P_LibOut     */          
                                       /*          AND &P_UserOut   */          
                                       /*          PASSWORD BYPASS  */          
             DCL        &P_UserOut   *CHAR  10 /* User Profile +                
                          OUT          */                                      
             DCL        &P_PwdOut    *CHAR  10 /* Password +                    
                          OUT              */                                  
             DCL        &P_LibOut    *CHAR  10 /* Curlib +                      
                          OUT                */                                
 /* END OF FORMAT TCPL0100                                          */          
                                                                               
 /* VARIABLES FOR BINARY CONVERSIONS */                                        
             DCL        &AppID       *DEC   (1 0)                              
             DCL        &UserLen     *DEC   (3 0)                              
             DCL        &PwdLen      *DEC   (3 0)                              
             DCL        &IPLen       *DEC   (3 0)                              
                                                                               
 /* MISC. WORK VARIABLES             */                                        
             DCL        &Time        *CHAR   6                                  
             DCL        &Date        *CHAR   6                                  
             DCL        &Message     *CHAR 256                                  
             DCL        &Accept1     *DEC    1   VALUE(1)                      
             DCL        &Reject0     *DEC    1   VALUE(0)                      
             DCL        &MsgQ        *CHAR  10   VALUE('FTPLOG')                
             DCL        &MsgQLib     *CHAR  10   VALUE('FTPLIB')                
             DCL        VAR(&PRIGRP) TYPE(*CHAR) LEN(10)                        
             DCL        VAR(&SUPGRP) TYPE(*CHAR) LEN(150)                      
             DCL        &GROUP *CHAR 10 value('FTPGROUP')                                                                                          
                                                                               
 /* MESSAGE-HANDLING VARIABLES */                                              
             DCL        &MsgID       *CHAR   7                                  
             DCL        &MsgF        *CHAR  10                                  
             DCL        &MsgFLib     *CHAR  10                                  
             DCL        &MsgDta      *CHAR 100                                  
                                                                               
             DCL        VAR(&CMD) TYPE(*CHAR) LEN(200)                          
             DCL        VAR(&TARGET) TYPE(*CHAR) LEN(100)                      
             DCL        VAR(&DTARGET) TYPE(*CHAR) LEN(100)                      
             DCL        VAR(&USERNAME) TYPE(*CHAR) LEN(10)                      
                                                                               
             Monmsg     (CPF0000  MCH0000)  Exec(GoTo Error)                    
                                                                               
             ChgVar     &AppID    %BIN(&P_AppID)                                
             ChgVar     &Userlen  %BIN(&P_UserLen)                              
             ChgVar     &Pwdlen   %BIN(&P_PwdLen)                              
             ChgVar     &IPLen    %BIN(&P_IPLen)                                
                                                                               
                                                                               
             CHGVAR     &USERNAME     %SST(&P_User 1 &UserLen)                  
                                                                                                                                                   
             RtvSysVal  QTIME    &Time                                          
             RtvSysVal  QDATE    &Date                                          
    /*       RTVUSRPRF  USRPRF(&USERNAME) GRPPRF(&PRIGRP) +     */              
    /*                    SUPGRPPRF(&SUPGRP)                    */              
                                                                               
                                                                               
             CHGVAR     VAR(&TARGET) VALUE('/admin/ftp_' *CAT &DATE *CAT +      
                          '.txt')                                              
                                                                               
             CHGVAR     VAR(&DTARGET) VALUE('/admin/ftp_denials.txt')

/* Looks like a valid request.... Let IBM i check UserID and Password */        
/* Here we log the attempted Login to the FTPLOG Message queue         */      
             Chgvar     &Message ('FTP Logon' *BCAT %SST(&P_User 1 +            
                          &UserLen) *BCAT 'From IP Addr' *BCAT %SST(&P_IP +    
                          1 &IPLen) *BCAT 'at' *BCAT %SST(&Time 1 2) *CAT +    
                          ':' *CAT  %SST(&Time 3 2) *CAT  ':' *CAT +            
                          %SST(&Time 5 2) *BCAT 'on' *BCAT %SST(&Date 1 2) +    
                          *CAT  '/' *CAT %SST(&Date 3 2) *CAT  '/' *CAT +      
                          %SST(&Date 5 2))                                      
                                                                               
             CHGVAR     VAR(&CMD) VALUE('echo "' *TCAT &MESSAGE *TCAT '" +      
                          >> ' *CAT &TARGET)                                    
                                                                               
             QSH        CMD(&CMD)

             ChgVar     %Bin(&P_RtnOut)   Value(&Accept1) /* Return +          
                          "Accept" */    

 EndCLPgm:                                                                      
             Return     /* Normal end of program */                            
                                                                               
 Error:      /* if the exit program bombs, a message will be sent to the +      
                          JobLog */                                            
             RcvMsg     Msgtype(*LAST) MsgDta(&MsgDta) MsgID(&MsgID) +          
                          MsgF(&MsgF) SndMsgFLib(&MsgFLib)                      
                                                                               
/* Prevent loop, just in case           */                                      
             MonMsg     CPF0000                                                
                                                                               
             SndPgmMsg  MsgID(&MsgID) MsgF(&MsgFLib/&MsgF) MsgDta(&MsgDta) +    
                          MsgType(*ESCAPE)                                      
/* Prevent loop, just in case           */                                      
             MonMsg     CPF0000                                                
                                                                               
             EndPgm
SOLUTION
Avatar of Gary Patterson, CISSP
Gary Patterson, CISSP
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Member_2_276102
Member_2_276102

It's a little difficult being sure of much because of the obsolete coding. Can you provide the OS version for us? The coding style is pre-V5R3, so it could be very old. We need to know what we're working with.

If it fails when RTVUSRPRF runs, it seems likely that the command is throwing an error. And since the only error test is global, it's not handled properly and the return value isn't set to allow access.
Avatar of Matthew Roessner

ASKER

I found the shell of the exit program online, so I would not be overly surprised to hear that it is an old coding style. Do you know if there are newer examples somewhere?

I found (from the DMPCLPGM) that I am basically getting an error message that says, "Not Authorized to user profile XXXXXX".  So essentially the QCTP user is not authorized to my user profile.

Any ideas how I can get around this easily and "securely"?

Thanks guys,
FTP Exit program examples are in the IBM i Knowledge Center for your OS version.  You don't mention your version but if you search the knowledge center for "FTP exit program example" I'm sure you'll find it.

To get around this, you could compile your CL exit point program to run under adopted authority of a user profile that has access to all user profiles on the system.
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks for all your help!
Here's a trivial example, using just one of the new data types available since V5R3 -- the *INT (binary integer) data type. It defaults to 32-bit (4 byte) integers, so the *INT type is all that's needed on the DCL. No length needed.

Also, there's no need for using the %BIN() function to convert between a *CHAR (4) and some numeric data type such as *DEC (3 0)  because it's already a proper numeric data element.
pgm    ( +
         &pAppId      +
         &pUsrId      +
         &plUsrId     +
         &pAutStr     +
         &plAutStr    +
         &pRmtIpAdr   +
         &plRmtIpAdr  +
         &pAccRej     +
         &pUsrPrf     +
         &pPwd        +
         &pInlLib     +
         &pInlDir     +
         &plInlDir    +
         &pAppInf     +
         &plAppInf    +
       )

   dcl   &pAppId      *int
   dcl   &pUsrId      *char  128
   dcl   &plUsrId     *int
   dcl   &pAutStr     *char  128
   dcl   &plAutStr    *int
   dcl   &pRmtIpAdr   *char   45
   dcl   &plRmtIpAdr  *int
   dcl   &pAccRej     *int
   dcl   &pUsrPrf     *char   10
   dcl   &pPwd        *char   10
   dcl   &pInlLib     *char   10
   dcl   &pInlDir     *char  512
   dcl   &plInlDir    *int
   dcl   &pAppInf     *char 4096
   dcl   &plAppInf    *int

   dcl   &AppId       *int
   dcl   &UsrId       *char  128
   dcl   &lUsrId      *int
   dcl   &AutStr      *char  128
   dcl   &lAutStr     *int
   dcl   &RmtIpAdr    *char   45
   dcl   &lRmtIpAdr   *int
   dcl   &AccRej      *int
   dcl   &UsrPrf      *char   10
   dcl   &Pwd         *char   10
   dcl   &InlLib      *char   10
   dcl   &InlDir      *char  512
   dcl   &lInlDir     *int
   dcl   &AppInf      *char 4096
   dcl   &lAppInf     *int

   monmsg     ( cpf0000 cpa0000 cpd0000 cpi0000 mch0000 )


   chgvar            &AppId                 &pAppId
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar         &AppId               ( 0 )
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing AppId' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo

   chgvar            &lUsrId                &plUsrId
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar         &lUsrId              ( 0 )
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing lUsrId' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo
   if ( &lUsrId *gt 0 )  do
      chgvar         &UsrId           %sst( &pUsrId  1 &lUsrId )
      monmsg  ( mch3601 )  exec( do )
         rcvmsg      msgtype( *LAST ) rmv( *YES )
         monmsg    ( cpf0000 cpf9999 mch0000 )
         chgvar      &UsrId                 ' '
         sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                      msgdta( 'Missing UsrId' ) +
                      topgmq( *EXT ) msgtype( *DIAG )
      enddo
   enddo
   else  +
      chgvar         &UsrId                 ' '

   chgvar            &lAutStr               &plAutStr
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar         &lAutStr             ( 0 )
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing lAutStr' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo
   if ( &lAutStr *gt 0 )  do
      chgvar         &AutStr          %sst( &pAutStr  1 &lAutStr )
      monmsg  ( mch3601 )  exec( do )
         rcvmsg      msgtype( *LAST ) rmv( *YES )
         monmsg    ( cpf0000 cpf9999 mch0000 )
         chgvar      &AutStr                ' '
         sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                      msgdta( 'Missing AutStr' ) +
                      topgmq( *EXT ) msgtype( *DIAG )
      enddo
   enddo
   else  +
      chgvar         &AutStr                ' '

   chgvar            &lRmtIpAdr             &plRmtIpAdr
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar         &lRmtIpAdr           ( 0 )
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing lRmtIpAdr' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo
   if ( &lRmtIpAdr *gt 0 )  do
      chgvar         &RmtIpAdr        %sst( &pRmtIpAdr 1 &lRmtIpAdr )
      monmsg  ( mch3601 )  exec( do )
         rcvmsg      msgtype( *LAST ) rmv( *YES )
         monmsg    ( cpf0000 cpf9999 mch0000 )
         chgvar      &RmtIpAdr              ' '
         sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                      msgdta( 'Missing RmtIpAdr' ) +
                      topgmq( *EXT ) msgtype( *DIAG )
      enddo
   enddo
   else  +
      chgvar         &RmtIpAdr              ' '

   chgvar            &AccRej                &pAccRej
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar         &AccRej              ( 0 )
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing AccRej   ' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo

   chgvar            &UsrPrf                &pUsrPrf
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar         &UsrPrf                ' '
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing UsrPrf   ' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo

   chgvar            &Pwd                   &pPwd
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar      &Pwd                   ' '
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing Pwd     ' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo

   chgvar            &InlLib                &pInlLib
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar         &InlLib              ( ' ' )
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing InlLib   ' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo

   chgvar            &lInlDir               &plInlDir
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar         &lInlDir             ( 0 )
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing lInlDir  ' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo
   if ( &lInlDir   *gt 0 )  do
      chgvar         &InlDir          %sst( &pInlDir   1 &lInlDir   )
      monmsg  ( mch3601 )  exec( do )
         rcvmsg      msgtype( *LAST ) rmv( *YES )
         monmsg    ( cpf0000 cpf9999 mch0000 )
         chgvar      &InlDir                ' '
         sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                      msgdta( 'Missing InlDir  ' ) +
                      topgmq( *EXT ) msgtype( *DIAG )
      enddo
   enddo
   else  +
      chgvar         &InlDir                ' '

   chgvar            &lAppInf               &plAppInf
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      chgvar         &lAppInf             ( 0 )
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing lAppInf  ' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo
   if ( &lAppInf   *gt 0 )  do
      chgvar         &AppInf          %sst( &pAppInf   1 &lAppInf   )
      monmsg  ( mch3601 )  exec( do )
         rcvmsg      msgtype( *LAST ) rmv( *YES )
         monmsg    ( cpf0000 cpf9999 mch0000 )
         chgvar      &AppInf                ' '
         sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                      msgdta( 'Missing AppInf  ' ) +
                      topgmq( *EXT ) msgtype( *DIAG )
      enddo
   enddo
   else  +
      chgvar         &AppInf                ' '


   chgvar            &pAccRej               &AccRej
   monmsg  ( mch3601 )  exec( do )
      rcvmsg      msgtype( *LAST ) rmv( *YES )
      monmsg    ( cpf0000 cpf9999 mch0000 )
      sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                   msgdta( 'Missing pAccRej parm' ) +
                   topgmq( *EXT ) msgtype( *DIAG )
   enddo

   sndpgmmsg  msgid( CPF9897 ) msgf( QCPFMSG ) +
                msgdta( 'Processed *FTPSIGNON' ) +
                topgmq( *EXT ) msgtype( *DIAG )

   dmpclpgm
   dspjoblog   output(*print)

   return

endpgm

Open in new window

The program only accepts parameters from the exit point (or anything that calls it), moves parameter values into program variables, dumps itself and spools the current joblog. If any parameter is not passed, a default value is assigned. Tests for MCH3601 detect the "missing parm" conditions.

There are more enhancements to CL coding in V5R3 and V5R4 than just the *INT data type; but all by itself, a *INT data type can clean up a lot in any code for exit points or APIs.
Thanks for the example! I appreciate the information