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
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.
/* 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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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,
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.
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.
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
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.
ASKER
Thanks for the example! I appreciate the information
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.