#!/usr/bin/perl
######################################################################
# l7cookie
# Calculate cookie value for UltraMonkey-L7 cpassive module.
#
# 2009 (C) NTT COMWARE
#
# License:   GNU General Public License (GPL)
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of the
# License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 USA
######################################################################

use strict;
use warnings;
use Getopt::Long;
use Sys::Hostname;
use Socket;

$| = 1;

# default value
my ($ip_def)   = inet_ntoa((gethostbyname(hostname))[4]);
my $port_def   = 80;
my $cookie_def = 'CookieName';

# option value
my $ip;
my $port;
my $cookie;
my $help;
my $encoded;

# get options
my $opt = GetOptions(
    "cookie=s" => \$cookie,
    "ip=s"     => \$ip,
    "port=s"   => \$port,
    "help"     => \$help,
    "decode=s" => \$encoded,
);

# help
usage() if $help || !$opt;

# decode cookie value
decode($encoded) if (defined $encoded && $encoded =~ /^\d{15}$/);

# get IP address
if (!defined $ip) {
    print "Input IP address [$ip_def]: ";
    $ip = <>;
    $ip =~ s/\s//g;
    # set default IP address
    $ip = $ip_def if $ip eq q{};
}

# IP address validation
if ($ip =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ &&
    $1 < 256 && $2 < 256 && $3 < 256 && $4 < 256) {
    $ip = $1 + (($2 + (($3 + ($4 << 8)) << 8)) << 8);
} else {
    usage("Bad IP address.($ip)");
}

# get port number
if (!defined $port) {
    print "Input port number [$port_def]: ";
    $port = <>;
    $port =~ s/\s//g;
    # set default port number
    $port = $port_def if $port eq q{};
}

# Port number validation
if ($port =~ /^\d+$/ && $port < 65536) {
    # same as htons(3)
    $port = unpack('n*', pack('S*', $port));
} else {
    usage("Bad port number.($port)");
}

# get cookie name
if (!defined $cookie) {
    print "Input cookie name [$cookie_def]: ";
    $cookie = <>;
    $cookie =~ s/\s//g;
    # set default cookie name
    $cookie = $cookie_def if $cookie eq q{};
}

# show Set-Cookie header field
print  "\n";
printf "Set-Cookie: %s=%010s%05s\n", $cookie, $ip, $port;

#--------------------------------------------------------------------
# usage
sub usage {
    my $msg = shift;
    if ($msg) {
        print $msg, "\n\n";
    }
    print <<"__USAGE__";
Usage: $0 [-i ip_address] [-p port] [-c cookie_name]

-i, --ip      Set IP address of real server.
-p, --port    Set port number of real server.
-c, --cookie  Set cookie name of UltraMonkey-L7.
-h, --help    Show this usage.
__USAGE__

    exit;
}

#--------------------------------------------------------------------
# decode cookie value
sub decode {
    my $encoded = shift;
    my $_ip   = substr($encoded, 0, 10);
    my $_port = substr($encoded, 10, 5);
    print "IP address : ", inet_ntoa(scalar reverse pack('H*', sprintf('%08X', $_ip))), "\n";
    print "Port number: ", unpack('S*', pack('n*', $_port)), "\n";
    exit;
}