Network Translations

Problem this snippet solves:

This iRule translates (SNAT) the network bits of the client IP (it keeps the host bits).
It requires a data group dg_network_translations of type Address.
Example:
* Entry in the data group: 1.1.1.0/24 := 10.10.10.0
* Client IP: 1.1.1.5 -> 10.10.10.5

How to use this snippet:

Create the data group. Make sure its name matches the name in the iRule (default name of the data group is "dg_network_translations", and load the iRule on a Virtual Server.
Uncomment the debug lines to test/troubleshoot.

Code :

# Gregory Thiell - 2016-11-15
# This iRule translates (SNAT) the network bits of the client IP (it keeps the host bits).
# It requires a data group dg_network_translations of type Address
# Example:
# - Entry in the data group: 1.1.1.0/24 := 10.10.10.0
# - Client IP: 1.1.1.5 -> 10.10.10.5

# Procedures for hex conversion -- from http://wiki.tcl.tk/8909

proc IPtoHex { IP } {
  binary scan [binary format c4 [split $IP .]] H8 Hex
  return $Hex
}
proc hexToIP { Hex } {
  binary scan [binary format H8 $Hex] c4 IPtmp
  foreach num $IPtmp {
    # binary scan "c" format gives signed int - the following
    # [expr]-ology converts to unsigned (from [binary] manpage)
    lappend IP [expr ($num + 0x100) % 0x100]
  }
  set IP [join $IP .]
  return $IP
}
proc CIDRtoHexNetmask { CIDR } {
  set zeros [expr 32 - $CIDR]
  set ones $CIDR
  set binaryCIDR [string repeat 1 $ones]
  append binaryCIDR [string repeat 0 $zeros]
  binary scan [binary format B32 $binaryCIDR] H8 HexNetmask
  return $HexNetmask
}

when RULE_INIT {
  set static::dg_net_tsl "dg_network_translations"
}

when CLIENT_ACCEPTED {

  set original_ip [IP::client_addr]
  
# Debug -- To overwrite original_ip
#  set original_ip 1.1.1.5
  
# Read Data Group
  set dg_elements [class match -element $original_ip equals $static::dg_net_tsl]
  set original_network [getfield [lindex $dg_elements 0] "/" 1]
  set cidr [getfield [lindex $dg_elements 0] "/" 2]
  set translated_network [lindex $dg_elements 1]
  
  if { $dg_elements != "" } {
    
  # Hex conversion
    set hex_original_ip [call IPtoHex $original_ip]
    set hex_netmask [call CIDRtoHexNetmask $cidr]
    set hex_translated_network [call IPtoHex $translated_network]
    
  # Calculate the hostmask (= inverted netmask)
    set hex_hostmask [expr 0x$hex_netmask ^ 0xffffffff]
    binary scan [binary format I $hex_hostmask] H8 hex_hostmask
    set hostmask [call hexToIP $hex_hostmask]
    
  # Extract the host bits (bit-wise AND between original_ip and hostmask)
    set hex_host [expr 0x$hex_original_ip & 0x$hex_hostmask]
    binary scan [binary format I $hex_host] H8 hex_host
    set host [call hexToIP $hex_host]
    
  # Translate the network bits (bit-wise OR between host bits and translated_network)
    set hex_translated_ip [expr 0x$hex_host | 0x$hex_translated_network]
    binary scan [binary format I $hex_translated_ip] H8 hex_translated_ip
    set translated_ip [call hexToIP $hex_translated_ip]
    
  # SNAT
    snat $translated_ip
    
  # Debug -- Log
    
#    log local0. "Client IP (dec, hex): ($original_ip, $hex_original_ip)"
#    log local0. "Original network (dec): ($original_network)"
#    log local0. "Netmask (CIDR, hex): ($cidr, $hex_netmask)"
#    log local0. "Translated network (dec, hex): ($translated_network, $hex_translated_network)"
#    log local0. "Hostmask (dec, hex): ($hostmask, $hex_hostmask)"
#    log local0. "Host (dec, hex): ($host, $hex_host)"
#    log local0. "Translated IP (dec, hex): ($translated_ip, $hex_translated_ip)"
    
  }
}

Tested this on version: