Router Blackhole List - testiskripti

Tästä joko näppärästi mailiserverin perään filtteriksi tai kääri komponentiksi ja aja vasten mailiakkountteja.

Asenna ensin aspdnsx. Helppoa kuin heinänteko. Ohjeistusta osoitteesta http://www.internext.co.za/stefan/aspdnsx/

Copypaste alta soveltuvaan tiedostoon, tyyliin rbl.vbs

Komentorivillä sitten "CSCRIPT rbl.vbs [tiedostonimi]". Paluukoodi paljastaa osuiko (Jos ReverseCodes on True, nolla kertoo että spammia, ykkönen tai muu kertoo että ei ollut tahi skripti kaatui nenälleen). Jos aiot tunkata mailiserverin perään, käytännössä external executables tyypillisesti vaatii .BAT-tiedoston (eivät osaa suoraan ajaa vbs:ää). Sisältö noin suunnilleen (rbl.bat):

CSCRIPT rbl.vbs %1

(ja siinä se.)

' RBLTest.vbs v. 0.2
' (C) 2003 PLZI

Option Explicit
Const ForReading = 1
Const ForAppend = 8
Dim oArgs
Dim SafeServers, RBLServers,DNSServer
Dim RBLCount
Dim MailFile
Dim LogFileName, SessionStart
Dim SpamFound
Dim ReverseCodes, CodeErrorOrNoSpam, CodeSpamFound
Dim LogFso, LogTs
Dim CopyDir
Dim ExitWhenFound
Dim ToScreen
Dim dummy

'
' Settings for the script
'

' Local addresses to be skipped
SafeServers = "[127.0.0.1],[192.168.111.5],[195.156.165.6],[131.177.74.186],"
SafeServers = SafeServers & "[131.177.121.200],[131.177.130.26],[131.177.130.22]"

' RBL Server list to be used
RBLServers = Array("bl.spamcop.net","orbs.dorkslayers.com")

' DNS Server
DNSServer="192.168.111.1"

' Where to put the log
LogFileName="c:\rbltest.log"

' Where to copy the spam files
CopyDir="c:\mailserver\spam\"

' Exit with spamfound when first RBL match is found?
ExitWhenFound=True

' Reverse the exit codes? (Merak uses filter settings where 0 means blocking)
ReverseCodes=True

' Where to put the output, to log file or to screen?
ToScreen=True


If ReverseCodes Then
  CodeErrorOrNoSpam=1
  CodeSpamFound=0
Else
  CodeErrorOrNoSpam=0
  CodeSpamFound=1
End If

SpamFound=False
RBLCount = UBound(RBLServers)
SessionStart="[" & Date & " " & Time &"] - Program started"

Set LogFso = CreateObject("Scripting.FileSystemObject")
Set LogTs = LogFso.OpenTextFile(LogFileName, ForAppend, True)

WriteLog SessionStart

Set oArgs=WScript.Arguments
If oArgs.Count = 0 Then
  WriteLog VbTab & "file name argument missing - exiting with code " _
   & CodeErrorOrNoSpam
  Logts.close
  WScript.Quit (CodeErrorOrNoSpam)
Else
  MailFile=oArgs(0)
  Main
End If


If SpamFound Then
  dummy = copyto(MailFile)
  WriteLog "- end run with exit code " & CodeSpamFound & VbCrLf
  Logts.close
  WScript.Quit (CodeSpamFound)
Else
  WriteLog "- end run with exit code " & CodeErrorOrNoSpam & VbCrLf
  Logts.close
  WScript.Quit (CodeErrorOrNoSpam)
End if

Sub Main
Dim RBLTest 
Dim F,T
Dim dictIP
Dim Headers 
Dim IPKeys, IPKeyCount
Dim OneKey

  WriteLog VbTab & "Reading addresses from '" & MailFile & "'" 

  Headers = RipHeader(MailFile)
  Set dictIP = RegExpTest("\[[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+\]",Headers)

  WriteLog VbTab & dictIP.Count & " unique addresses found."

  IPKeys=dictIP.Keys
  IPKeyCount=UBound(IPKeys)
  If IPKeyCount>-1 Then
     For T=0 To RBLCount
      WriteLog VBTab & "testing against " & RBLServers(T)
      For F = IPKeyCount to 0 Step -1
      OneKey=CStr(IPKeys(F))
      If Instr(SafeServers,OneKey) Then
          WriteLog VbTab & OneKey & " is a local address-skipped"
        Else  
          RBLTest=CreateRBL(OneKey,RBLServers(T))
          If IsListed(RBLTest) Then
            SpamFound=True 
            WriteLog "***" & VbTab & OneKey & " is listed in RBL!"
            If ExitWhenFound Then 
              WriteLog VbTab & "stop processing (ExitWhenFound true)"
              Exit For
            End If
          Else
            WriteLog VbTab & OneKey & " (no match)"
          End If
        End If  
      Next
    If SpamFound And ExitWhenFound Then Exit For
    Next
  Else
    Writelog VBTab & "No addresses to test!"
  End If
End Sub


Function WriteLog(byval temp)
  If ToScreen then
    WScript.Echo temp
  Else
    Logts.WriteLine temp
  End If
End Function


' Check if address is listed in RBL(s)
Function IsListed (byval Check)
  Dim objDNS,Response
  Set objDNS = CreateObject("ASPDNSX.RealDNSLookup")
  objDNS.DNSServer = DNSServer
  objDNS.TimeOut = 10000
  Response = objDNS.GetIPFromName(Check)
  If Len(Response) = 0 Then  
    IsListed=False
  Else
    IsListed=True
  End If
  Set objDNS = Nothing
End Function


' Rip header from file
Function RipHeader(byval filename)
  Dim fso, f1, ts, Line, Output, EndHeaders
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set ts = fso.OpenTextFile(FileName, ForReading)
  EndHeaders=False
  Do Until ts.AtEndOfStream or EndHeaders
    Line = ts.ReadLine
    Output=Output & Line & VbCrLf   
    if Trim(Line)="" Then
      EndHeaders=True
    End If
   Loop
   ts.Close
   RipHeader=Output
End Function

' List all IP's in data
Function RegExpTest(patrn, strng)
  Dim regEx, Match, Matches 
  Dim dictIP
  Set dictIP=CreateObject("Scripting.Dictionary")
  Set regEx = New RegExp  
  regEx.Pattern = patrn   
  regEx.IgnoreCase = True 
  regEx.Global = True  
  Set Matches = regEx.Execute(strng) 
  For Each Match in Matches  
      If Not(dictIP.Exists(Match.Value)) Then ' remove duplicates
      dictIP.Add Match.Value,Match.FirstIndex
    End If
  Next
  Set RegExpTest = dictIP
End Function


' Create RBL FQDN from enclosed IP
Function CreateRBL (byval ip, byval RBL)
  Dim IPElements, NewIP, F
  ip=Replace(ip,"[","")
  ip=Replace(ip,"]","")
  IPElements=Split(ip,".")
  For F=UBound(IPElements) to 0 Step -1
    NewIP=NewIP & IPElements(F) & "."
  Next
  CreateRBL=NewIP & RBL
End Function

Function CopyTo (byval file)
  Dim fso, f2
  Dim LastSlash, BareFile, NewName

  LastSlash = InstrRev(file,"\")
  BareFile = mid(file,LastSlash+1)
  NewName = CopyDir & BareFile & ".spam.txt"
  WriteLog VbTab & " copying to name " & NewName

  Set fso = CreateObject("Scripting.FileSystemObject")
  Set f2 = fso.GetFile(file)
  f2.Copy (NewName)
  Set fso=Nothing

End Function