/*
   OS/2 REXX script for the banip module.

   The script is called when bans are created or removed and makes changes to
   the system file %ETC%\SECURITY\FWFILTRS.CNF, which describes the firewall
   rules.

   Rules are created and deleted in the block that starts with line

     # --- banip.cmd: Begin ---

   and ends with line

     # ---- banip.cmd: End ----

   You can freely move this block inside the FWFILTRS.CNF file using any text
   editor. The script will make changes only in this block. If the block is
   missing (the start or end line is not found), a new one will be created at
   the beginning of the file.

   Please refer to the documentation or configuration file comments to
   understand how to configure the script call.


   Arguments passed to the script from the BanIP module:

     1. Pool Name (in quotes).

     2. IP address.

     3. Operation code - a positive decimal integer.

        ORed bits:
          bit 0 (0x01) cleared - ban removed,
          bit 0 (0x01) is set  - new ban created,
          bit 1 (0x02) is set  - not the first time a ban has been created,
          bit 2 (0x04) is set  - automatic action, i.e. not initiated by the
                                 administrator.

        In the form of values:
          0 - the administrator removed the ban,
          1 - the administrator has created a permanent ban,
          4 - the ban has expired (removed automatically),
          5 - new ban has been created automatically,
          7 - ban created automatically again.

     4. Expiry time (in quotes, optional).

        Timestamp in the future, format: YYYY-MM-DD HH:MM:SS
        Present only if a temporary ban is created.
*/


/* ************************************************************************ */
/*                                Properties                                */
/* ************************************************************************ */

/* Uncomment the following line to write to the log file. */
/* logFile = "banip.log" */


/* Number of backup files.
   Files will rotate when changes are made, like:
     %ETC%\SECURITY\FWFILTRS.CNF
     %ETC%\SECURITY\FWFILTRS.000
     %ETC%\SECURITY\FWFILTRS.001
*/
iBackupFiles = 4


/* Lists of ports corresponding to pools.
   If ports are not specified for a pool (the pool is not in the list), then
   all ports will be closed for banned IPs. */

aPorts.0 = 4                       /* The number of pools in this list. */

aPorts.1.!POOL  = "SMTP"           /* Pool name. */
aPorts.1.!PORTS = "25 465 587"     /* Space separated list of ports. */

aPorts.2.!POOL  = "POP3"
aPorts.2.!PORTS = "110 995"

aPorts.3.!POOL  = "IMAP"
aPorts.3.!PORTS = "143 993"

aPorts.4.!POOL  = "mail-reader"
aPorts.4.!PORTS = "106 110 143 993 995"


/* ************************************************************************ */
/* ************************************************************************ */


parse source s1 s2 sScript
sScript = filespec( "name", sScript )
sBeginBanIPRules = "# --- " || sScript || ": Begin ---"
sEndBanIPRules   = "# ---- " || sScript || ": End ----"


/* Read arguments */

parse arg sArg
if getarg(sArg) < 3 | \is_ip(aArg.2) | wordpos(aArg.3,"0 1 4 5 7") = 0 then
  call die "This script is intended to be called from the banip module."

sPool = aArg.1  /* aArg.1 - Pool Name.  */ 
sAddr = aArg.2  /* aArg.2 - IP address. */


/* Prepare a message for the comment and logfile.

     sMessage
*/

/* aArg.3 - Operation code */
select
  when aArg.3 = 0 then sOp = "ban removed by administrator"
  when aArg.3 = 1 then sOp = "permanent ban created by administrator"
  when aArg.3 = 4 then sOp = "ban expired"
  when aArg.3 = 5 then sOp = "ban created automatically"
  when aArg.3 = 7 then sOp = "ban created automatically again"
end

if aArg.3 = 5 | aArg.3 = 7 then
do
  if aArg.0 > 3 then
    sOp = sOp || " (expires " || aArg.4 || ")"  /* aArg.4 - Expiry time */
  else
    sOp = sOp || " (permanent)"
end

sMessage = '"' || sPool || '", ' || sAddr || ' - ' || sOP

if symbol( "logFile" ) = "VAR" then
  call log "Pool " || sMessage

sMessage = date() || ' ' || time() || " " || sMessage



/* Find port list for the given pool

     sPorts - a string containing space separated port numbers.
*/

sPorts = ""
do i = 1 to aPorts.0
  if translate( aPorts.i.!POOL ) = translate( sPool ) then
  do
    sPorts = aPorts.i.!PORTS
    leave
  end
end


/* Load firewall rules from %ETC%\SECURITY\FWFILTRS.CNF.

     sFile           - full filename,
     aFile.n         - lines read from file,
     iBeginRulesLine - the line number from which the block of rules created
                       by this script begins.
     iEndRulesLine   - the number of the last line of the block.

     iBeginRulesLine and iEndRulesLineare are zero if the block is not found.
*/

iBeginRulesLine = 0
iEndRulesLine = 0

sFile = value( "ETC",, "OS2ENVIRONMENT" ) || "\SECURITY"
if stream( sFile, "c", "QUERY DATETIME" ) = "" then
  call die "The %ETC%\SECURITY directory does not exist"

sFile = sFile || "\FWFILTRS.CNF"
if stream( sFile, "c", "QUERY EXISTS" ) = "" then do
  call log sFile || " does not exist, a new one will be created."
  aFile.0 = 0
end
else do
  i = 0
  sBeginBanIPRulesUpc = translate(sBeginBanIPRules)
  sEndBanIPRulesUpc = translate(sEndBanIPRules)

  do while lines( sFile ) = 1
    i = i + 1
    aFile.i = linein( sFile )
    parse upper value space( aFile.i, 1 ) with sLine
    if sLine = sBeginBanIPRulesUpc then
      iBeginRulesLine = i
    else if iBeginRulesLine \= 0 & sLine = sEndBanIPRulesUpc then
      iEndRulesLine = i
  end

  drop sBeginBanIPRulesUpc  sEndBanIPRulesUpc  sLine

  if iEndRulesLine = 0 then
   iBeginRulesLine = 0

  aFile.0 = i

  call stream sFile, 'c', 'close'
end


/* Delete existing rules for the specified pool and address. */

if iEndRulesLine \= 0 then
do
  do i = iBeginRulesLine to iEndRulesLine
    if left(aFile.i, 1) = "#" then
    do
      parse var aFile.i '# ' nFDay sFMonth nFYear sFTime '"' sFPool '", ',
                sFAddr " - " sFOp
      if sFPool \= sPool | sFAddr \= sAddr then
        iterate
    end
    else if left(aFile.i, 5) = "deny " then do
      parse var aFile.i "deny " sFAddr " 255.255.255.255 0 0 tcp any 0 ",
                sPortCmp " " iFPort " both local inbound"
      if ( sPortCmp \= "eq" & sPortCmp \= "any" ) | \is_uint( iFPort ) |,
         sFAddr \= sAddr then
        iterate

      if sPorts = "" then
      do
        /* Ports for the pool are not specified in the configuration part of
           the script (any connections from the banned address are blocked). */

        if sPortCmp \= "any" | iFPort \= "0" then
          iterate
      end
      else do
        if sPortCmp \= "eq" | wordpos(iFPort, sPorts) = 0 then
          iterate
      end
    end
    else
      iterate

    /* A row for the given pool and IP was found. Mark it for deletion. */

    aFile.i = x2c("01")  /* Deleted line indicator. */
  end
end   /* if iEndRulesLine \= 0 then */


/* Creating new rules.

   iInsLine     - the line number of the source file starting from which new
                  lines will be inserted,
   aNewLines.n  - new lines to insert.
*/

iInsLine = 0
aNewLines.0 = 0

if wordpos(aArg.3,"1 5 7") \= 0 then do
  /* The operation to create a ban has been specified. */

  iLine = 0

  if iBeginRulesLine \= 0 then do
    iInsLine = iBeginRulesLine + 1
  end
  else do
    iInsLine = 1

    iLine = iLine + 1
    aNewLines.iLine = sBeginBanIPRules
  end

  iCount = words( sPorts )

  iLine = iLine + 1
  aNewLines.iLine = "# " || sMessage

  if iCount = 0 then do
    /* Ports for the pool are not specified in the configuration part of the
       script (any connections from the banned address are blocked).  */

    iLine = iLine + 1
    aNewLines.iLine = "deny " || sAddr ||,
                      " 255.255.255.255 0 0 tcp any 0 any 0 both local inbound"
  end
  else do
    do i = 1 to iCount
      iLine = iLine + 1
      aNewLines.iLine = "deny " || sAddr ||,
                        " 255.255.255.255 0 0 tcp any 0 eq " ||,
                        word( sPorts, i ) || " both local inbound"
    end
  end


  if iBeginRulesLine = 0 then do
    iLine = iLine + 1
    aNewLines.iLine = sEndBanIPRules
    iLine = iLine + 1
    aNewLines.iLine = ""
  end

  aNewLines.0 = iLine
end  /* if wordpos(aArg.3,"1 5 7") \= 0 then */


/* Write the result to a temporary file.

     sTempFile - output file (%ETC%\SECURITY\FWFILTRS.~NF),
     sFilePath - path for FWFILTRS.CNF (%ETC%\SECURITY),
     sFileExt  - FWFILTRS.CNF file extension ("CNF"),
     sFileName - FWFILTRS.CNF file name w/o extension ("FWFILTRS").
*/

sFilePath = filespec( "drive", sFile ) || filespec( "path", sFile )
parse value filespec( "name", sFile ) with sFileName "." sFileExt

sTempFile = sFilePath || sFileName || '.~' || substr( sFileExt, 2 )
call delFile sTempFile

if aFile.0 == 0 then
  /* Source file is empty. Write only block lines. */

  do j = 1 to aNewLines.0
    call lineout sTempFile, aNewLines.j
  end
else
do i = 1 to aFile.0
  if i = iInsLine then do
    do j = 1 to aNewLines.0
      call lineout sTempFile, aNewLines.j
    end
  end

  if aFile.i \= x2c("01") then  /* Deleted line indicator */
    call lineout sTempFile, aFile.i
end

call stream sTempFile, 'c', 'close'

/* Checking the new firewall rules file for errors. */

'@cfgfilt -f "' || sTempFile || '" >nul'
if rc \= 0 then
  call die "Validation of the firewall rules file " || sTempFile || " failed"



/* Rotate backup files and rename the created temporary file to the name of
   the target file.
*/

if iBackupFiles = 0 then
  call delFile sFile
else
do
  iBackupFiles = iBackupFiles - 1

  sBackupFile = sFilePath || sFileName || "." || right( iBackupFiles, 3, "0" )
  call delFile sBackupFile

  do i = iBackupFiles - 1 to 0 by -1
    sBackupFile = sFilePath || sFileName || "." || right( i, 3, "0" )

    if stream( sBackupFile, "c", "query exists" ) \= "" then
      '@ren "' || sBackupFile || '" *.' || right( i+1, 3, "0" )
  end
  if stream( sFile, "c", "query exists" ) \= "" then
    '@ren "' || sFile || '" *.000'
end

'@ren "' || sTempFile || '" *.' || sFileExt


/* Notify the firewall of changes.
*/

cmd = "cfgfilt -u -i"

"@"cmd" >nul"
if rc \= 0 then
  call die "Failed to notify firewall of changes (command: " || cmd || ")"

/* Turn on the firewall.*/
"@inetcfg -s firewall 1"


EXIT


/* Utilites */


/* getarg(sInput)

   Fills aArg. stem with command line arguments from sInput. Unquotes quoted
   arguments. Returns the number of arguments read (as in aArg.0).
*/

getarg: procedure expose aArg.
  sInput = arg( 1 )
  do i = 1 by 1
    sArg = unquoteArg( sInput )
    if sArg = "" then do
      aArg.0 = i - 1
      leave
    end

    aArg.i = sArg
    sInput = sUQRem
  end
return aArg.0

unquoteArg: procedure expose sUQRem
  sStr = strip( arg(1) )
  if left(sStr,1) \= '"' then do
    sUQRem = substr( sStr, wordlength( sStr, 1 ) + 1 )
    return word( sStr, 1 )
  end

  sRes = ""
  iStrPos = 2
  do forever
    iPos = verify( sStr, '\"', "M", iStrPos )
    if iPos = 0 then do
      sStr = substr( sStr, iStrPos )
      sRes = sRes || sStr
      iStrPos = iStrPos + length(sStr)
      leave
    end

    sRes = sRes || substr( sStr, iStrPos, (iPos - iStrPos) )
    sCh = substr( sStr, iPos, 1 )
    if sCh = '"' then do
      iStrPos = iPos + 1
      leave
    end
    iPos = iPos + 1
    sCh = substr( sStr, iPos, 1 )
    sRes = sRes || sCh
    iStrPos = iPos + 1
  end

  sUQRem = substr( sStr, iStrPos )

  return sRes


die: procedure expose logFile sScript
  sMessage = "Error: " || arg(1)
  call log sMessage
  exit 1


log: procedure expose logFile sScript
  sMessage = "[" || date( "O" ) || " " || time() || "] " || arg(1)
  say sScript || ": " || sMessage
  if symbol( "logFile" ) = "VAR" & logFile \= "" then
  do
    call lineout logFile, sMessage
    call lineout logFile
  end
  return


is_uint: procedure
  sVal = strip( arg(1) )
  return sVal \= "" & verify( sVal, "0123456789" ) = 0

is_ip: procedure
  parse arg v1 "." v2 "." v3 "." v4
  return is_uint(v1) & v1 < 256 & is_uint(v2) & v2 < 256 & is_uint(v3) &,
         v3 < 256 & is_uint(v4) & v4 < 256

delFile: procedure
  sFile = strip( arg(1) )
  if stream( sFile, "c", "query exists" ) \= "" then
    '@del "' || sFile || '"'
  return
