Obtaining country and owner of a given IP

This section contains scripts that hMailServer has contributed with. hMailServer 5 is needed to use these.
Post Reply
ObiWan
Senior user
Senior user
Posts: 278
Joined: 2010-07-21 14:30
Location: Halfway between Germany and Egypt

Obtaining country and owner of a given IP

Post by ObiWan » 2010-07-28 18:35

The following script can be "linked" to the hMailServer connect event
and will allow you to run DNS queries to retrieve the IP country (TLD)
and the "organization" owning the IP; those infos may then be used
to make decision about accepting or rejecting the transaction

Code: Select all

'::::::::: GLOBALS :::::::::::::::
Dim goDNS ' global DNS object
':::::::::::::::::::::::::::::::::

' returns the owner of a given IP
Function GetIPowner(sIPaddr)
  Dim sQuery, sResult, nPos
  Dim vaData, iData, nCol

  On Error Resume Next
  GetIPowner = ""
  If IsPrivateIP(sIPaddr) Then
    ' private IP, skip the check
    Exit Function
  End If
  If Not InitDNS(vbTab) Then
    ' failed to init the resolver object
    Exit Function
  End If

  ' run the DNS query
  sQuery = ReverseIP(sIPaddr) & ".sa.senderbase.org."
  sResult = QueryDNS(sQuery, "TXT")
  If Len(sResult) < 1 Then
    ' no available infos
    Exit Function
  End If

  ' handle multiple records
  vaData = Split(sResult, vbTab)
  For iData = LBound(vaData) To UBound(vaData)
    If Mid(vaData(iData), 2, 1) = "-" Then
      vaData(iData) = Mid(vaData(iData), 3)
    End If
  Next    
  sResult = Join(sResult, "|")

  ' now split the columns and seek the infos
  vaData = Split(sResult, "|")
  sResult = ""
  For iData = LBound(vaData) To UBound(vaData)
    nPos = InStr(1, vaData(iData), "=")
    If nPos > 0 Then
      nCol = CInt("0" & Mid(vaData(iData), 1, nPos - 1))
      If nCol = 1 Then
        ' column #1 contains the orgname
        sResult = Trim(Mid(vaData(iData), nPos + 1))
        Exit For
      End If
    End If
  Next    
  
  ' all done
  GetIPowner = sResult
End Function

' returns the country TLD for the given IP
Function GetIPcountry(sIPaddr)
  Dim sQuery
  
  On Error Resume Next
  GetIPcountry = ""
  If IsPrivateIP(sIPaddr) Then
    ' private IP, skip the check
    Exit Function
  End If
  If Not InitDNS(vbTab) Then
    ' failed to init the resolver object
    Exit Function
  End If
  
  ' run the DNS query
  sQuery = ReverseIP(sIPaddr) & ".zz.countries.nerd.dk."
  GetIPcountry = QueryDNS(sQuery, "TXT")
End Function

' true = the IP is a private one
Function IsPrivateIP(sIP)
  Dim vaOct

  On Error Resume Next  
  IsPrivateIP = True
  vaOct = Split(sIP, ".")
  If (vaOct(0) = "10") Or (vaOct(0) = "127") Then
    Exit Function ' 10/8 or 127/8
  End If
  If (vaOct(0) = "192") And (vaOct(1) = "168") Then
    Exit Function ' 192.168...
  End If
  If (vaOct(0) = "169") And (vaOct(1) = "254") Then
    Exit Function ' 169.254... (APIPA)
  End If
  If (vaOct(0) = "172") Then
    If (vaOct(1) >= "16") And (vaOct(1) <= "31") Then
      Exit Function ' 172.16/12
    End If
  End If
  IsPrivateIP = False
End Function

' reverses a given IP address
Function ReverseIP(sIP)
  Dim vaOct, iOct, sRev
  
  On Error Resume Next
  vaOct = Split(sIP, ".")
  sRev = ""
  For iOct = UBound(vaOct) To LBound(vaOct) Step -1
    sRev = sRev & "." & vaOct(iOct)
  Next
  ReverseIP = Mid(sRev, 2)
End Function

' initialize the resolver object
Function InitDNS(sRecSep)
  Dim sSrv
  
  On Error Resume Next
  InitDNS = False
  Set goDNS = CreateObject("Emmanuel.SimpleDNSClient")
  With goDNS
    .FindServerAddresses sSrv   ' optional
    '.ServerAddresses = sSrv    ' optional
    .Separator = sRecSep        ' results record separator
  End With
  If Err.Number <> 0 Then
    trace "InitDNS() ERR: 0x" & Hex(Err.Number) & " " & Err.Description
    Exit Function
  End If
  InitDNS = True
End Function

' runs a DNS query
Function QueryDNS(sQuery, sType)
  Dim sResult, sRR
  
  On Error Resume Next
  QueryDNS = ""
  sRR = sType
  If sRR = "TXT" Then
    sRR = "TEXT"    ' special case
  End If
  sRR = "T_" & sRR  ' add the required prefix
  
  ' send out the query
  goDNS.Resolve sQuery, sResult, "C_IN", sRR
  If Err.Number <> 0 Then
    trace "QueryDNS() ERR: 0x" & Hex(Err.Number) & " " & Err.Description
    Exit Function
  End If
  
  ' all ok
  QueryDNS = sResult
End Function

' trace
Sub trace(sMsg)
  ' add code to trace msgs/errors
End Sub
note that to use the above script you'll need to pick the DNS resolver object from
this site or use the attached one; the latter is the same object, I just fixed some
minor bugs in the code and rebuilt it; in either case, place the DLL in whatever
suitable folder and register it (regsvr32...); from that point on you'll be able
to call the "GetIPowner(sIPaddr)" or the "GetIPcountry(sIPaddr)" to retrieve
a given IP owner or country

HTH

[edit]

if you'll need to add some trace/debug code to the script, just insert some logging code
inside the trace function and add "trace()" calls where desired
Attachments
SimpleDNSResolver.zip
COM Wrapper for the Win32 DNS resolver API
(26.09 KiB) Downloaded 274 times

ObiWan
Senior user
Senior user
Posts: 278
Joined: 2010-07-21 14:30
Location: Halfway between Germany and Egypt

Re: Obtaining country and owner of a given IP

Post by ObiWan » 2010-07-29 17:30

Since we're at it... here's another "version" of that script; this
one is more "generic" since it will allow to retrieve a bunch of
infos and also embeds some "utility functions" (but uses the
same COM DLL used in the previous one)

Code: Select all

'=================================================================
' DNS query code and service functions start here
'=================================================================

Dim goDNS ' global DNS resolver object

' retrieves origin/peer/ASN infos from CYMRU
Function GetCYdata(sData, nType)
  Dim sQuery, sResponse
  Dim vaRec, iRec
  Dim vaCol, iCol
  Dim vaAsn, iAsn
  
  On Error Resume Next
  GetCYdata = ""
  
  ' check query type
  Select Case nType
    Case 1            ' route origin
      sQuery = ReverseIP(sData) & ".origin.asn.cymru.com."
    Case 2            ' route peers
      sQuery = ReverseIP(sData) & ".peer.asn.cymru.com."
    Case 3            ' ASN infos
      sQuery = "as" & sData & ".asn.cymru.com."
    Case Else         '
      GetCYdata = ""      
      Exit Function
  End Select
  
  ' run the query, check results
  sResponse = DNSquery(sQuery, "TXT")
  If Len(sResponse) < 1 Then
    Exit Function ' no result
  End If

  ' handle records
  vaRec = Split(sResponse, vbLf)
  For iRec = LBound(vaRec) To UBound(vaRec)
    sResponse = Trim(vaRec(iRec))
    vaCol = Split(sResponse, "|")
    For iCol = LBound(vaCol) To UBound(vaCol)
      vaCol(iCol) = Trim(vaCol(iCol))   ' trim spaces
    Next
    sResponse = Join(vaCol, "|")
    ' do we have multiple ASN in a single record ?
    If InStr(1, vaCol(0), " ") > 0 Then
      ' build a buffer with record data w/o the ASN
      sResponse = ""
      For iCol = 1 To UBound(vaCol)
        sResponse = sResponse & "|" & vaCol(iCol)
      Next        
      ' split the ASN and rebuild the array
      vaAsn = Split(vaCol(0), " ")
      For iAsn = LBound(vaAsn) To UBound(vaAsn)
        vaAsn(iAsn) = vaAsn(iAsn) & sResponse
      Next
      sResponse = Join(vaAsn, vbLf) ' multiple ASN records
    Else
      sResponse = Join(vaCol, "|")  ' single ASN record
    End If
    vaRec(iRec) = sResponse
  Next    

  ' all done, return the records "array"
  ' records are separated by vbLf, columns
  ' by the pipe char, each record contains
  ' ASN|CIDR|COUNTRY|SOURCE|LASTUPD
  ' or, in case of ASN queries
  ' ASN|COUNTRY|SOURCE|LASTUPD|OWNER
  GetCYdata = Join(vaRec, vbLf)
End Function

' retrieves senderbase data for a given IP
'
'   0 => 'version_number',
'   1 => 'org_name',
'   2 => 'org_daily_magnitude',
'   3 => 'org_monthly_magnitude',
'   4 => 'org_id',
'   5 => 'org_category',
'   6 => 'org_first_message',
'   7 => 'org_domains_count',
'   8 => 'org_ip_controlled_count',
'   9 => 'org_ip_used_count',
'  10 => 'org_fortune_1000',
'  
'  20 => 'hostname',
'  21 => 'domain_name',
'  22 => 'hostname_matches_ip',
'  23 => 'domain_daily_magnitude',
'  24 => 'domain_monthly_magnitude',
'  25 => 'domain_first_message',
'  26 => 'domain_rating',
'  
'  40 => 'ip_daily_magnitude',
'  41 => 'ip_monthly_magnitude',
'
'  43 => 'ip_average_magnitude',
'  44 => 'ip_30_day_volume_percent',
'  45 => 'ip_in_bonded_sender',
'  46 => 'ip_cidr_range',
'  47 => 'ip_blacklist_score',
'  
'  50 => 'ip_city',
'  51 => 'ip_state',
'  52 => 'ip_postal_code',
'  53 => 'ip_country',
'  54 => 'ip_longitude',
'  55 => 'ip_latitude',
'
Function GetSBdata(sIP)
  Dim sQuery, sResponse
  Dim vaRec, iRec
  Dim vaCol, nCol, nPos
  
  On Error Resume Next
  GetSBdata = ""

  ' run the query, check results  
  sQuery = ReverseIP(sIP) & ".test.senderbase.org."
  sResponse = DNSquery(sQuery, "TXT")
  If Len(sResponse) < 1 Then
    Exit Function ' no result
  End If
  
  ' split results records
  vaRec = Split(sResponse, vbLf)
  For iRec = LBound(vaRec) To UBound(vaRec)
    sResponse = Trim(vaRec(iRec))
    If Mid(sResponse, 1, 1) = "|" Then
      sResponse = Mid(sResponse, 2)   ' remove leading "|"
    End If
    If Mid(sResponse, 2, 1) = "-" Then
      sResponse = Mid(sResponse, 3)   ' remove record#
    End If
    vaRec(iRec) = sResponse
  Next
  sResponse = Join(vaRec, "|")        ' build a single record

  ' turn the results in a positional "array"
  ReDim vaCol(100)                    
  vaRec = Split(sResponse, "|")
  For iRec = LBound(vaRec) To UBound(vaRec)
    sResponse = vaRec(iRec)
    nPos = InStr(1, sResponse, "=")
    If nPos > 0 Then
      nCol = CInt("0" & Mid(sResponse, 1, nPos - 1))  ' column #
      If nCol <= 100 Then
        vaCol(nCol) = Trim(Mid(sResponse, nPos + 1))  ' value
      End If
    End If
  Next
  
  ' all done return the columns "array"
  ' splitting the string into an array will
  ' result in a positional array, so to get
  ' the IP city you'll just have to pick
  ' the array element #50
  GetSBdata = Join(vaCol, "|")    
End Function

' true = the IP is valid
Function IsValidIP(sIP)
  Dim sBuff, vaOct, iOct, nOct
  
  On Error Resume Next
  IsValidIP = False
  sBuff = Trim(sIP)
  If Len(sBuff) < 1 Then
    Exit Function
  End If
  If InStr(1, sBuff, ".") < 1 Then
    Exit Function
  End If
  vaOct = Split(sBuff, ".")
  If UBound(vaOct) <> 3 Then
    Exit Function
  End If
  For iOct = LBound(vaOct) To UBound(vaOct)
    If Not IsNumeric(vaOct(iOct)) Then
      Exit Function
    End If
    nOct = CInt(vaOct(iOct))
    If (nOct < 0) Or (nOct > 255) Then
      Exit Function
    End If
  Next
  IsValidIP = True
End Function

' true = the IP is a "private" one
Function IsPrivateIP(sIP)
  Dim vaOct
  
  On Error Resume Next
  IsPrivateIP = True
  vaOct = Split(sIP, ".")
  If (vaOct(0) = "10") Or (vaOct(0) = "127") Then
    Exit Function     ' 10/8
  End If
  If (vaOct(0) = "169") And (vaOct(1) = "254") Then
    Exit Function     ' 169.254/16 (APIPA)
  End If
  If (vaOct(0) = "192") And (vaOct(1) = "168") Then
    Exit Function     ' 192.168/16 (used as /24)
  End If
  If vaOct(0) = "172" Then
    If (vaOct(1) > "15") And (vaOct(1) < "32") Then
      Exit Function   ' 172.16/12
    End If
  End If
  IsPrivateIP = False
End Function

' reverses an IP address
Function ReverseIP(sIP)
  Dim vaOct, iOct
  Dim sRet
  
  On Error Resume Next
  vaOct = Split(sIP, ".")
  For iOct = UBound(vaOct) To LBound(vaOct) Step -1
    sRet = sRet & "." & vaOct(iOct)
  Next
  ReverseIP = Mid(sRet, 2)  
End Function

' init/reset DNS engine
Function DNSengine(bStart)
  Dim sDNS
  
  On Error Resume Next
  Set goDNS = Nothing
  If bStart = True Then
    Err.Clear
    Set goDNS = CreateObject("Emmanuel.SimpleDNSclient.1")
    If Err.Number <> 0 Then
      printerr "DNSengine(" & bStart & ")"
      DNSengine = False
      Exit Function
    End If
    goDNS.FindServerAddresses sDNS
    goDNS.Separator = vbLf ' records separator
  End If
  DNSengine = True
End Function

' run a DNS query
Function DNSquery(sQuery, sType)
  Dim sQClass, sQType, sResponse

  On Error Resume Next
  sResponse = ""
  DNSquery = sResponse
  sQType = UCase(sType)
  If sQType = "TXT" Then
    sQType = "TEXT"
  End If
  sQClass = "C_IN"
  sQType = "T_" & sQType
  Err.Clear
  goDNS.Resolve sQuery, sResponse, sQClass, sQType
  If Err.Number <> 0 Then
    DNSquery = "" '' "0x" & Hex(Err.Number) & ": " & Err.Description
    Exit Function
  End If
  DNSquery = Trim(sResponse)
End Function
to test the above code, you may just save it as (e.g.) "nsfunc.vbs"
then, just add the following to the top (or bottom) of the script

Code: Select all

':::::::::::::: TEST CODE BELOW :::::::::::::::::::::::::
Dim arg
Set arg = WScript.Arguments
WScript.Quit main(arg.Count, arg)

Function main(argc, argv)
  Dim sRet, vaRet, iRet
  Dim sIP
  Dim vaCol

  sIP = "208.67.222.222" ' argv(0)

  ' check if the IP is valid and not private
  If Not IsValidIP(sIP) Then
    main = 1
    Exit Function
  End If
  If IsPrivateIP(sIP) Then
    main = 1
    Exit Function
  End If

  ' init the DNS resolver object
  If DNSengine(True) = False Then
    main = 1
    Exit Function
  End If

  ' route origin (Team CYMRU)
  sRet = GetCYdata(sIP, 1) ' 1=origin infos
  If Len(sRet) < 1 Then
    main = 2
    Exit Function
  End If
  WScript.StdOut.WriteLine ":: =========== Route origin "
  ' ASN|CIDR|COUNTRY|SOURCE|LASTUPD
  vaRet = Split(sRet, vbLf)
  For iRet = LBound(vaRet) To UBound(vaRet)
    WScript.StdOut.WriteLine vaRet(iRet)
  Next    

  ' ASN infos about route origin(s)
  WScript.StdOut.WriteLine ":: =========== Route origin AS owners"
  'ASN|COUNTRY|SOURCE|LASTUPD|OWNER
  For iRet = LBound(vaRet) To UBound(vaRet)
    vaCol = Split(vaRet(iRet), "|") ' get record columns
    sRet = GetCYdata(vaCol(0), 3) ' 3=ASN infos
    If Len(sRet) > 0 Then
      WScript.StdOut.WriteLine sRet
    End If
  Next    

  ' route peers (Team CYMRU)
  sRet = GetCYdata(sIP, 2) ' 2=route infos
  If Len(sRet) < 1 Then
    main = 2
    Exit Function
  End If
  WScript.StdOut.WriteLine ":: =========== Route peering"
  ' ASN|CIDR|COUNTRY|SOURCE|LASTUPD
  vaRet = Split(sRet, vbLf)
  For iRet = LBound(vaRet) To UBound(vaRet)
    WScript.StdOut.WriteLine vaRet(iRet)
  Next    
  
  ' ASN infos about route peers
  WScript.StdOut.WriteLine ":: =========== Route peering AS owners"
  'ASN|COUNTRY|SOURCE|LASTUPD|OWNER
  For iRet = LBound(vaRet) To UBound(vaRet)
    vaCol = Split(vaRet(iRet), "|") ' get record columns
    sRet = GetCYdata(vaCol(0), 3) ' 3=ASN infos
    If Len(sRet) > 0 Then
      WScript.StdOut.WriteLine sRet
    End If
  Next    

  ' IP informations (senderbase)
  sRet = GetSBdata(sIP)
  If Len(sRet) < 1 Then
    main = 3
    Exit Function
  End If
  WScript.StdOut.WriteLine ":: =========== Senderbase"
  ' positional array
  vaCol = Split(sRet, "|")
  For iRet = LBound(vaCol) To UBound(vaCol)
    sRet = Trim(vaCol(iRet))
    If Len(sRet) > 0 Then
      WScript.StdOut.WriteLine Left(iRet & String(10, "."), 10) & ": " & vaCol(iRet)
    End If      
  Next  
  Call DNSengine(False)  
  main = 0      
End Function
':::::::::::::: TEST CODE ABOVE :::::::::::::::::::::::::
at this point, save the script again and run it through "cscript"
to see the output; I kept the test code quite simple, but it should
allow you to understand how things work

Some notes:

The "CYMRU" queries for IPs may return a single record or multiple
records and in either case, any record may contain multiple ASNs
so the code takes care of that by "exploding" such records so that
the returned results will contain an ASN in each record; on the other
hand, queries related to ASN infos (querytype = 3) will usually return
a single record so you may safely skip the record splitting for those

As for the senderbase, in some cases a query may result in a single
record being splitted amongst a number of answers; the code takes
care of that and also transforms the "tagged" results returned by
senderbase into a "positional" array so that (e.g.) element #50 will
contain the ip city while element #1 will contain the IP owner name

The code also contains generic functions like the ones related to IP
addresses (isvalidip, isprivateip, reverseip) and the one allowing to
run DNS queries; those may be easily used for other purposes (or
at least I hope so)

HTH

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Obtaining country and owner of a given IP

Post by percepts » 2010-08-04 16:20

Haven't tried it but I'm sure it works. One word of caution though, I used reverse dns lookups for web stats before and it was very slow. If mail traffic to your server is light you probably won't notice a performance hit. But if your mail server is busy receiving a lot of email, then you may find you get a performance hit.

ObiWan
Senior user
Senior user
Posts: 278
Joined: 2010-07-21 14:30
Location: Halfway between Germany and Egypt

Re: Obtaining country and owner of a given IP

Post by ObiWan » 2010-08-04 18:41

percepts wrote:Haven't tried it but I'm sure it works. One word of caution though, I used reverse dns lookups for web stats before and it was very slow. If mail traffic to your server is light you probably won't notice a performance hit. But if your mail server is busy receiving a lot of email, then you may find you get a performance hit.
Just a note; PTR queries (reverse lookups) may be really sloooow, I agree about that; but this isn't the case, the zone servers answer immediately with either a response or an NXDOMAIN, so you won't experience the slowdown which happens with PTR queries

HTH

[edit]

PTR type queries may take quite long, since in many case there's no PTR or the AUTH server for the given IP block won't answer at all, this in turn means that the client will have to wait until the timeout expires; on the other hand, senderbase/cymru queries will always get back an immediate answer (even if it's an NXDOMAIN one)

percepts
Senior user
Senior user
Posts: 5282
Joined: 2009-10-20 16:33
Location: Sceptred Isle

Re: Obtaining country and owner of a given IP

Post by percepts » 2010-08-04 19:09

Iechyd da !

ObiWan
Senior user
Senior user
Posts: 278
Joined: 2010-07-21 14:30
Location: Halfway between Germany and Egypt

Re: Obtaining country and owner of a given IP

Post by ObiWan » 2010-08-04 19:12

percepts wrote:Iechyd da !
Thanks :D

Post Reply