rebellion.pl

#!/usr/bin/perl -w
# Marcin Gryszkalis <mg@fork.pl>
# https://github.com/marcin-gryszkalis/rebellion

my $VERSION = '0.7';

use strict;
use warnings;

use POSIX qw/SIGHUP strftime/;
use Time::HiRes qw/time/;
#use WWW::Curl::Easy;
#use WWW::Curl::Form;
use Net::Curl::Easy qw(:constants);
use Net::Curl::Form qw(:constants);

use threads (
     'stack_size' => 32*4096, # override with env. PERL5_ITHREADS_STACK_SIZE
     'exit' => 'threads_only',
     );

use threads::shared;
# use forks;
# use forks::shared;

use Thread::Queue;
# use Event::Lib;
use Data::Dumper;
use URI::Escape;
use HTML::Entities;
use File::Slurp;

my $DEBUG_NO_BURL = 0;
my $DEBUG_NO_DELAY = 0;
my $DEBUG_ONE_SHOT = 0;
my $DEBUG_ALWAYS_SAVE_VERIFICATION_LOG = 0;

# global config, defaults
my %cfg = (
    logfile => './sparky.log',
    sparkytee => 0,
    scenario => undef,
    skippages => undef,
    duration => 60,
    tests => 1,
    sourceip => undef,
);

my @status :shared;
my @round :shared;


my $gen_dowod_prefix = 'BBD';
my $gen_dowod_seed :shared = 0;

my $global_rawpost_data = undef;

my $rebels = 0;

my @def_headers = ();
my $def_headers_h;
my %def_variables = ();
my $def_variables_per_fox;
my @def_verifynegs = ();
my %def_delays = ();
my @varfiles = ();
my @varfiles_names = ();

my $stackfiles;
my @stackfiles_names = ();

my @scenario_base = ();
my @scenario = ();
# my $skippages = '';
# my $browsers = 1;
# my @foxies = ();
# my $duration = 600;
# my $tests = undef;
# my $rate = undef;
# my @army = ();
# my @src_ip = ();
#

my $war_is_over  :shared = 0;

my $devnull;

my $curl;

# Signals:

$SIG{PIPE} = 'IGNORE';


# options

use Getopt::Std;
our ($opt_c, $opt_h, $opt_V, $opt_l, $opt_d, $opt_b, $opt_p, $opt_o, $opt_a);
sub VERSION_MESSAGE() { print "$VERSION\n"; }
sub HELP_MESSAGE()
{
print "Usage: rebellion.pl [-hV] [-l log file] -c config-file
    -c config file\t\tMain config file
    -l log file\t\tSparky logger file
    -p proto://host:port\t\tproxy defnition (proto: http, https, socks)
    -d\t\tno delays
    -b\t\tno static elements (b-url)
    -o\t\tone shot
    -a\t\talways save verification logs
    -h\t\tthis help
    -V\t\tversion info
";
}

getopts('c:hl:Vbdop:a');
if ($opt_h) { HELP_MESSAGE(); exit; }
if ($opt_V) { VERSION_MESSAGE(); exit; }
if ($opt_d) { $DEBUG_NO_DELAY = 1; }
if ($opt_b) { $DEBUG_NO_BURL = 1; }
if ($opt_o) { $DEBUG_ONE_SHOT = 1; }
if ($opt_a) { $DEBUG_ALWAYS_SAVE_VERIFICATION_LOG = 1; }
if ($opt_p) { $cfg{proxy} = $opt_p; }


# # === return channel for main thread
my $queue_re = Thread::Queue->new();

# hashref of queues
my $queues_varlist;

# ================ sparky logger stuff
my $queue_sparky = Thread::Queue->new();


sub now()
{
    my @t = localtime time;
    return sprintf("%4d-%02d-%02d %02d:%02d:%02d", $t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]);
}

sub thread_sparky
{
    print STDERR "SPARKY:Alive\n";
    $cfg{logfile} = $opt_l if defined $opt_l;

    open(my $l, ">$cfg{logfile}") or die("cannot create logfile ($cfg{logfile}): $!");

    # my $old = select($l);
    # $| = 1;
    # select($old);
    $l->autoflush(1);

    $queue_re->enqueue("OK");

    while (my $msg = $queue_sparky->dequeue())
    {
        chomp $msg;
        my ($mode, $msg) = split/\s+/, $msg, 2;
        last if $msg eq 'END';
        my $date = now();
        print $l "$date $msg\n";
        print STDERR "$date $msg\n" if ($cfg{sparkytee} || $mode eq 'HIGH');
    }
    close($l);
}

sub LOG($)
{
    $queue_sparky->enqueue("LOW ".shift);
}

sub MSG($)
{
    $queue_sparky->enqueue("HIGH ".shift);
}


sub randxy($$)
{
    my $a = shift;
    my $b = shift;
    return int($a + rand($b - $a + 1));
}

# === Generators
my $last_pesel = '';
sub gen_pesel()
{
    # http://wipos.p.lodz.pl/zylla/ut/pesel.html

    my @wagi = qw{1 3 7 9 1 3 7 9 1 3};

    my $pesel = sprintf("%02d%02d%02d%03d%d",
        randxy(50,90),
        randxy(1,12),
        randxy(1,28),
        randxy(1,999),
        randxy(0,4)*2 + 1); # even = female, odd = male

    my @c = split //, $pesel;
    my $sum = 0;
    for (my $i = 0; $i < 10; $i++)
    {
        my $x = $c[$i] * $wagi[$i];
        $sum += $x;
    }

    my $mod = (10 - ($sum % 10)) % 10;
    $last_pesel = "$pesel$mod";
    return $last_pesel;
}

sub gen_date_from_last_pesel
{
    $last_pesel =~ /^(..)(..)(..)/;
    return sprintf("%04d-%02d-%02d", $1 + 1900, $2 ,$3);
}

sub gen_nip()
{
    my $nip;
    my $mod;
    while (1)
    {
        my @wagi = qw{6 5 7 2 3 4 5 6 7};

        $nip = sprintf("%03d%03d%03d",
            randxy(100,199),
            randxy(100,999),
            randxy(100,999));

        my @c = split //, $nip;
        my $sum = 0;
        for (my $i = 0; $i < 9; $i++)
        {
            my $x = $c[$i] * $wagi[$i];
            $sum += $x;
        }

        $mod = (10 - ($sum % 10)) % 10;
        $mod = $sum % 11;
        last unless $mod == 10;
    }
    return "$nip$mod";
}

sub gen_regon()
{
    my $regon;
    my $mod;
    while (1)
    {
        my @wagi = qw{8 9 2 3 4 5 6 7};
        $regon = randxy(10000000,99999999);

        my @c = split //, $regon;
        my $sum = 0;
        for (my $i = 0; $i < 8; $i++)
        {
            my $x = $c[$i] * $wagi[$i];
            $sum += $x;
        }

        # $mod = (10 - ($sum % 10)) % 10;
        $mod = $sum % 11;
        last unless $mod == 10;
    }
    return "$regon$mod";
}

sub gen_iban()
{
    my $iban = "11402004"."0000".randxy(1111,9999).randxy(1111,9999).randxy(1111,9999);
    my $xban = $iban."252100"; # PL
    my $mod = 0;
    for my $c (split//,$xban)
    {
        $mod = (10 * $mod + $c) % 97;
    }
    $mod = 98 - $mod;
    $iban = sprintf "%02d%s", $mod, $iban;
    return $iban;
}

sub gen_dowod()
{
    # http://pl.wikipedia.org/wiki/Dow%C3%B3d_osobisty_w_Polsce
    my @wagi = qw{7 3 1 0 7 3 1 7 3};

    $gen_dowod_seed++;

    my $do = sprintf("%s%06d", $gen_dowod_prefix, $gen_dowod_seed);
    my @c = split //, $do;
    my $sum =
        $wagi[0] * (ord($c[0])-55) +
        $wagi[1] * (ord($c[1])-55) +
        $wagi[2] * (ord($c[2])-55) +
        $wagi[3] * $c[3] + # ctrl, will be 0 as wagi[3]==0
        $wagi[4] * $c[4] +
        $wagi[5] * $c[5] +
        $wagi[6] * $c[6] +
        $wagi[7] * $c[7] +
        $wagi[8] * $c[8];

    my $mod = $sum % 10;
    return sprintf("%s%d%05d", $gen_dowod_prefix, $mod, $gen_dowod_seed);
}

sub gen_random_text($)
{
    my $len = shift;
    my @chars=('a'..'z');
    my $v = "";
    foreach (1..$len)
    {
        $v .= $chars[int rand scalar @chars];
    }
    return $v;
}

sub gen_email()
{
    return gen_random_text(10).'@'.gen_random_text(10).'.pl';
}

sub gen_random_number($$)
{
    my $min = shift;
    my $max = shift;
    return sprintf("%d", rand($max - $min + 1) + $min);
}

my @first_names = qw{
Piotr Krzysztof Andrzej Jan Tomasz Marcin Marek Grzegorz Adam Zbigniew Jerzy Tadeusz Mateusz Dariusz Mariusz Wojciech Ryszard Jakub Henryk Robert Kazimierz Jacek Maciej Kamil
Anna Maria Katarzyna Agnieszka Barbara Krystyna Ewa Zofia Teresa Magdalena Joanna Janina Monika Danuta Jadwiga Aleksandra Halina Irena Beata Marta Dorota Helena Karolina Jolanta Iwona Marianna Natalia
};

sub gen_firstname
{
    return $first_names[int rand scalar @first_names];
}

sub gen_lastname
{
    my @names = qw{
Nowak Kowalski Lewandowski Kowalczyk Jankowski Wojciechowski Kwiatkowski Kaczmarek Mazur Krawczyk Piotrowski Grabowski Nowakowski Michalski Nowicki Adamczyk Dudek Wieczorek Majewski Olszewski Jaworski Malinowski Pawlak Witkowski
};

    return $names[int rand scalar @names];
}

sub gen_company
{
    my $n = $first_names[int rand scalar @first_names];
    my @sufix = qw/Trans Pol ex Agra Bis Art/;
    my @mod = ("Sp.z o.o.", "SA", "Sp.j.");
    my $s = $sufix[int rand scalar @sufix];
    my $m = $mod[int rand scalar @mod];
    return "$n$s $m";
}

sub gen_city
{
    my @names = qw{
Warszawa Szczecin Bydgoszcz Lublin Katowice Gdynia Radom Sosnowiec Kielce Gliwice Olsztyn Tychy Opole Koszalin Kalisz Legnica
};

    return $names[int rand scalar @names];
}

sub gen_list($)
{
    my $qn = shift;
    my $a = $queues_varlist->{$qn}->dequeue();
    if (!defined $a)
    {
        MSG "PROBLEM:Queue($qn) is empty";
        return '0'; # oh well
    }
    else
    {
        LOG "VARLIST($qn)=($a)";
        $queues_varlist->{$qn}->enqueue($a); # store it back, so it doesn't dry
    }
    return $a;
}

sub gen_zipcode
{
    return sprintf("%02d-%03d", int rand(100), int rand(1000))
}

# http://pl.wikipedia.org/wiki/Vehicle_Identification_Number
# 17-chars
# TMB AH6NH8 D4042851
sub gen_vin
{
    return sprintf("TMBAH6NH8%08d", int rand(99999999))
}

sub gen_date
{
    return strftime("%F", localtime);
}

sub gen_date_add($)
{
    my $add = shift;
    return strftime("%F", localtime(time() + ($add * 86400)));
}

sub gen_time
{
    return strftime("%T", localtime());
}

sub gen_time_add($)
{
    my $add = shift;
    return strftime("%T", localtime(time() + $add));
}

sub gen_datetime
{
    return strftime("%F %T", localtime());
}

sub gen_datetime_add($)
{
    my $add = shift;
    return strftime("%F %T", localtime(time() + $add));
}

# 1990-12-31T23:59:60.123Z
# 1996-12-19T16:39:57.123-08:00
# 2020-10-30T11:33:02.077+0000 <- currently this form w/o TZ offset (ie. localtime without proper offset)
# /!\ fraction of seconds is random
sub gen_datetime_rfc3339
{
    my $msec = sprintf("%.3f", time());
    $msec =~ s/.*\.//;
    return strftime("%FT%T.${msec}+0000", localtime());
}

sub gen_datetime_rfc3339_add($)
{
    my $add = shift;
    my $msec = sprintf("%.3f", time());
    $msec =~ s/.*\.//;
    return strftime("%FT%T.${msec}+0000", localtime(time() + $add));
}

sub process_generators
{
    my $url = shift;

    $url  =~ s/{:TEXT\((\d+)\)}/gen_random_text($1)/ge;

    $url  =~ s/{:NUMBER\((\d+),(\d+)\)}/gen_random_number($1,$2)/ge;

    $url  =~ s/{:FIRSTNAME}/gen_firstname()/ge;

    $url  =~ s/{:LASTNAME}/gen_lastname()/ge;

    $url  =~ s/{:COMPANY}/gen_company()/ge;

    $url  =~ s/{:LIST\((\S+?)\)}/gen_list($1)/ge;

    $url  =~ s/{:PESEL}/gen_pesel()/ge;

    $url  =~ s/{:DATE_FROM_LAST_PESEL}/gen_date_from_last_pesel()/ge;

    $url  =~ s/{:NIP}/gen_nip()/ge;

    $url  =~ s/{:REGON}/gen_regon()/ge;

    $url  =~ s/{:IBAN}/gen_iban()/ge;

    $url  =~ s/{:VIN}/gen_vin()/ge;

    $url  =~ s/{:ZIPCODE}/gen_zipcode()/ge;

    $url  =~ s/{:CITY}/gen_city()/ge;

    $url  =~ s/{:EMAIL}/gen_email()/ge;

    $url  =~ s/{:DOWOD}/gen_dowod()/ge;

    $url =~ s/{:DATE}/gen_date()/ge;
    $url =~ s/{:DATE\+(\d+)}/gen_date_add($1)/ge; # add days

    $url =~ s/{:TIME}/gen_time()/ge;
    $url =~ s/{:TIME\+(\d+)}/gen_time_add($1)/ge; # add seconds

    $url =~ s/{:DATETIME}/gen_datetime()/ge;
    $url =~ s/{:DATETIME\+(\d+)}/gen_datetime($1)/ge;

    $url =~ s/{:DATETIME_RFC3339}/gen_datetime_rfc3339()/ge;
    $url =~ s/{:DATETIME_RFC3339\+(\d+)}/gen_datetime_rfc3339($1)/ge;

    $url =~ s/{:UNIXTIME}/int(time())/ge;

    return $url;
}

my $mimecache;
sub check_mime($)
{
    my $b = shift;
    my $mt = undef;
    if (exists $mimecache->{$b})
    {
        $mt = $mimecache->{$b};
    }
    else
    {
        $mt = `file --mime-type --brief '$b'` || 'text/plain';
        chomp $mt;
        $mimecache->{$b} = $mt;
    }

    return $mt;
}


sub process_variables
{
    my $h = shift;
    my $text = shift;
    my $noenc = shift // 0;

    # setup variables
    for my $k (keys %$h)
    {
        my $v = $h->{$k};
        $v = uri_escape($v) unless $k =~ /^(NOENC|DECHTML):(.*)/ || $noenc;
        $v = decode_entities($v) if $k =~ /^DECHTML:(.*)/;

        # print STDERR "VAR($k = $v)\n";
        $text =~ s/\Q{$k}\E/$v/g;
    }

    return $text;
}

# =============================================================================
# xxx REBELS xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
# =============================================================================

my $body = undef;
my $body_h = undef; # file handle to $body

sub init_curl($)
{
    my $curl = shift;

    $curl->setopt(CURLOPT_NOSIGNAL, 1);
    # TODO notfound $curl->setopt(CURLOPT_SSLVERSION, CURL_SSLVERSION_SSLv3);
    $curl->setopt(CURLOPT_SSL_VERIFYPEER, 0);
    $curl->setopt(CURLOPT_SSL_VERIFYHOST, 0);

    # wywala bledy dla http kodow >= 400:
    $curl->setopt(CURLOPT_FAILONERROR, 0);
    # we;ll do parsing ourself (TODO: why?)
    $curl->setopt(CURLOPT_HEADER, 1);

    # for debug
#    $curl->setopt(CURLOPT_VERBOSE, 1);

    $curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
    $curl->setopt(CURLOPT_AUTOREFERER, 1);
    $curl->setopt(CURLOPT_MAXREDIRS, 64);

    # check
    $curl->setopt(CURLOPT_FORBID_REUSE, 0);

    # move to config
    $curl->setopt(CURLOPT_CONNECTTIMEOUT, 60);

    $curl->setopt(CURLOPT_POSTFIELDSIZE, -1); # curl will take care ### TODO:  backport change from rebel.c

    # curl->setopt(curl, CURLOPT_COOKIESESSION, 1);
    $curl->setopt(CURLOPT_COOKIEFILE, "");

    if (defined $cfg{proxy})
    {
        $curl->setopt(CURLOPT_PROXY, $cfg{proxy});
        if ($cfg{proxy} =~ m{^socks})
        {
            $curl->setopt(CURLOPT_PROXYTYPE, CURLPROXY_SOCKS5);
        }
        elsif ($cfg{proxy} =~ m{^https})
        {
            $curl->setopt(CURLOPT_PROXYTYPE, CURLPROXY_HTTPS);
        }
        else
        {
            $curl->setopt(CURLOPT_PROXYTYPE, CURLPROXY_HTTP);
            # $curl->setopt(CURLOPT_PROXYTYPE, CURLPROXY_HTTP_1_0);
        }
        # curl->setopt(curl, CURLOPT_HTTPPROXYTUNNEL, 1);
    }


    if (defined $cfg{sourceip})
    {
        $curl->setopt(CURLOPT_INTERFACE, $cfg{sourceip});
    }

        # CURLOPT_MAX_SEND_SPEED_LARGE
        # CURLOPT_MAX_RECV_SPEED_LARGE

        # other config?
        # - CURLOPT_INTERFACE
        # - http auth

    return $curl;
}

sub reset_curl($)
{
    my $curl = shift;
    ## XXX from WWW::Curl -- $curl->cleanup();
    # $curl = undef;
    $curl = new Net::Curl::Easy;
    $curl = init_curl($curl);
    return $curl
}

sub setup_fox($)
{
    my $id = shift;
    my $fox = undef;
    $fox->{status} = 'start';
    $fox->{line} = -1; # reference to source
    $fox->{round} = 0;
    $fox->{variables} = ();
    $fox->{variables}->{variable_placeholder} = "placeholder";
    $fox->{headers} = ();
    $fox->{id} = $id;
#    $fox->{ip} = $src_ip[$id%($#src_ip+2)] if $#src_ip >= 0;

    @scenario = @scenario_base;

    return $fox;
}

sub setup_stack_variables($)
{
    my $fox = shift;

    # get next from stackfiles
    for my $variable (@stackfiles_names)
    {
        my $var = shift @{$stackfiles->{$variable}};
        die "stackfile ($variable) too short" unless $var;
        chomp $var;
        redo if $var =~ /(^\s*$|^#)/;
        $fox->{variables}->{$variable} = $var;

        LOG "STACKFILE($fox->{id}:$variable)=($var)";
    }

    return $fox;
}

sub reset_scenario($)
{
    my $fox = shift;
    my $id = $fox->{id};
    my $save_round = $fox->{round} + 1;

    LOG "REBEL($fox->{id}:$fox->{line}):RESET SCENARIO";

    # mostly an ugly copy :( - incomplete!!!
    # assume this is dead stuff
    #
    # if (exists $fox->{fallback})
    # {

    #     my $url = $fox->{fallback};
    #     my $post = undef;
    #     my $upload = undef;
    #     my $curlf = undef;

    #     if ($url =~ /^\s*(\S+)\s+POST\s+(\S+)/)
    #     {
    #         $url = $1;
    #         $post = $2;
    #         $fox->{post} = $post; # just to remember
    #     }

    #     if ($url =~ /^\s*(\S+)\s+UPLOAD\s+(.*)/)
    #     {
    #         $url = $1;
    #         $upload = $2;
    #         $curlf = Net::Curl::Form->new;
    #         MSG "UP($upload)";

    #         my @upfields = split/\s+/, $upload;
    #         while (@upfields)
    #         {
    #             my $a = shift @upfields;
    #             my $b = shift @upfields;
    #             MSG "XF($a)->($b)";
    #             if (-f $b)
    #             {
    #                 my $mt = `file --mime-type '$b'` || 'text/plain';
    #                 chomp $mt;
    #                 $curlf->formaddfile($b, $a, $mt);
    #                 MSG "UPLOAD($a -> $b [$mt])";
    #             }
    #             else
    #             {
    #                 $curlf->formadd($a, $b);
    #             }

    #         }

    #         $fox->{upload} = $upload; # just to remember
    #     }


    #     $url = $fox->{base}."/$url" unless $url =~ m{^https?://};
    #     $url =~ s{([^:])/+}{$1/}g; # remove multiple /////

    #     $fox->{url} = $url;
    #     $curl->setopt(CURLOPT_WRITEDATA, $devnull);
    #     $curl->setopt(CURLOPT_HTTPGET, 1); # reset to GET, will be overwritten later
    #     $curl->setopt(CURLOPT_POST, 0);

    #     $curl->setopt(CURLOPT_URL, $url);
    #     # fprintf(stderr, "F%d:URL:PAGEID(%s):URL(%s)\n", id, pageid, realurl);

    #     if ($post)
    #     {
    #         $curl->setopt(CURLOPT_POST, 1);
    #         $curl->setopt(CURLOPT_COPYPOSTFIELDS, $post);
    #     }

    #     if ($upload)
    #     {
    #         $curl->setopt(CURLOPT_POST, 1);
    #         $curl->setopt(CURLOPT_HTTPPOST, $curlf);
    #     }

    #     $curl->setopt(CURLOPT_HTTPHEADER, \@def_headers);

    #     my $cpr;
    #     eval { $curl->perform(); };
    #     if ( ref $@ eq "Net::Curl::Easy::Code" )
    #     {
    #         $cpr = int($@);
    #     }
    #     else
    #     {
    #         # rethrow everyting else
    #         MSG "UNEXPECTED ERROR: $@";
    #         die $@;
    #     }

    #     LOG "REBEL($fox->{id}:$fox->{line}):FALLBACK:".
    #         "URL($url)".
    #         ($post ? ":POST($post)" : "").
    #         ($upload ? ":UPLOAD($upload)" : "");
    # }


    $fox = setup_fox($id);

    $fox->{id} = $id;

    $fox->{round} = $save_round;
    $fox->{status} = 'start';

    $round[$id] = $save_round;
    $status[$id] = 'start';

    if (defined $def_variables_per_fox)
    {
        for (keys %{$def_variables_per_fox})
        {
            $fox->{variables}->{$_} = $def_variables_per_fox->{$_}; # just to make them show
        }
    }

    $fox = setup_stack_variables($fox);

    if ($war_is_over || $DEBUG_ONE_SHOT)
    {
        LOG "REBEL($fox->{id}:0):END-OF-WAR";
        $fox->{status} = 'finished';
        $status[$id] = 'finished';
    }


    $curl = reset_curl($curl);

    return $fox;
}

my $verlognum = 0;
sub verification_log($$$)
{
    my $fox = shift;
    my $reason = shift;
    my $vn = shift;

    my $orygbody = $fox->{body} // 'EMPTY-BODY';
    delete $fox->{body};

    my $body = '';
    my $headers = ''; my $copyheaders = 1;
    for my $l (split/[\r\n]+/,$orygbody)
    {
        if ($copyheaders)
        {
            if ($l =~ /^\S+:\s+\S+/ || $l =~ /^\s*$/ || $l =~ /^HTTP\/1.[01]\s+\d\d\d/)
            {
                $headers .= "$l\n";
            }
            else
            {
                $body .= "$l\n";
                $copyheaders = 0;
            }
        }
        else
        {
            $body .= "$l\n";
        }
    }

    $verlognum++;
    my $vlnumx = sprintf "%04d", $verlognum;
    my $fnumx = sprintf "%04d", $fox->{id};
    my $vlogf = "verification.$fnumx.$vlnumx.$vn.log.html";

    mkdir("dbg") unless -d "dbg";
    open(V, ">dbg/$vlogf") or die "cannot create verification log: $!";

    print V "<h2>$fox->{page}</h2>\n";
    print V "<h2>$fox->{url}</h2>\n";
    my $vnow = strftime("%F %T", localtime);
    print V "<h2>$vnow</h2><hr>\n";
    print V "<h2>$reason [thread $fox->{id} at line $fox->{line}]</h2><hr>\n";
    print V "<pre style='font-size: 10px;'>\n".(Dumper $fox), "\n</pre>\n<hr>\n";
    print V "<pre style='font-size: 10px; white-space: pre-wrap; '>\n$headers\n</pre>\n<hr>\n";

    # disable popup escape
    #    if(top!=self)top.location.href=location.href;
    #    if (top === self){window.location = '/'; }
    $body =~ s/top[ !=]+self/false/g;

    print V $body;

    close(V);

    $fox->{body} = $orygbody;

    # print V
    #     "VERFAIL:$reason\n",
    #     (Dumper $fox),
    #     "\n\n";

}

sub writedata_callback
{
    my ($curl, $chunk, $handle) = @_;
    $body .= $chunk;
    return length $chunk;
}

sub thread_rebel
{
    my $id = shift;

    $status[$id] = 'start';
    $round[$id] = 0;

    my $fox = setup_fox($id);

    # read varfiles
    for my $varfile (@varfiles)
    {
        my @vf = read_file($varfile) or die("cannot open varfile($varfile): $!");
        @vf = grep {!/^#/ } grep {!/^\s*$/} @vf;
        my $varname = shift @varfiles_names;
        my $var = $vf[$id];
        die("varfile ($varname) too short") unless $var;
        chomp $var;
        $fox->{variables}->{$varname} = $var;
        LOG "VARFILE($id:$varname)=($var)";
    }

    my %tmph = %{$fox->{variables}};
    $def_variables_per_fox = \%tmph;

    $fox = setup_stack_variables($fox);

    # prepare curl
    $curl = new Net::Curl::Easy;
    $curl = init_curl($curl);
    $curl = reset_curl($curl);

    $curl->setopt(CURLOPT_HEADER,1);
    $curl->setopt(CURLOPT_URL, '');
    $curl->setopt(CURLOPT_CUSTOMREQUEST, undef);


    my $leading_delay =  int(rand($cfg{leading_delay} * $cfg{browsers})+1);

    LOG "REBEL($id:X) Start (delay: $leading_delay)";
    $queue_re->enqueue($id);
    sleep($leading_delay);

    # === loop =====================================
    my $skippages_active = 0;
    my $skippages_skipto = undef;

    my $verifyuntiltry = 0;
    my $verifyuntillasturl = undef;
    my $verifyuntilredo = 0;
    my @verifyuntilstack = ();
    while (1)
    {

        last if $fox->{status} eq 'finished';

        my $vlvn = $cfg{verification_log_variable};
        my $vlv = exists $fox->{variables}->{$vlvn} ? "$vlvn=$fox->{variables}->{$vlvn}" : "-";
        my $vlvx = exists $fox->{variables}->{$vlvn} ? $fox->{variables}->{$vlvn} : "-";

        my $sline = shift @scenario;
        if (not defined $sline) # end of scenario
        {
            LOG "REBEL($fox->{id}:0):END-OF-ROUND";
            $skippages_active = 0;

            $fox = reset_scenario($fox);

            next;
        }

        $fox->{line} = $sline->{line};

        next if ($skippages_active and $sline->{k} ne 'page');

        push(@verifyuntilstack, { %$sline });

# print "VU-STACK:", Dumper \@verifyuntilstack;
        if ($sline->{k} eq 'skipto')
        {
            if ($sline->{v} eq 'END')
            {
                LOG "REBEL($fox->{id}:$fox->{line}):SKIPTO(END)";
                # $fox->{lineact} = $#scenario + 10; # skip past end of scenario, it'll got hit above
                # die "not implemented with new auto-burl stuff and no lineact ";
                # next;

                $fox = reset_scenario($fox);
                next;
            }
            elsif ($sline->{v} =~  m/^(\S+)\s*$/)
            {
                my $target = $1;
                $skippages_active = 1;
                $skippages_skipto = $target;
                LOG "REBEL($fox->{id}:$fox->{line}):SKIPTO(ALWAYS:$target)";
                next;
            }
            elsif ($sline->{v} =~  m/^RND(\d+)\s+(\S+)/)
            {
                my $rnd = $1;
                my $target = $2;
                if (int(rand(100)) < $rnd)
                {
                    $skippages_active = 1;
                    $skippages_skipto = $target;
                    LOG "REBEL($fox->{id}:$fox->{line}):SKIPTO(RANDOM:$rnd:$target:YES)";
                }
                else
                {
                    LOG "REBEL($fox->{id}:$fox->{line}):SKIPTO(RANDOM:$rnd:$target:NO)";
                }

                next;
            }
            else
            {
                MSG "REBEL($fox->{id}:$fox->{line}):SKIPTO(SYNTAX ERROR:$sline->{v})";
            }
        }

        if ($sline->{k} eq 'verify' || $sline->{k} eq 'verifyneg')
        {
            if (not defined $fox->{body})
            {
                MSG "REBEL($fox->{id}:$fox->{line}:$vlv):ERROR:Verification Failed - body empty";
                verification_log($fox, "body empty", $vlvx);
                $fox = reset_scenario($fox);
                next;
            }

            my $patt = $sline->{v};
            my $verify = 1;
            if ($patt eq 'DEFAULT')
            {
                verification_log($fox, "DEFAULT", $vlvx);
                foreach my $vdef (@def_verifynegs)
                {
                    $patt = $vdef;
                    $verify = !($fox->{body} =~ m!$patt!s);
                    $patt = "DEFAULT:$patt"; # for reporting
                    # print STDERR "DEFAULT:$patt\n";
                    last unless $verify;
                }
            }
            else
            {
                $verify = ($fox->{body} =~ m!$patt!s);
                $verify = !$verify if  $sline->{k} eq 'verifyneg';
            }

            if (not $verify)
            {
                MSG "REBEL($fox->{id}:$fox->{line}:$vlv):ERROR:Verification Failed ($patt)";
                verification_log($fox,"verification:$patt", $vlvx);
                $fox = reset_scenario($fox);
            }
            next;
        }

        if ($sline->{k} eq 'verify_until') # verify_until max-count delay pattern
        {
            if (not defined $fox->{body})
            {
                MSG "REBEL($fox->{id}:$fox->{line}:$vlv):ERROR:Verification Failed - body empty";
                verification_log($fox, "body empty", $vlvx);
                $fox = reset_scenario($fox);
                next;
            }

            my @vline = split(/\s+/, $sline->{v}, 3);
            my $vmaxtry = $vline[0];
            my $delay = $vline[1];
            my $patt = $vline[2];

            my $verify = ($fox->{body} =~ m!$patt!s);

            if (not $verify)
            {
                $verifyuntiltry++; # resetted at page=
                if ($verifyuntiltry > $vmaxtry)
                {
                    MSG "REBEL($fox->{id}:$fox->{line}:$vlv):VERIFYUNTIL:Try limit exceeded ($patt)";
                    verification_log($fox,"verification:$patt", $vlvx);
                    $fox = reset_scenario($fox);
                    next;
                }

                MSG "REBEL($fox->{id}:$fox->{line}:$vlv):VERIFYUNTIL:Verification Failed ($patt) - try $verifyuntiltry/$vmaxtry";

                # add delay, redo url and verify_until

                while (my $sx = pop @verifyuntilstack)
                {
                    my $sxx = { %$sx };
                    ## MSG "unshift: ".Dumper($sxx);
                    unshift(@scenario, $sxx);
                }

#                my $sc3;
#                $sc3->{k} = 'delay';
#                $sc3->{v} = "$vdelay $vdelay";
#                $sc3->{line} = "$fox->{line}-vuredo-delay";
#                unshift(@scenario, $sc3);

#                MSG "unshift: ".Dumper($sxx);

#                my $sc1;
#                $sc1->{k} = 'verify_until';
#                $sc1->{v} = $sline->{v};
#                $sc1->{line} = "$fox->{line}";
#                unshift(@scenario, $sc1);

#                my $sc2;
#                $sc2->{k} = 'url';
#                $sc2->{v} = $verifyuntillasturl;
#                $sc2->{line} = "$fox->{line}-vuredo-url";
#                unshift(@scenario, $sc2);

            }

            sleep($delay) if $delay > 0;

            next;
        }

        if ($sline->{k} eq 'let')
        {
            my @vx = split(/\s+/, $sline->{v}, 2);
            my $val = $vx[1];

            $val = process_generators($val);

            $fox->{variables}->{$vx[0]} = $val;
            LOG "REBEL($fox->{id}:$fox->{line}):LET:VAR($vx[0]=$val)";
        }

        if ($sline->{k} eq 'sessionheader')
        {
            my @vx = split(/:\s+/, $sline->{v}, 2);
            my $val = $vx[1];

            $val = process_generators($val);
            $val = process_variables($fox->{variables}, $val);
            $val = process_variables(\%def_variables, $val);
            $val = process_variables($def_variables_per_fox->{$fox->{id}}, $val);

            $fox->{headers}->{$vx[0]} = $val; # xxxh
            LOG "REBEL($fox->{id}:$fox->{line}):SESSIONHEADER:($vx[0]: $val)";
        }

        if ($sline->{k} eq 'var' || $sline->{k} =~ /^var\@(\d+)$/)
        {
            my $occurence = 0;
            if ($sline->{k} =~ /^var\@(\d+)$/)
            {
                $occurence = $1;
            }

            my @vx = split(/\s+/, $sline->{v}, 2);
            my $patt = $vx[1];
            #print STDERR "PATTV($patt)\n";
            my $match = ($fox->{body} =~ m!$patt!s);
            if ($match)
            {
                if ($occurence > 0)
                {
                    my @matches = ($fox->{body} =~ m!$patt!g);
                    if (@matches)
                    {
                        # my $vchosen = $matches[rand @matches];
                        my $vchosen = $matches[$occurence - 1];

                        if ($vchosen)
                        {
                            $fox->{variables}->{$vx[0]} = $vchosen;
                            LOG "REBEL($fox->{id}:$fox->{line}):VARIABLE:VAR($vx[0]\@$occurence=$1)";
                        }
                        else
                        {
                            MSG "REBEL($fox->{id}:$fox->{line}:$vlv):ERROR:Variable ($vx[0]\@$occurence) occurence not found ($patt)";
                            verification_log($fox, "$vx[0]\@$occurence occurence not found:$patt", $vlvx);
                            $fox = reset_scenario($fox);
                        }
                    }
                    else
                    {
                        MSG "REBEL($fox->{id}:$fox->{line}:$vlv):ERROR:Variable ($vx[0]\@$occurence) not found ($patt)";
                        verification_log($fox, "$vx[0]\@$occurence not found:$patt", $vlvx);
                        $fox = reset_scenario($fox);
                    }

                }
                else
                {
                    $fox->{variables}->{$vx[0]} = $1;
                    LOG "REBEL($fox->{id}:$fox->{line}):VARIABLE:VAR($vx[0]=$1)";
                }
            }
            else
            {
                # more fixes to come
                $fox->{body} =~ s/&quot;/"/g;
                $fox->{body} =~ s/&apos;/'/g;
                $fox->{body} =~ s/&amp;/&/g;
                $fox->{body} =~ s/&lt;/</g;
                $fox->{body} =~ s/&gt;/>/g;
                $fox->{body} =~ s/&nbsp;/ /g;

                $match = ($fox->{body} =~ m!$patt!s);
                if ($match)
                {
                    $fox->{variables}->{$vx[0]} = $1;
                    LOG "REBEL($fox->{id}:$fox->{line}):VARIABLE:VAR($vx[0]=$1)";
                }
                else
                {

                    MSG "REBEL($fox->{id}:$fox->{line}:$vlv):ERROR:Variable ($vx[0]) not found ($patt)";
                    verification_log($fox, "$vx[0] not found:$patt", $vlvx);
#                    print V "VERFAIL($patt):\n", (Dumper $fox), "\n\n";
#                    close(V);
                    $fox = reset_scenario($fox);
                }


            }
            next;
        }

        # TODO copied from new leader.pl - not tested
        if ($sline->{k} =~ 'multivar' )
        {
            my $body = $fox->{body};
            my @vx = split(/\s+/, $sline->{v}, 2);
            my $v = $vx[0];
            if ($v =~ m/(\S+)\[(.*)\]\[(.*)\]/)
            {
                $v = $1;
                my $vfrom = $2;
                my $vto = $3;

                if ($body =~ m!$vfrom(.*?)$vto!)
                {
                    $body = $1;
                }
            }
            my $patt = $vx[1];
            #print STDERR "PATTV($patt)\n";
            my @matches = ($body =~ m!$patt!g);
            if (@matches)
            {
                my $vchosen = $matches[rand @matches];
                $fox->{variables}->{$v} = $vchosen;

                LOG "FOX($fox->{id}:$fox->{line}):MULTIVARIABLE:VAR($vx[0]=$v FROM ".join('|',@matches).")\n";
            }
            else
            {
                LOG "FOX($fox->{id}:$fox->{line}):ERROR:MultiVariable ($v) not found ($patt) - reset scenario\n";
                verification_log($fox, "MULTIVARIABLE($patt)", 'USERNAME');
                $fox = reset_scenario($fox);
            }
            next;
        }


        if ($sline->{k} eq 'autoburl' && !$DEBUG_NO_BURL)
        {
            my @burls = ($fox->{body} =~ m/(?:src|href)=["']([^"'']+?\.(?:png|jpe?g|gif|ico|css|js))/gi);
            for my $burl (@burls)
            {
                LOG "REBEL($fox->{id}:$fox->{line}):AUTO-BURL:$burl";
                my $sc;
                $sc->{k} = 'burl';
                $sc->{v} = $burl;
                $sc->{line} = "$fox->{line}-autoburl";
                unshift(@scenario, $sc);
            }
        }

        if ($sline->{k} eq 'delay')
        {
            my @v = ();
            if ($sline->{v} =~ m/(\d+)\s+(\d+)/)
            {
                @v = ($1, $2);
            }
            elsif ($sline->{v} =~ m/(\d+)/)
            {
                @v = ($1, $1);
            }
            else
            {
                if (exists $def_delays{$sline->{v}})
                {
                    @v = split/\s+/, $def_delays{$sline->{v}}, 2;
                }
                else
                {
                    MSG "WARNING: unknown delay definition ($sline->{v}), setting to NONE";
                    @v = (0,0);
                }
            }


            $fox->{status} = 'delay';
            $status[$id] = 'delay';

            my $d = ($DEBUG_NO_DELAY || $sline->{v} eq 'NONE') ? 0 : int(rand($v[1]-$v[0]+1)+$v[0]); # 10-20: rand(20-10+1)+10 = rand(11)+10 = [0..10]+10 = [10..20]
            LOG "REBEL($fox->{id}:$fox->{line}):DELAY($d)";

            sleep($d) if $d > 0; # here's the delay
            next;
        }


        # if not var or verify then remove page from memory,
        # delay is used with verify_until so it's needed too
        $fox->{body} = undef;
        close($body_h) if defined $body_h;

        if ($sline->{k} eq 'base')
        {
            $fox->{base} = $sline->{v};
            LOG "REBEL($fox->{id}:$fox->{line}):BASE($fox->{base})";
            next;
        }

        if ($sline->{k} eq 'fallback')
        {
            $fox->{fallback} = $sline->{v};
            LOG "REBEL($fox->{id}:$fox->{line}):FALLBACK($fox->{fallback})";
            next;
        }

        if ($sline->{k} eq 'define')
        {
            my @v = split/\s+/, $sline->{v}, 2;
            $fox->{variables}->{$v[0]} = $v[1];
            next;
        }

        if ($sline->{k} eq 'page')
        {
            $verifyuntiltry = 0; # reset counter for page
            @verifyuntilstack = ();

            $sline->{v} =~ s/^\s+//;
            $sline->{v} =~ s/\s+$//;
            $sline->{v} =~ s/\s+/ /;

            $fox->{page} = $sline->{v};
            $fox->{pageid} = $sline->{v};
            $fox->{pageid} =~ s/\s+.*//; # first word is id

            LOG "REBEL($fox->{id}:$fox->{line}):PAGE($fox->{pageid}):################################## $sline->{v} #####";

            if (defined $cfg{skippages} && $cfg{skippages} ne '' && $fox->{pageid} =~ m/$cfg{skippages}/)
            {
                LOG "REBEL($fox->{id}:$fox->{line}):SKIP-SKIPPAGES($fox->{pageid})";
                $skippages_active = 1;
                next;
            }

            if ($skippages_active)
            {
                if (defined $skippages_skipto && $fox->{pageid} ne $skippages_skipto)
                {
                    LOG "REBEL($fox->{id}:$fox->{line}):SKIP-SKIPTO($fox->{pageid}:$skippages_skipto)";
                    next;
                }

                $skippages_active = 0;
                $skippages_skipto = undef;
                next;
            }

            next;
        }

        if ($sline->{k} =~ /^b?url$/)
        {
            $fox->{status} = $sline->{k};
            $status[$id] = $sline->{k};

            my $url = $verifyuntillasturl = $sline->{v};

            my $post = undef;
            my $customrq = 0;
            my $customrq_arg = '';
            my $postempty = 0;
            my $postfile = undef;
            my $postraw = undef;
            my $upload = undef;
            my $curlf = undef;

            my $add_headers_h = undef;

            while ($url =~ /^\s*(.*)\s+HEADER\((.*?)\)\s*$/)
            {
                $url = $1;
                my $addhdrx = $2;
                $addhdrx =~ /(\S+):\s*(.*)/;
                $add_headers_h->{$1} = $2;

#                MSG "hdr($1)=($2)";
            }

            if ($url =~ /^\s*(\S+)\s+POST\s+(\S+)/)
            {
                $url = $1;
                $post = $2;
            }

            if ($url =~ /^\s*(\S+)\s+(PUT|DELETE)(\s+(.*))?/) # optional args
            {
                $url = $1;
                $customrq = $2;
                $customrq_arg = $4;
            }

            if ($url =~ /^\s*(\S+)\s+UPLOAD\s+(.*)/)
            {
                $url = $1;
                $upload = $2;
            }

            if ($url =~ /^\s*(\S+)\s+POSTFILE\s+(.*)/)
            {
                $url = $1;
                $postfile = $2;
            }

            if ($url =~ /^\s*(\S+)\s+POSTRAW\s+(.*)/)
            {
                $url = $1;
                $postraw = $2;
            }

            if ($url =~ /^\s*(\S+)\s+JSON\s+(.*)/)
            {
                $url = $1;
                $postraw = "application/json $2";
            }

            if ($url =~ /^\s*(\S+)\s+POSTEMPTY/)
            {
                $url = $1;
                $postempty = 1;
            }

            # setup variables in url
            $url = process_variables($fox->{variables}, $url);
            $url = process_variables(\%def_variables, $url);
            $url = process_variables($def_variables_per_fox->{$fox->{id}}, $url);
            $url = process_generators($url);

            if ($post)
            {
                $post = process_variables($fox->{variables}, $post);
                $post = process_variables(\%def_variables, $post);
                $post = process_variables($def_variables_per_fox->{$fox->{id}}, $post);
                $post = process_generators($post);
            }

            if ($postraw) # no encoding in postraw mode
            {
                $postraw = process_variables($fox->{variables}, $postraw, 1);
                $postraw = process_variables(\%def_variables, $postraw, 1);
                $postraw = process_variables($def_variables_per_fox->{$fox->{id}}, $postraw, 1);
                $postraw = process_generators($postraw);
            }

            if ($customrq_arg) # customrq_arg is like postraw mode
            {
                $customrq_arg = process_variables($fox->{variables}, $customrq_arg, 1);
                $customrq_arg = process_variables(\%def_variables, $customrq_arg, 1);
                $customrq_arg = process_variables($def_variables_per_fox->{$fox->{id}}, $customrq_arg, 1);
                $customrq_arg = process_generators($customrq_arg);
            }

# TODO commented out in leader.pl too...
#             # multivariables
#             for (keys %{$fox->{multivariables}})
#             {
#                 my $k = $_;

# #               print STDERR "VAR($k = $v)\n";
#                 $url =~ s/\Q{$k}\E/$v/g;
#                 $post =~ s/\Q{$k}\E/$v/g if $post;
#             }


            $url = $fox->{base}."/$url" unless $url =~ m{^https?://};
            $url =~ s{([^:])/+}{$1/}g; # remove multiple /////


            my $bulk = 0;
            # burl cache
            if ($sline->{k} eq 'burl')
            {
                if ($fox->{cache}->{$url} || $DEBUG_NO_BURL == 1)
                {
                    LOG
                        "REBEL($fox->{id}:$fox->{line}):BURL:".
                        "URL($url) CACHED";
                    next;
                }
                $fox->{cache}->{$url} = 1;
                $bulk = 1;
            }

            $fox->{url} = $url;
            $fox->{post} = $post; # just to remember
            $fox->{upload} = $upload; # just to remember
            $fox->{postfile} = $postfile; # just to remember
            $fox->{postraw} = $postraw; # just to remember

            if ($bulk)
            {
#                 $curl->setopt(CURLOPT_WRITEFUNCTION, undef);
                $curl->setopt(CURLOPT_WRITEDATA, $devnull);
            }
            else
            {
                $body = '';

                # TODO do we really need this handle if we have own callback (WRITEFUNCTION)?
                # open ($body_h, ">", \$body);
                # $curl->setopt(CURLOPT_WRITEDATA, $body_h);
                $curl->setopt(CURLOPT_WRITEDATA, $devnull);

                $curl->setopt(CURLOPT_WRITEFUNCTION, \&writedata_callback);
            }

            $curl->setopt(CURLOPT_HTTPGET, 1); # reset to GET, will be overwritten later
            $curl->setopt(CURLOPT_POST, 0);
            $curl->setopt(CURLOPT_CUSTOMREQUEST, undef);

            $curl->setopt(CURLOPT_URL, $url);
            # fprintf(stderr, "F%d:URL:PAGEID(%s):URL(%s)\n", id, pageid, realurl);

            if ($post)
            {
                $curl->setopt(CURLOPT_POST, 1);
                $curl->setopt(CURLOPT_COPYPOSTFIELDS, $post);
                $curl->setopt(CURLOPT_READDATA, undef);
            }

            if ($customrq) # PUT, DELETE
            {
                # $curl->setopt(CURLOPT_PUT, 1); -- expects file
                $curl->setopt(CURLOPT_CUSTOMREQUEST, $customrq);
                if (defined $customrq_arg && $customrq_arg ne '')
                {
                    # ? $curl->setopt(CURLOPT_POST, 1);
                    my @upfields = split/\s+/, $customrq_arg, 2;
                    my $ct = $upfields[0];
                    $add_headers_h->{'Content-Type'} = $ct; # 'Transfer-Encoding: chunked'?

                    $curl->setopt(CURLOPT_COPYPOSTFIELDS, $upfields[1]);
                    $curl->setopt(CURLOPT_READDATA, undef);

                }
                else
                {
                    $curl->setopt(CURLOPT_READDATA, undef);
                }
            }

            if ($postempty)
            {
                $curl->setopt(CURLOPT_CUSTOMREQUEST, "POST");
                $curl->setopt(CURLOPT_READDATA, undef);
            }

            if ($postfile)
            {
                $curl->setopt(CURLOPT_POST, 1);
                my @upfields = split/\s+/, $postfile, 2;
                my $f = $upfields[0];
                my $slug = $upfields[1];
                my $mt = check_mime($f);
                $add_headers_h->{'Content-Type'} = $mt; # 'Transfer-Encoding: chunked'?
                $add_headers_h->{Slug} = $slug;
                $add_headers_h->{Expect} = undef;

                # didn't work :(
                #
                my $ofile;
                open($ofile, "<", $f) or die($!);
                $curl->setopt(CURLOPT_READDATA, $ofile);
                $curl->setopt(CURLOPT_COPYPOSTFIELDS, undef);
                $curl->setopt(CURLOPT_POSTFIELDS, undef);
#                $curl->setopt(CURLOPT_COPYPOSTFIELDS, read_file($ofile));
            }

            if ($postraw)
            {
                $curl->setopt(CURLOPT_POST, 1);
                my @upfields = split/\s+/, $postraw, 2;
                my $ct = $upfields[0];
                # $global_rawpost_data = $upfields[1];
                $add_headers_h->{'Content-Type'} = $ct; # 'Transfer-Encoding: chunked'?

                $curl->setopt(CURLOPT_COPYPOSTFIELDS, $upfields[1]);
                $curl->setopt(CURLOPT_READDATA, undef);

                # $curl->setopt(CURLOPT_READFUNCTION, sub { return $global_rawpost_data; })
            }

            if ($upload)
            {
                $curlf = Net::Curl::Form->new;
                my @upfields = split/\s+/, $upload;
                while (@upfields)
                {
                    my $a = shift @upfields;
                    my $b = shift @upfields;
                    if (-f $b)
                    {
                        my $mt = check_mime($b);
                        MSG "UPLOAD($a -> $b [$mt])";
                        $curlf->add(
                            CURLFORM_COPYNAME, $a,
                            CURLFORM_FILE, $b,
                            CURLFORM_CONTENTTYPE, $mt
                        );
                    }
                    else
                    {
                        $curlf->add(
                            CURLFORM_COPYNAME, $a,
                            CURLFORM_COPYCONTENTS, $b
                        );
                    }

                }

                $curl->setopt(CURLOPT_POST, 1);
                $curl->setopt(CURLOPT_HTTPPOST, $curlf);
            }

            if (defined $add_headers_h || length(keys %{$fox->{headers}}) > 0) # merge default headers with additonal
            {
                my $allh;

                for my $k (keys %$def_headers_h)
                {
                    $allh->{$k} = $def_headers_h->{$k};
                }

                if (length(keys %{$fox->{headers}}) > 0)
                {
                    for my $k (keys %{$fox->{headers}})
                    {
                        $allh->{$k} = $fox->{headers}->{$k};
                    }
                }

                if (defined $add_headers_h)
                {
                    for my $k (keys %$add_headers_h)
                    {
                        $allh->{$k} = $add_headers_h->{$k};
                    }
                }

                $allh->{"X-Rebellion"} = "T=$fox->{id} L=$fox->{line} $fox->{page}";

                my @allharr = ();
                for my $k (keys %$allh)
                {
                    if (defined $allh->{$k})
                    {
                        push(@allharr, "$k: ".$allh->{$k});
                    }
                    else
                    {
                        push(@allharr, "$k:"); # reset header
                    }
                }
                $curl->setopt(CURLOPT_HTTPHEADER, \@allharr);
            }
            else # usually we can use the deafults
            {
                $curl->setopt(CURLOPT_HTTPHEADER, \@def_headers);
            }

            #my $curl_errorstr;
            #$curl->setopt(CURLOPT_ERRORBUFFER, $curl_errorstr);
            #$curl_errorstr = "-" unless defined $curl_errorstr;


            # fprintf(stderr, "F%d:ATTACK:PAGEID(%s)\n", id, pageid);

            my $cpr;
            eval { $curl->perform(); };
            if ( ref $@ eq "Net::Curl::Easy::Code" )
            {
                $cpr = int($@);
            }
            elsif ($@ ne "")
            {
                # rethrow everyting else
                print STDERR "\n\nUNEXPECTED ERROR: $@";
                print STDERR Dumper $@;
                die $@;
            }
            else
            {
                $cpr = 0;
            }

#            my $cookies = "Cookie: ";
#            for (keys %{$fox->{cookies}})
#            {
#                $cookies .= "$_=$fox->{cookies}->{$_}; ";
#            }
#            $rebel->{socket}->print("$cookies\n");
            my $responsecode = $curl->getinfo(CURLINFO_RESPONSE_CODE);
            my $curl_errorstr = $cpr != 0 ? $curl->strerror($cpr) : '-';
            my $curl_os_errno = $curl->getinfo(CURLINFO_OS_ERRNO);
            if ($cpr == 55 && $responsecode == 201)
            {
                # special upload case, errno=55 (Failed sending network data) + http respnse 201 (created)
                 MSG sprintf(
                        "REBEL(%d:%d):WARNING_55_201:PAGEID(%s):CURL(%d):ERRNO(%ld):HTTP(%ld):ERRMSG(%s)",
                        $id, $fox->{line},
                        $fox->{pageid}, $cpr, $curl_os_errno, $responsecode, $curl_errorstr);
                $cpr = 0;

            }
            elsif ($cpr != 0)
            {
                MSG sprintf(
                        "REBEL(%d:%d):ERROR:PAGEID(%s):CURL(%d):ERRNO(%ld):HTTP(%ld):ERRMSG(%s)",
                        $id, $fox->{line},
                        $fox->{pageid}, $cpr, $curl_os_errno, $responsecode, $curl_errorstr);
            }
            elsif ($responsecode >= 400 && !$bulk)
            {
                MSG sprintf(
                        "REBEL(%d:%d):HTTP_ERROR(%ld):PAGEID(%s)",
                        $id, $fox->{line},$responsecode,$fox->{pageid});

            }

            my $totaltime = $curl->getinfo(CURLINFO_TOTAL_TIME);
            my $conntime = $curl->getinfo(CURLINFO_CONNECT_TIME);
            my $appconntime = $curl->getinfo(CURLINFO_APPCONNECT_TIME);
            my $pttime = $curl->getinfo(CURLINFO_PRETRANSFER_TIME);
            my $sttime = $curl->getinfo(CURLINFO_STARTTRANSFER_TIME);
            my $redirtime = $curl->getinfo(CURLINFO_REDIRECT_TIME);
            my $downsize = $curl->getinfo(CURLINFO_SIZE_DOWNLOAD);
            my $upsize = $curl->getinfo(CURLINFO_SIZE_UPLOAD);
            my $reqsize = $curl->getinfo(CURLINFO_REQUEST_SIZE);

            my $pfix = ($cpr == 0) ? "OK!" : "ERR";

            LOG sprintf(
                        "REBEL(%d:%s):CALL-%s:PAGEID(%s):%s:CURL(%d:%ld:%s):HTTP(%ld):TT(%.3f):CT(%.3f):AT(%.3f):PT(%.3f):ST(%.3f):RT(%.3f):DS(%.1f):US(%.1f):RS(%.1f):%s",
                        $id,$fox->{line},
                        ($bulk ? "B" : "")."URL:",
                        $fox->{pageid},
                        $pfix,
                        $cpr, $curl_os_errno, $curl_errorstr,
                        $responsecode, # long
                        $totaltime,  # dbl
                        $conntime, # dbl
                        $appconntime, # dbl
                        $pttime, # dbl
                        $sttime, # dbl
                        $redirtime, # dbl
                        $downsize, # dbl
                        $upsize, # dbl
                        $reqsize, # dbl
                        $url
                        );

            if (!$bulk)
            {
                $fox->{body} = $body;
                $body = undef;
            }

            LOG
                "REBEL($fox->{id}:$fox->{line}):".
                ($bulk ? "B" : "")."URL:".
                "URL($url)".
                ($post ? ":POST($post)" : "");

            if ($cpr != 0 && !$bulk)
            {
                verification_log($fox, "CURL Error($cpr -- $curl_errorstr)", $vlvx);
                $fox = reset_scenario($fox);
            }
            elsif ($responsecode >= 400 && !$bulk)
            {
                verification_log($fox, "HTTP Error($responsecode)", $vlvx);
                $fox = reset_scenario($fox);
            }

            #####################################
            ### DBG
            #####################################
            elsif (!$bulk && $DEBUG_ALWAYS_SAVE_VERIFICATION_LOG)
            {
                verification_log($fox, "OK", $vlvx);
            }
            ####################################


            next;
        }

    }

    sleep(2);

    LOG "REBEL($id:X) Retired";
}


# =============================================================================
# === MAIN part (Lee) =========================================================
# =============================================================================


open($devnull, ">/dev/null") or die("cannot open /dev/null for write");

# === read config =============================================================


# create threads that are needed
my $th_sparky = threads->create({'stack_size' => 128*4096},\&thread_sparky); # just for case - bigger stack_size
$queue_re->dequeue(); # wait for sparky's confirmation
sleep(1); # allow time for sparky setup
MSG "Rebellion v$VERSION";
sleep(1);

# === read config =============================================================

#x my $fighter_squads = 0;
if (!defined $opt_c) { die("config file not specified"); }
open(C, "<$opt_c") or die("cannot open config file ($opt_c): $!");
while (<C>)
{
    chomp;
    next if /^\s*#/;
    next if /^\s*$/;

    if (/^header\s*=\s*(.+)/)
    {
        my $hh = $1;
        push(@def_headers, $hh);
        $hh =~ /(\S+):\s*(.*)/;
        $def_headers_h->{$1} = $2;
        next;
    }

    if (/^variable\s*=\s*(\S+)\s+(.+)/) # can have spaces!
    {
        my $vv = $2;
        $vv =~ s/\s+$//; # but not at the end
        $def_variables{$1} = $2;
        next;
    }

    if (/^verifyneg\s*=\s*(\S+)/)
    {
        push(@def_verifynegs, $1);
        next;
    }

    if (/^delaydef\s*=\s*(\S+)\s+(\S+)\s+(\S+)/)
    {
        $def_delays{$1} = "$2 $3";
        next;
    }

    if (/^varfile\s*=\s*(\S+)\s+(\S+)/)
    {
        push(@varfiles_names, $1);
        push(@varfiles, $2);
        next;
    }

    if (/^stackfile\s*=\s*(\S+)\s+(\S+)/)
    {
        my $vn = $1; my $fn = $2;
        push(@stackfiles_names, $vn);
        my @sf = read_file($fn) or die "cannot read stackfile($2)";
        $stackfiles->{$vn} = \@sf;

        next;
    }

    if (/^varlist\s*=\s*(\S+)\s+(\S+)/) # it's global, we read it now
    {
        my $vln = $1;
        my $vlf = $2;
        $queues_varlist->{$vln} = Thread::Queue->new();
        LOG "VARLIST($vln) from [$vlf]";
        open(VL, $vlf);
        while (<VL>)
        {
            chomp;
            next if /^#/;
            next if /^\s*$/;
            LOG "VARLIST($vln) insert($_)";
            $queues_varlist->{$vln}->enqueue($_);
        }
        close(VL);
        next;
    }

    # unspecified options
    if (/^(\S+)\s*=\s*(\S+)/)
    {
        $cfg{$1} = $2;
    }
}
close(C);

$rebels = $cfg{browsers};

MSG "Configuration:";
MSG Dumper \%cfg;
#x my $threads_per_squad = int($browsers / $fighter_squads);
#x $threads_per_squad++ while ($threads_per_squad * $fighter_squads < $browsers);

if (!defined $cfg{scenario}) { die("scenario file not specified"); }
open(C, "<$cfg{scenario}") or die("cannot open scenario file ($cfg{scenario}): $!");
my $scenline = 0;
while (<C>)
{
    chomp;
    $scenline++;

    next if /^\s*[#;]/;
    next if /^\s*$/;

    die "scenario syntax error[$scenline]: $_" unless /=/;

    my $sc;
    my @ss = split /=/, $_, 2;

    $ss[0] =~ s/^\s+//;
    $ss[0] =~ s/\s+$//;
    $ss[1] =~ s/^\s+//;
    $ss[1] =~ s/\s+$//;

    $sc->{k} = $ss[0];
    $sc->{v} = $ss[1];
    $sc->{line} = $scenline;
    push(@scenario_base, $sc);
}
close(C);

# === start the army ============================================================
my $d = 0;
my @th_rebels = ();
my $rebel_id; # loop counter
for $rebel_id (0..$rebels-1)
{
    push(@th_rebels, threads->create(\&thread_rebel, $rebel_id));
}

# wait for rebels to be ready
my $live_rebels = 0;
my $war_start_time = time();

while ($live_rebels < $rebels)
{
    $rebel_id = $queue_re->dequeue();
    $live_rebels++;
    MSG "REBELLION:rebel($rebel_id) reported for duty ($live_rebels of $rebels)";
}


# use Devel::FindGlobals;
# print STDERR print_globals_sizes();

# === main loop =================================================================
my $loop = 0;
while (1)
{
    $loop++;

    my %statuses = ();
    my $statusesrep;

    for $rebel_id (0..$rebels-1)
    {
        $statuses{$status[$rebel_id]}++;
    }

    my @statuskeys = qw/start url burl delay finished/;

    for (@statuskeys)
    {
        $statusesrep .= exists $statuses{$_} ? sprintf("%8s=%04d ", $_, $statuses{$_}) : ' ' x (8 + 1 + 5 + 1);
    }
    $statusesrep =~ s/\s+$//;

    my $totalrounds = 0;
    for $rebel_id (0..$rebels-1)
    {
        $totalrounds += $round[$rebel_id];
    }

    MSG "REBELLION:L($loop):R($totalrounds):S(subdf): $statusesrep";


    if (!$war_is_over && $totalrounds >= $cfg{tests})
    {
        $war_is_over = 'tests';
        MSG "REBELLION:war-is-over(tests)";
    }


    if (!$war_is_over && time() - $war_start_time > $cfg{duration})
    {
        $war_is_over = 'time';
        MSG "REBELLION:war-is-over(time)";
    }

    # finish dead bodies
    if ($war_is_over && $live_rebels > 0)
    {
        MSG "REBELLION:burying dead bodies ($live_rebels left)";
        for my $r (@th_rebels)
        {
            if ($r->is_joinable())
            {
                $r->join();
                $live_rebels--;
            }
        }
    }

    last if $live_rebels == 0;

    sleep(1);
}

MSG "REBELLION:FINISHED";
LOG 'END'; # messenger quits last
$th_sparky->join();
sleep(3);