#!/usr/local/bin/perl -nwT
#
# Copyright Hank Leininger <hlein@korelogic.com>, <hlein@progressive-comp.com>
#           Joe Segreti

INIT {
  $::V = '$Id: weblogicdecode,v 1.2 2005/08/26 04:51:01 hlein Exp $';
  $::V =~ s/^.*,v //; $::V =~ s/ .*//;
}

# BEA WebLogic Application-server cluster session token secret decoder ring
#
# Takes a signed integer (encoded IP addr) or a Weblogic cookie on STDIN and
# tries to find and decode IP addresses for the backend WL server, or an IP
# address on STDIN and converts it to an encoded signed int.  Some of the
# values returned will turn out to be garbage (that just happened to look
# like an integer that might be an IP).  Some others will be multicast
# addresses, because WL clusters use multicast heartbeats.  But others will
# be the real IPs of the WebLogic server that the webserver is talking to...
#
# Note that the Apache bridge plugin will respect whatever values you send
# it for server IP and port; connections to bad ports or nonexistant IPs will
# error quickly or time out slowly.  So... mapping out the network(s) behind
# the webserver is trivial.  Supposedly the NSAPI and ISAPI plugins are
# smarter, and won't respect arbitrary values (though they still leak info).
#
# This was reported to BEA in October of 2000; since then they have changed
# the cookie format in various minor ways, but AFAIK not addressed the
# underlying leakage issues (the Apache plugin might have been fixed to
# prevent portscanning by now...)

use strict;

my (@wlserv, @ips, @ports);

# Either we've been fed a plain IP addr,
@wlserv = ($1) if m%^(-?[0-9]{7,10})$%;

# or a cookie/URL with session information embedded,
# from which we should extract all available IP addrs
unless (@wlserv) {
  # Trim the prefix, if any; old and new cookie formats
  $_ =~ s/^[^|]*\|//;
  $_ =~ s/^[0-9]*[a-zA-Z]+[0-9a-zA-Z]+!//;

  my (@tok) = split(/[!\/;]/, $_);
  my %ports;
  foreach my $tok (@tok) {
    push(@wlserv, $tok)	if $tok =~ m%^-?[0-9]{7,10}$%;
    $ports{$tok}++
			if $tok =~ m%^[0-9]{2,5}$%;
  }
  push(@ports, keys(%ports));
}

# or an IP addr to be encoded
@ips = ($1) if m/^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})(?: +[0-9]+)*$/;

foreach my $serv (@wlserv) {
  # Convert to a 32bit int
  my $ip=pack('N', $serv);
  # Convert to 4 octets
  my (@oct)=unpack('C4',$ip);
  print join(".", @oct),
	scalar(@ports) ? "\t" . join(" ", @ports) : '', "\n";
}

foreach my $ip (@ips) {
  # Convert to octets
  my (@oct) = split(/\./, $ip);
  # convert to 32bit int
  my $int = pack('C4', @oct);
  # silly endianness check
  $int = pack('C4', reverse @oct) if (unpack('V', $int) == unpack('l', $int));
  # convert to signed int
  print unpack('l', $int), "\n";
}