/TITLE FTPLOGON Firewall Program for FTP Server Logon
*--------------------------------------------------------------*
* Programmers Group & Management Resources Copyright 1999 *
* *
* \\\\\\\ *
* ( o o ) *
*---------------------oOOO----(_)----OOOo----------------------*
* *
* System name. . : Security *
* Module/Program : FTPLOGON *
* Text . . . . . : Firewall for FTP Server Logon *
* *
* Author . . . . : Alex Nubla *
* Description. . : This program must be added to the exit *
* point QIBM_QTMF_SVR_LOGON for format *
* TCPL0100. *
* *
* OOOOO OOOOO *
* ( ) ( ) *
*--------------------( )-------------( )-------------------*
* (_) (_) *
* *
* Modification Log : *
* *
* Task Programmer/ *
* Date No. Description *
* -------- ------ -------------------------------------------- *
* 10/15/98 Alex Nubla *
* Creation Date *
* *
*--------------------------------------------------------------*
* *
* Modules: *
* *
* 1. FTPLOGON RPGLE FTP Server Logon Exit Program *
* *
* Service Programs: *
* *
* 1. *NONE *
* *
* Programs: *
* *
* 1. *NONE *
* *
*--------------------------------------------------------------*
* *
* APIs Used: *
* *
* QSYRUSRA Retrieve user authority to object *
* *
*--------------------------------------------------------------*
H COPYRIGHT('(C) Alex Nubla of PGMR, Inc. 1999')
****************************************************************
* F I L E D E S C R I P T I O N S P E C I F I C A T I O N *
****************************************************************
FQATOCHOST IF E K DISK
*
* Host Table by IP address
*
*--------------------------------------------------------------*
D/EJECT
****************************************************************
* D E F I N I T I O N S P E C I F I C A T I O N *
****************************************************************
*--------------------------------------------------------------*
*
* Retrieve user authority to Object (QSYRUSRA) API
*
D@RtnObjAut DS 93
D @UA2byte 9B 0 Inz
D @UA2avail 9B 0 Inz
D @UA2ObjAut 10 Inz
*
D @UA2Len S 9B 0 Inz(93)
D @UA2Format S 8 Inz('USRA0100')
D @UA2User S 10 Inz
D @UA2Object S 20 Inz('FTPLOGON QSYS ')
D @UA2OType S 10 Inz('*AUTL')
*--------------------------------------------------------------*
*
* TCP/IP Application Server Logon Exit Point Interface
*
* *------------------------------------------------------------*
* | 1 | Application identifier | Input | Binary(4) |
* | | | | |
* | | 1 = FTP server program | | |
* | | 2 = REXEC server program | | |
* | | | | |
* |----+------------+----------------+--------+----------------|
* | 2 | User identifier | Input | Char(*) |
* |----+------------+----------------+--------+----------------|
* | 3 | Length of user identifier | Input | Binary(4) |
* |----+------------+----------------+--------+----------------|
* | 4 | Authentication string | Input | Char(*) |
* |----+------------+----------------+--------+----------------|
* | 5 | Length of authentication | Input | Binary(4) |
* | | string | | |
* |----+------------+----------------+--------+----------------|
* | 6 | Client IP address | Input | Char(*) |
* |----+------------+----------------+--------+----------------|
* | 7 | Length of client IP address | Input | Binary(4) |
* |----+------------+----------------+--------+----------------|
* | 8 | Return code | Output | Binary(4) |
* | | | | |
* | | 0 = Reject Logon | | |
* | | 1 = Continue Logon | | |
* | | 2 = Continue Logon, | | |
* | | override current | | |
* | | library | | |
* | | 3 = Continue Logon, | | |
* | | override user prf, | | |
* | | password | | |
* | | 4 = Continue Logon, | | |
* | | override user prf, | | |
* | | password, current | | |
* | | library | | |
* | | 5 = Accept logon with | | |
* | | user prf returned | | |
* | | 6 = Accept logon with | | |
* | | user prf returned, | | |
* | | override current | | |
* | | library | | |
* | | | | |
* |----+------------+----------------+--------+----------------|
* | 9 | User profile | Output | Char(10) |
* |----+------------+----------------+--------+----------------|
* | 10 | Password | Output | Char(10) |
* |----+------------+----------------+--------+----------------|
* | 11 | Initial current library | Output | Char(10) |
* *------------------------------------------------------------*
*
* Exit Point: QIBM_QTMF_SVR_LOGON
* QIBM_QTMX_SVR_LOGON
*
D AppId S 9B 0
D UserId S 999
D UserIdLen S 9B 0
D Authen S 999
D AuthenLen S 9B 0
D IpAddr S 15
D IpAddrLen S 9B 0
D RtnCode S 9B 0
D User S 10
D Password S 10
D CurrLib S 10
D Email S 30
D FTPUser S 10
D Message S 52
D FullJob S 28
*--------------------------------------------------------------*
*
* Record structure for error code parameter
*
D@ErrData DS
D @BytesProv 9B 0 Inz(200)
D @BytesAval 9B 0
D @ExcpId 7
D @Reserved1 1
D @ExcpData 184
*--------------------------------------------------------------*
*
* Constants
*
D Special C 'ZFTP'
D Anonymous C 'ANONYMOUS '
D LogMsg1 C 'ANONYMOUS ('
D LogMsg2 C ') try to logon FTP'
D LogMsg3 C ' logon to FTP'
D @Sign C '@'
D Warn1 C ' SECURITY VIOLATION: '
D Warn2 C ' =================================-
D =================='
D Warn3 C ' Invalid IP Address of FTP Logon. -
D Check the ff:'
D Warn4 C ' Not authorized to FTPLOGON *AUTL.-
D Check the ff:'
D Reject C 0
D Continue C 1
D Accept C 5
*
C/EJECT
****************************************************************
* C A L C U L A T I O N S P E C I F I C A T I O N *
****************************************************************
*
C *Entry Plist
*
* Input parameters
C Parm AppId
C Parm UserId
C Parm UserIdLen
C Parm Authen
C Parm AuthenLen
C Parm IpAddr
C Parm IpAddrLen
*
* Return parameters
C Parm RtnCode
C Parm User
C Parm Password
C Parm CurrLib
*
*----------------------------------------------------*
* Check user id requesting the FTP *
*----------------------------------------------------*
C If UserIdLen > *Zeros
C Eval FtpUser = %Subst(UserId: 1: UserIdLen)
C EndIf
*
C Select
*----------------------------------------------------*
* ANONYMOUS user log on *
*----------------------------------------------------*
C When FtpUser = Anonymous
C Exsr $Anonym
C Other
*----------------------------------------------------*
* Is user authorized to FTPLOGON *AUTL *
*----------------------------------------------------*
C Exsr $Autl
C EndSl
*
C Eval *InLR = *On
C Return
/EJECT
****************************************************************
* S U B R O U T I N E S *
****************************************************************
/SPACE
*==============================================================*
* *
* Anonymous user log on *
* *
C $Anonym Begsr
*==============================================================*
*----------------------------------------------------*
* We may want ANONYMOUS user id in the fututre - *
* if so, create the user id use by "PUBLIC" user. *
* For now, it will abend because ANONYMOUS is not a *
* valid AS/400 id. Read I.7 Anonymous FTP of *
* OS/400 TCP/IP Configuration & Reference Manual. *
*----------------------------------------------------*
* *------------------------------------------*
* * email address follows ANONYMOUS *
* *------------------------------------------*
C @Sign Scan Authen:2 88
C If *In88
*
* if we allow "PUBLIC" FTP, change this code
* to use the "PUBLIC" user id.
*
C Eval User = FtpUser
C Eval RtnCode = Accept
C Eval Email = %Subst(Authen: 1: AuthenLen)
C Eval Message = LogMsg1 +
C %Trimr(Email) +
C LogMsg2
C Message Dsply 'QSYSOPR'
C Else
C Eval RtnCode = Reject
C EndIf
*
*
C #Anonym Endsr
/SPACE
*==============================================================*
* *
* Authorized to FTPLOGON *AUTL? *
* *
C $Autl Begsr
*==============================================================*
*----------------------------------------------------*
* User must be authorized to FTPLOGON *AUTL. *
*----------------------------------------------------*
C Reset @RtnObjAut
C Reset @UA2Len
C Reset @UA2Format
C Eval @UA2User = FtpUser
C Call 'QSYRUSRA'
C Parm @RtnObjAut
C Parm @UA2Len
C Parm @UA2Format
C Parm @UA2User
C Parm @UA2Object
C Parm @UA2OType
C Parm @ErrData
* *------------------------------------------*
* * Not authorized to FTPLOGON *AUTL. *
* * If we want to prevent the FTP for the *
* * user, use the Reject statement instead. *
* *------------------------------------------*
C If @UA2ObjAut = '*EXCLUDE'
C Eval RtnCode = Continue
*@@@@@@@@ Eval RtnCode = Reject
C Warn2 Dsply 'QSYSOPR'
C Eval Message = %Trimr(Warn1) +
C ' USER ID INVALID'
C Message Dsply 'QSYSOPR'
C Warn4 Dsply 'QSYSOPR'
C Eval Message = ' User Id : ' + FtpUser
C Message Dsply 'QSYSOPR'
C Eval Internet = %Subst(IpAddr: 1: IpAddrLen)
C Eval Message = ' IP Address: ' + Internet
C Message Dsply 'QSYSOPR'
C Warn2 Dsply 'QSYSOPR'
*
C Else
* *------------------------------------------*
* * if authorized, validate IP *
* *------------------------------------------*
C Exsr $ValidIp
C EndIf
*
C #Autl Endsr
/SPACE
*==============================================================*
* *
* Validate the FTP Client IP Address *
* *
C $ValidIp Begsr
*==============================================================*
*----------------------------------------------------*
* Validate the IP address the FTP request is coming *
* in from. The IP must be registered as one of the *
* host tables. GO CFGTCP and take option 10 to *
* enter new host in the table. *
*----------------------------------------------------*
*
C Eval Internet = %Subst(IpAddr: 1: IpAddrLen)
C Internet Chain QATOCHOST 40
C If Not *In40
C Eval RtnCode = Continue
C If FtpUser <> Special
C Eval Message = %Trimr(FtpUser) + LogMsg3
C Message Dsply 'QSYSOPR'
C EndIf
*
C Else
* *------------------------------------------*
* * Invalid Client IP Address. *
* * If we want to prevent the FTP for the *
* * user, use the Reject statement instead. *
* *------------------------------------------*
C Eval RtnCode = Continue
*@@@@@@@@ Eval RtnCode = Reject
C Warn2 Dsply 'QSYSOPR'
C Eval Message = %Trimr(Warn1) +
C ' CLIENT IP ADDRESS INVALID'
C Message Dsply 'QSYSOPR'
C Warn3 Dsply 'QSYSOPR'
C Eval Message = ' IP Address: ' + Internet
C Message Dsply 'QSYSOPR'
C Eval Message = ' User Id : ' + FtpUser
C Message Dsply 'QSYSOPR'
C Warn2 Dsply 'QSYSOPR'
C EndIf
*
C #ValidIp Endsr