Скрипт для кардера

Xakep, номер #020, стр. 020-036-5

print "Location: $go\n\n";}

else{&loadagain;}

sub loadagain{

print "Content-type: text/html\n\n";

@out=confiles ($file{form});

print @out; exit;}

/ Файл show.cgi /

#!/usr/local/bin/perl

require 'func.pl';

## Переменные

$time=60*15; # Лимит времени бездействия

$errorpic='error.jpg';

print "Content-type: image/jpeg\n\n";

$dat=$ENV{QUERY_STRING};

$dat=~s/^\///; $dat=~s/\.\.\///g;

$dat=~s/\.\///g; $dat=~s /[\\|><]//g;

if (not -e "$ip_dir$ENV{'REMOTE_ADDR'}"){&error;}

open (DATA, "$ip_dir$ENV{'REMOTE_ADDR'}");

$login=; close (DATA);

open (DATA, "$status_dir$login");

$time{end}=; chomp ($time{end});

$time{now}=; chomp ($time{now});

$ip=; chomp ($ip); close (DATA);

if (($ip eq $ENV{'REMOTE_ADDR'}) && (time()<$time{end}) && ((time()-$time{now})<$time)){

if (not -e "$pic_dir$dat"){&error;}

open (AA,">$status_dir$login");

print AA $time{end}."\n"; print AA time()."\n";

print AA $ip."\n";

open (AA,"$pic_dir$dat");

binmode AA; binmode STDOUT;

while ($bytesread = read(AA,$buffer,4096)) {

print $buffer;}}

else{&error;}

sub error{

open (AA,"$errorpic");

binmode AA; binmode STDOUT;

while ($bytesread = read(AA,$buffer,4096)) {

print $buffer;} exit;}

/ Файл show.cgi /

#!/usr/bin/perl

$pic_dir='s-zone/'; $status_dir="status/"; $user_dir="user/"; $ip_dir='ip/';

#############################################

# Процедура для замены данных в массиве

########################################

sub exchange{

my ($text1,$text2,@text3)=@_; my ($cl);

for ($cl=0; $cl<=$#text3; $cl++){

$text3[$cl]=~ s/$text1/$text2/g;}

return (@text3);}

########################################

# Процедура для склеивания файлов

##################################

sub confiles{

my (@files)=@_; my (@ret,@fil,$cur);

@ret=""; foreach $cur (@files){

open (CUR, "$cur"); @fil=; push (@ret,@fil);

close (CUR);}

return (@ret);}

####################################

# Процедура для чтения формы

#############################

sub parse_form{

read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

@pairs=split (/&/, $buffer);

foreach $pair (@pairs){

($name,$value) = split (/=/,$pair);

$value=~ tr/+/ /;

$value=~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;

$FORM{$name}=$value;

}}

1;

Ну вот вроде и все, что я хотел сказать. Знатоки Perl'а могут сами добавить дополнительные фичи к программам к уже имеющемуся ядру. Для хацкеров, которых ломает вводить всю эту байду, скрипты можно скачать с xakepy.al.ru.