/****************************************************************/ /* Ban an IP address in SFTPServer */ /* */ /* Author: Peter Moylan (peter@pmoylan.org) */ /* Started: 9 April 2023 */ /* Last revised: 11 April 2023 */ /* Status: Working */ /* */ /* Usage: */ /* ban arg */ /* where arg is one of */ /* addr */ /* addr-addr (a range) */ /* addr/count (a range in CIDR notation) */ /* */ /* Installation: */ /* Put this file in the same directory as FTPD.INI or FTPD.TNI*/ /* */ /* My apologies for the use of global variables. In hindsight */ /* I should have written this in a high-level language. */ /* */ /****************************************************************/ CALL RxFuncAdd SysLoadFuncs, rexxutil, sysloadfuncs CALL SysLoadFuncs CALL CheckPrerequisites rxu SelectTNI INI_get INI_put PARSE ARG param IF (param = '') THEN CALL SayUsage tni = SelectTNI("FTPD") IF tni THEN INIFile = 'FTPD.TNI' ELSE INIFile = 'FTPD.INI' /* Special case: if the INI file does not contain an IP */ /* filter, create one. */ oldlist = INI_get(INIFile, '$SYS', 'IPfilterS') IF oldlist = "" THEN DO CALL INI_put INIFile, '$SYS', 'IPfilterS', '0100'X END /* Add the new banned domain or IP address (or range) */ record = TranslateArg() /* Update the INI file entry. */ list = INI_get(INIFile, '$SYS', 'IPfilterS') CALL INI_put INIFile, '$SYS', 'IPfilterS', record||list /* Tell SFTPServer that a change has occurred, then exit. */ SemName = "\SEM32\FTPSERVER\UPDATED" IF RxOpenEventSem(hev, SemName) \= 0 THEN rc = RxCreateEventSem( hev ,'Shared', SemName, 'Reset') CALL RxPostEventSem hev CALL RxResetEventSem hev CALL RxCloseEventSem hev EXIT 0 /****************************************************************/ /* A USEFUL HELP MESSAGE */ /* We will exit if this is called */ /****************************************************************/ SayUsage: PROCEDURE SAY "Usage: ban arg" SAY "where arg is one of" SAY " addr" SAY " addr-addr (a range)" SAY " addr/count (a range in CIDR notation)" SAY "and addr is an IP address in dotted notation. In the first case only," SAY "a * wildcard may be used, but only as the last element, for example" SAY "1.2.* is legal but 1.2.*.3 is not legal. If addr has fewer than" SAY "four components, this too is a wildcard case. Exception: in the" SAY "range and CIDR cases, if addr has fewer than four components then" SAY "the missing parts are set to zero." EXIT 1 /****************************************************************/ /* EXTRACT LEADING DECIMAL STRING */ /****************************************************************/ GetDecimal: PROCEDURE EXPOSE param /* Picks up a decimal number from the beginning of param. */ /* This seems like a clumsy way to do it, but I couldn't */ /* find the Rexx function (it must exist!) to do this. */ digits = "0123456789" number = 0 DO FOREVER ch = LEFT(param,1) p = POS(ch, digits) IF p = 0 THEN LEAVE number = 10*number + p - 1 PARSE VAR param VALUE(ch) param END RETURN number /****************************************************************/ /* TRANSLATING IP ADDRESS IN DOTTED NOTATION */ /****************************************************************/ TranslateIPAddr: PROCEDURE EXPOSE param AddrPair. /* The result is a pair AddrPair.1 and AddrPair.2 */ /* The second component is the mask. */ parts = 0 addr = "" mask = "" DO FOREVER IF (parts = 4) | (param = "") THEN LEAVE ch = LEFT(param, 1) IF ch = '*' THEN DO PARSE VAR param '*'param LEAVE END ELSE IF (ch = '-') | (ch = '/') THEN LEAVE /* No more loop exit conditions, pick up a number. */ ELSE DO cpt = GetDecimal() IF LEFT(param, 1) = '.' THEN PARSE VAR param '.'param END parts = parts+1 /* Append this component to the result. */ addr = addr||D2C(cpt) mask = mask||'FF'X END /* Add padding in the wildcard case. */ DO WHILE parts < 4 addr = addr||'00'X mask = mask||'00'X parts = parts+1 END AddrPair.1 = addr AddrPair.2 = mask RETURN /****************************************************************/ /* TRANSLATING ARGUMENT TO ALLOW/DENY RECORD */ /****************************************************************/ TranslateArg: PROCEDURE EXPOSE param AddrPair. /* ($SYS, IPfilterS) holds the allow/deny data. It is a */ /* sequence of records, terminated by a two-byte "allow all" */ /* of "deny all" record. Each other record is ten bytes long:*/ /* allow flag 1 byte */ /* type 1 byte */ /* address 4 bytes */ /* mask, count, or upper bound 4 bytes */ /* The record types are: */ /* 0 end of list */ /* 1 address and mask */ /* 2 single address */ /* 3 address and bit count */ /* 4 range */ /* For type 2, the mask field must be 0FFFFFFFFH. */ allow = '00'X CALL TranslateIPAddr addr = AddrPair.1 mask = AddrPair.2 /* Check for special case of CIDR notation. */ IF LEFT(param, 1) = '/' THEN DO PARSE VAR param '/'param Call TranslateIPAddr mask = AddrPair.1 type = '03'X END /* Lower and upper bound? */ ELSE IF LEFT(param, 1) = "-" THEN DO PARSE VAR param '-'param Call TranslateIPAddr mask = AddrPair.1 type = '04'X END /* If single address, possibly with wildcard, we */ /* already have addr and mask. */ ELSE IF mask \= 'FFFFFFFF'X THEN type = '01'X ELSE DO type = '02'X END record = allow||type||addr||mask RETURN record /****************************************************************/ /* CHECKING PREREQUISITES */ /****************************************************************/ CheckPrerequisites: PROCEDURE /* The argument is a space-separated list of prerequisite */ /* functions, for example */ /* CALL CheckPrerequisites rxu SelectTNI INI_get */ /* where (at least in this version) each list item is */ /* either 'rxu' or a function from my TNItools package. */ /* If any is missing then we exit with an error message. */ PARSE UPPER ARG funclist funclist = STRIP(funclist) needrxu = 0 needtools = 0 DO WHILE funclist \= '' PARSE VAR funclist func funclist funclist = STRIP(funclist) IF func = 'RXU' THEN DO /* Initialise RXU if not already available, fail if */ /* the RxFuncAdd operation fails. We must */ /* RxFuncQuery RxuTerm because RxuTerm does not */ /* deregister RxuInit. The RxFuncDrop is needed */ /* because RxFuncAdd seems to report failure if the */ /* function is already registered. */ IF RxFuncQuery('RxuTerm') THEN DO CALL RxFuncDrop('RxuInit') CALL RxFuncAdd 'RxuInit','RXU','RxuInit' IF result THEN DO SAY 'Cannot load RXU' needrxu = 1 END ELSE CALL RxuInit END END ELSE DO func = func||'.CMD' IF SysSearchPath('PATH', func) = '' THEN DO SAY 'ERROR: 'func' must be in your PATH' needtools = 1 END END END IF needrxu THEN SAY 'You can find RXU1a.zip at Hobbes' IF needtools THEN SAY 'Please install the GenINI package' IF needrxu | needtools THEN EXIT 1 RETURN /****************************************************************/ /* NOTES */ /****************************************************************/ /* ($SYS, IPfilterS) holds the allow/deny data. They are a */ /* sequence of records, terminated by a two-byte "allow all" or */ /* "deny all" record. Every other record is ten bytes long: */ /* allow flag 1 byte */ /* type 1 byte */ /* address 4 bytes */ /* mask, count, or upper bound 4 bytes */ /* The record types are: */ /* 0 end of list */ /* 1 address and mask */ /* 2 single address */ /* 3 address and bit count */ /* 4 range */ /* For type 2, the mask field must be 0FFFFFFFFH. */ /****************************************************************/