WebLogic information extraction

set jsess [getfield [HTTP::header "X-WebLogic-Cluster-List"] "!" 1]
set server1 [getfield [HTTP::header "X-WebLogic-Cluster-List"] "!" 2]  
set server2 [getfield [HTTP::header "X-WebLogic-Cluster-List"] "!" 3]

when HTTP_RESPONSE {
  if { [HTTP::header exists "X-WebLogic-Cluster-List"] }{
    set server_mappings [split [HTTP::header "X-WebLogic-Cluster-List"] "|" ]
    init array if non-existent
    array set ::ServerList { }
    clear pre-existing array entries
    (re-initializing as blank array doesn't seem to do it)
    array unset ::ServerList
    foreach server $server_mappings {
      set ::ServerList($server) [getfield [findclass $server $::server_name_to_IP] " " 2]
    }
  }
}

{
-306262974 10.1.1.10
-572170000 10.1.1.11
-851958269 10.1.1.12
-896443913 10.1.1.13
-937189304 10.1.1.14
}

array get ::ServerList [getfield $jsessionstring "!" 2]
array get ::ServerList [getfield $jsessionstring "!" 3]

when HTTP_RESPONSE {
  if { [HTTP::header exists "X-WebLogic-Cluster-List"] }{
    set server_mappings [split [HTTP::header "X-WebLogic-Cluster-List"] "|" ]
    init array if non-existent
    array set ::ServerList { }
    clear pre-existing array entries
    (re-initializing as blank array doesn't seem to do it)
    array unset ::ServerList
    foreach servermap $server_mappings {
      set serverID [getfield $servermap "!" 1]
      set serverName [getfield $servermap "!" 2]
      set ::ServerList($serverID) [getfield [findclass $serverName $::server_name_to_IP] " " 2]
    }
  }
}

when HTTP_RESPONSE {
  if { [HTTP::header exists "X-WebLogic-Cluster-List"] }{
    set server_mappings [split [HTTP::header "X-WebLogic-Cluster-List"] "|" ]
    init array if non-existent
    array set ::ServerList { }
    clear pre-existing array entries
    (re-initializing as blank array doesn't seem to do it)
    array unset ::ServerList
    foreach servermap $server_mappings {
      set ::ServerList([getfield $servermap "!" 1]) [getfield [findclass [getfield $servermap "!" 2] $::server_name_to_IP] " " 2]
    }
  }
}

when CLIENT_ACCEPTED {
  set get_server_mappings 1
}
when HTTP_REQUEST {
   Insert WebLogic Header to retrieve active servers if new client connection
  if { $get_server_mappings } {
     Inserting this header instructs Weblogic to return cluster information
    HTTP::header insert "X-Weblogic-Request-ClusterInfo" "true"
     Reset variable to zero to prevent header insert on every request
    set get_server_mappings 0
  }
   If all servers are inactive, redirect to sorry page on Apache
  if { [active_members myPool] == 0 } {    
    HTTP::redirect "http://[HTTP::header "X-Forwarded-Host"]/unavailable/index.html"
  }
   Replace Host header with X-Forwarded-Host header contents
  if { [HTTP::header exists "X-Forwarded-Host"] } {
    HTTP::header replace "Host" [HTTP::header "X-Forwarded-Host"]
  }
   If JSESSIONID cookie exists, use the contents to extract jsession server reference 
  if { [HTTP::cookie exists "JSESSIONID"] } {
    set serverIP_fromCookie [lindex [ array get ::ServerList [getfield [HTTP::cookie "JSESSIONID"] "!" 2 ] ] 1]
     If an IP was found in the array
    if { $serverIP_fromCookie ne "" } {
       Send the connection to the primary server
      pool myPool member $serverIP_fromCookie
      log "From Cookie: Server $serverIP_fromCookie is primary for jsessionID [getfield [HTTP::cookie "JSESSIONID"] "!" 1 ]"
    } else {
        log "Couldn't extract pool member from array, connection will be load-balanced!"
    }
  } else {
       NO COOKIE, need to extract from URI
       if jsessionid is found in the uri AND in the absense of the jsessionid cookie
      if { [string tolower [HTTP::uri]] contains "jsessionid" } {
         Set IP from list item 1 of the array by extracting jsession server reference  from URI
        set serverIP_fromURI [lindex [ array get ::ServerList [lindex [split [findstr [HTTP::uri] "jsessionid" 11 "?"] "!" ] 1 ] ] 1]
         If an IP was found in the array
        if { $serverIP_fromURI ne "" } {
           Send the connection to the primary server
          pool myPool member $serverIP_fromURI
          log "From URI: Server $serverIP_fromURI is primary for jsessionID [lindex [split [findstr [HTTP::uri] "jsessionid" 11 "?"] "!" ] 0 ]"
        } else {
            log "Couldn't extract pool member from URI, connection will be load-balanced!"
        }
      }
  }
}
when HTTP_RESPONSE {
  if { [HTTP::header exists "X-WebLogic-Cluster-List"] }{
  
     Set indexed variable with server cluster information
    set server_mappings [split [HTTP::header "X-WebLogic-Cluster-List"] "|" ]
     Remove header before returning to client
    HTTP::header remove "X-WebLogic-Cluster-List"
     init array if non-existent
    array set ::ServerList { }
     clear pre-existing array entries by re-initializing as blank array doesn't seem to do it
    array unset ::ServerList
    foreach servermap $server_mappings {
      set ::ServerList([getfield $servermap "!" 1]) [getfield [findclass [getfield $servermap "!" 2] $::intres_servers] " " 2]
    }
  }
}
when LB_FAILED {
  log "LB_FAILED: Server [LB::server addr] failed!"
  set lbfailed 1
   Turn off least connections, set for round robin
  LB::mode rr
   Reselect another pool member. It might be failed server(s) once, but it won’t occur continuously with round robin
  LB::reselect pool myPool
  log "LB_FAILED: New server is [LB::server addr] "
}

when LB_FAILED {
  set failed_server [LB::server addr]
  log local0. "Connection to server $failed_server failed! Reselecting..."
  LB::mode rr
  LB::reselect pool MyPool
  for {set x 0} {$x<4} {incr x} {
    if { [LB::server addr] eq $failed_server } {
      LB::mode rr
      LB::reselect pool MyPool
      log local0. "Attempt $x ==>New server is [LB::server addr]"
    }
  }
}