LDAP Proxy

Problem this snippet solves:

Summary: An LDAP proxy used send read/write requests to different pools.

For anyone that is interested, I recently was posed with the problem of proxying ldap requests. The requirement was to send read and write requests to different pools. As any familiar with ldap knows, you need to send a bind request to authenticate. The following will transparently resend the bind requests to the newly selected server prior to sending the new read/write request.

Other functionality could be added to this, such as more verification of the ldap fields to ensure a valid request is being made.

The expr commands could be optimized with proper bracing. See the TCL expr wiki page for details

Code :

class ldap_writes {
   6
   8
   10
   12
}

# v11 compatabile version


when RULE_INIT {
    # Read Pool
    set static::readPool sun_ldap_read

    # Write Pool
    set static::writePool sun_ldap_write

    # Turn on debugging
    set static::ldap_debug 0

    # A lookup table for debugging
    array set static::msg_types {
           0 "bind request"
           1 "bind response"
           2 "unbind request"
           3 "search request"
           4 "search response"
           6 "modify request"
           7 "modify response"
           8 "add request"
           9 "add response"
          10 "delete request"
          11 "delete response"
          12 "modifydn request"
          13 "modifydn response"
          14 "compare request"
          15 "compare response"
          16 "abandon request"
          23 "extended request"
          24 "extended response"
    }
}

when CLIENT_ACCEPTED {  
    set rebind 0
    set binding ""
    set replayop ""
    set writing 0
    TCP::collect
}

when CLIENT_DATA {
    # Grab the current payload collected
    set payload [TCP::payload]

    # Pull the first 2 bytes.  
    binary scan $payload H2c ber_t ber_len

    # The first byte is the tag signifying an LDAP message, 
    # Always is hex 30, if that is not so reject

    if { $ber_t ne "30" } {
        reject
        return
    }

    # The second byte is one of two values:
    #       a) The length of the packet minus the above
    #          defining byte and the length byte
    #    OR 
    #       b) an octet describing how many subsequent bytes
    #          hold the packet length
    # In either case the message type (what we are after)
    # follows the message id field which too can be a variable
    # number of bytes. 

    set len_bytes 0
    if { [expr {[expr {$ber_len + 0x100} % 0x100]} & 128] > 0 } {
set len_bytes [expr {[expr ($ber_len + 0x100) % 0x100]} & 127]
    }

    # How many bytes is the message id
    binary scan $payload x[expr {3 + $len_bytes}]c msgid_bytes

    # The message type is then 4 bytes + number length bytes + number of
    # message id bytes offset.
    binary scan $payload x[expr {4 + $len_bytes + $msgid_bytes}]c msgtype

    # msgtype - BER encoded value, bits 1-5 are the actual 
    # type, 6 is the data type, 7-8 are the data class  
    # Here we only care about the lower 5 bits
    set msgtype [expr {$msgtype & 31}]

    if {$static::ldap_debug and 
        [catch {
              log local0. "message type is: $static::msg_types($msgtype) $msgtype"
         }
        ] 
       } {
       log local0. "Bad message type: $msgtype"
       reject
    }

    # Each connection should start with a bind request
    # We'll save this packet for later rebinding when we 
    # flip between servers
    if { $msgtype == 0 } {
       if {$static::ldap_debug} {log local0. "Bind Request with: ldap_read"}
       set writing 0
       set rebind 0
       set binding $payload
       LB::detach
       pool $static::readPool

    # If we come across a write request and are currently not 
    # sending data to the write pool, detach, and set the rebind 
    # flag so we can send the bind packet before we actually send 
    # our write request
    } elseif {[class match -- $msgtype equals ldap_writes] and $writing != 1} { 
       if {$static::ldap_debug} {log local0. "Rebinding with: ldap_write"}
       set rebind 1
       set writing 1
       set replayop $payload
       TCP::payload replace 0 [TCP::payload length] $binding
       LB::detach
       pool $static::writePool

    # If we come across a read request while we are bound to a write server
    # we need to detach and rebind with a read server from the read pool
    } elseif {![class match -- $msgtype equals ldap_writes] and $writing == 1} {
       if {$static::ldap_debug} {log local0. "Rebinding with: ldap_read"}
       set rebind 1
       set writing 0
       set replayop $payload
       TCP::payload replace 0 [TCP::payload length] $binding
       LB::detach
       pool $static::readPool
    }
    TCP::release
    TCP::collect
}

when SERVER_CONNECTED {
    # A change in the type of request has been detected
    # requiring a rebind, we've sent the bind now we need to
    # wait for the response before we send the actual request
    if { $rebind == 1 } {
        TCP::collect
    }
}

when SERVER_DATA {
    if { $rebind == 1 } {
        set rebind 0
        # See above for details on this block.  Stupid iRules, no proc grrrr
        set payload [TCP::payload]

        # Pull the first 2 bytes.  
        binary scan $payload H2c ber_t ber_len
        set len_bytes 0
        if { [expr {[expr {($ber_len + 0x100) % 0x100}]} & 128] > 0 } {
            set len_bytes [expr {[expr ($ber_len + 0x100) % 0x100]} & 127]
        }

        binary scan $payload x[expr {3 + $len_bytes}]c msgid_bytes

        binary scan $payload x[expr {4 + $len_bytes + $msgid_bytes}]c msgtype

        set msgtype [expr {$msgtype & 31}]

        # If the msgtype we have here is for a bind response just discard 
        # it as we don't need to send it to the client
        if {$msgtype == 1 } {
            TCP::payload replace 0 [TCP::payload length] ""
        }
        # Now send the actual read or write op to the server
        # It should now have processed the bind
        TCP::respond $replayop
    }
    TCP::release
}

# v10 CMP compatible version

when RULE_INIT {
    # Read Pool
    set static::readPool sun_ldap_read

    # Write Pool
    set static::writePool sun_ldap_write

    # Turn on debugging
    set static::ldap_debug 0

    # A lookup table for debugging
    array set static::msg_types {
           0 "bind request"
           1 "bind response"
           2 "unbind request"
           3 "search request"
           4 "search response"
           6 "modify request"
           7 "modify response"
           8 "add request"
           9 "add response"
          10 "delete request"
          11 "delete response"
          12 "modifydn request"
          13 "modifydn response"
          14 "compare request"
          15 "compare response"
          16 "abandon request"
          23 "extended request"
          24 "extended response"
    }
}

when CLIENT_ACCEPTED {  
    set rebind 0
    set binding ""
    set replayop ""
    set writing 0
    TCP::collect
}

when CLIENT_DATA {
    # Grab the current payload collected
    set payload [TCP::payload]

    # Pull the first 2 bytes.  
    binary scan $payload H2c ber_t ber_len

    # The first byte is the tag signifying an LDAP message, 
    # Always is hex 30, if that is not so reject

    if { $ber_t ne "30" } {
        reject
        return
    }

    # The second byte is one of two values:
    #       a) The length of the packet minus the above
    #          defining byte and the length byte
    #    OR 
    #       b) an octet describing how many subsequent bytes
    #          hold the packet length
    # In either case the message type (what we are after)
    # follows the message id field which too can be a variable
    # number of bytes. 

    set len_bytes 0
    if { [expr [expr ($ber_len + 0x100) % 0x100] & 128] > 0 } {
        set len_bytes [expr [expr ($ber_len + 0x100) % 0x100] & 127]
    }

    # How many bytes is the message id
    binary scan $payload x[expr 3 + $len_bytes]c msgid_bytes

    # The message type is then 4 bytes + number length bytes + number of
    # message id bytes offset.
    binary scan $payload x[expr 4 + $len_bytes + $msgid_bytes]c msgtype

    # msgtype - BER encoded value, bits 1-5 are the actual 
    # type, 6 is the data type, 7-8 are the data class  
    # Here we only care about the lower 5 bits
    set msgtype [expr $msgtype & 31]

    if {$static::ldap_debug and 
        [catch {
              log local0. "message type is: $static::msg_types($msgtype) $msgtype"
         }
        ] 
       } {
       log local0. "Bad message type: $msgtype"
       reject
    }

    # Each connection should start with a bind request
    # We'll save this packet for later rebinding when we 
    # flip between servers
    if { $msgtype == 0 } {
       if {$static::ldap_debug} {log local0. "Bind Request with: ldap_read"}
       set writing 0
       set rebind 0
       set binding $payload
       LB::detach
       pool $static::readPool

    # If we come across a write request and are currently not 
    # sending data to the write pool, detach, and set the rebind 
    # flag so we can send the bind packet before we actually send 
    # our write request
    } elseif {[matchclass $msgtype equals $::ldap_writes] and $writing != 1} { 
       if {$static::ldap_debug} {log local0. "Rebinding with: ldap_write"}
       set rebind 1
       set writing 1
       set replayop $payload
       TCP::payload replace 0 [TCP::payload length] $binding
       LB::detach
       pool $static::writePool

    # If we come across a read request while we are bound to a write server
    # we need to detach and rebind with a read server from the read pool
    } elseif {![matchclass $msgtype equals $::ldap_writes] and $writing == 1} {
       if {$static::ldap_debug} {log local0. "Rebinding with: ldap_read"}
       set rebind 1
       set writing 0
       set replayop $payload
       TCP::payload replace 0 [TCP::payload length] $binding
       LB::detach
       pool $static::readPool
    }
    TCP::release
    TCP::collect
}

when SERVER_CONNECTED {
    # A change in the type of request has been detected
    # requiring a rebind, we've sent the bind now we need to
    # wait for the response before we send the actual request
    if { $rebind == 1 } {
        TCP::collect
    }
}

when SERVER_DATA {
    if { $rebind == 1 } {
        set rebind 0
        # See above for details on this block.  Stupid iRules, no proc grrrr
        set payload [TCP::payload]
    
        # Pull the first 2 bytes.  
        binary scan $payload H2c ber_t ber_len
        set len_bytes 0
        if { [expr [expr ($ber_len + 0x100) % 0x100] & 128] > 0 } {
            set len_bytes [expr [expr ($ber_len + 0x100) % 0x100] & 127]
        }
            
        binary scan $payload x[expr 3 + $len_bytes]c msgid_bytes

        binary scan $payload x[expr 4 + $len_bytes + $msgid_bytes]c msgtype

        set msgtype [expr $msgtype & 31]

        # If the msgtype we have here is for a bind response just discard 
        # it as we don't need to send it to the client
        if {$msgtype == 1 } {
            TCP::payload replace 0 [TCP::payload length] ""
        }
        # Now send the actual read or write op to the server
        # It should now have processed the bind
        TCP::respond $replayop
    }
    TCP::release
}

# v9 compatible version

when RULE_INIT {
    # Read Pool
    set ::readPool sun_ldap_read

    # Write Pool
    set ::writePool sun_ldap_write

    # Turn on debugging
    set ::debug 0

    # A lookup table for debugging
    array set ::msg_types {
           0 "bind request"
           1 "bind response"
           2 "unbind request"
           3 "search request"
           4 "search response"
           6 "modify request"
           7 "modify response"
           8 "add request"
           9 "add response"
          10 "delete request"
          11 "delete response"
          12 "modifydn request"
          13 "modifydn response"
          14 "compare request"
          15 "compare response"
          16 "abandon request"
          23 "extended request"
          24 "extended response"
    }
}

when CLIENT_ACCEPTED {  
    set rebind 0
    set binding ""
    set replayop ""
    set writing 0
    TCP::collect
}

when CLIENT_DATA {
    # Grab the current payload collected
    set payload [TCP::payload]

    # Pull the first 2 bytes.  
    binary scan $payload H2c ber_t ber_len

    # The first byte is the tag signifying an LDAP message, 
    # Always is hex 30, if that is not so reject

    if { $ber_t ne "30" } {
        reject
        return
    }

    # The second byte is one of two values:
    #       a) The length of the packet minus the above
    #          defining byte and the length byte
    #    OR 
    #       b) an octet describing how many subsequent bytes
    #          hold the packet length
    # In either case the message type (what we are after)
    # follows the message id field which too can be a variable
    # number of bytes. 

    set len_bytes 0
    if { [expr [expr ($ber_len + 0x100) % 0x100] & 128] > 0 } {
        set len_bytes [expr [expr ($ber_len + 0x100) % 0x100] & 127]
    }

    # How many bytes is the message id
    binary scan $payload x[expr 3 + $len_bytes]c msgid_bytes

    # The message type is then 4 bytes + number length bytes + number of
    # message id bytes offset.
    binary scan $payload x[expr 4 + $len_bytes + $msgid_bytes]c msgtype

    # msgtype - BER encoded value, bits 1-5 are the actual 
    # type, 6 is the data type, 7-8 are the data class  
    # Here we only care about the lower 5 bits
    set msgtype [expr $msgtype & 31]

    if {$::debug and 
        [catch {
              log local0. "message type is: $::msg_types($msgtype) $msgtype"
         }
        ] 
       } {
       log local0. "Bad message type: $msgtype"
       reject
    }

    # Each connection should start with a bind request
    # We'll save this packet for later rebinding when we 
    # flip between servers
    if { $msgtype == 0 } {
       if {$::debug} {log local0. "Bind Request with: ldap_read"}
       set writing 0
       set rebind 0
       set binding $payload
       LB::detach
       pool $::readPool

    # If we come across a write request and are currently not 
    # sending data to the write pool, detach, and set the rebind 
    # flag so we can send the bind packet before we actually send 
    # our write request
    } elseif {[matchclass $msgtype equals $::ldap_writes] and $writing != 1} { 
       if {$::debug} {log local0. "Rebinding with: ldap_write"}
       set rebind 1
       set writing 1
       set replayop $payload
       TCP::payload replace 0 [TCP::payload length] $binding
       LB::detach
       pool $::writePool

    # If we come across a read request while we are bound to a write server
    # we need to detach and rebind with a read server from the read pool
    } elseif {![matchclass $msgtype equals $::ldap_writes] and $writing == 1} {
       if {$::debug} {log local0. "Rebinding with: ldap_read"}
       set rebind 1
       set writing 0
       set replayop $payload
       TCP::payload replace 0 [TCP::payload length] $binding
       LB::detach
       pool $::readPool
    }
    TCP::release
    TCP::collect
}

when SERVER_CONNECTED {
    # A change in the type of request has been detected
    # requiring a rebind, we've sent the bind now we need to
    # wait for the response before we send the actual request
    if { $rebind == 1 } {
        TCP::collect
    }
}

when SERVER_DATA {
    if { $rebind == 1 } {
        set rebind 0
        # See above for details on this block.  Stupid iRules, no proc grrrr
        set payload [TCP::payload]
    
        # Pull the first 2 bytes.  
        binary scan $payload H2c ber_t ber_len
        set len_bytes 0
        if { [expr [expr ($ber_len + 0x100) % 0x100] & 128] > 0 } {
            set len_bytes [expr [expr ($ber_len + 0x100) % 0x100] & 127]
        }
            
        binary scan $payload x[expr 3 + $len_bytes]c msgid_bytes

        binary scan $payload x[expr 4 + $len_bytes + $msgid_bytes]c msgtype

        set msgtype [expr $msgtype & 31]

        # If the msgtype we have here is for a bind response just discard 
        # it as we don't need to send it to the client
        if {$msgtype == 1 } {
            TCP::payload replace 0 [TCP::payload length] ""
        }
        # Now send the actual read or write op to the server
        # It should now have processed the bind
        TCP::respond $replayop
    }
    TCP::release
}