Code is porn

function createCookie(name,value,days) {
 if (days) {
  var date = new Date();
  date.setTime(date.getTime()+(days*24*60*60*1000));
  var expires = "; expires="+date.toGMTString();
 }
 else var expires = "";
 document.cookie = name+"="+value+expires+"; path=/";
}

function readCookie(name) {
 var nameEQ = name + "=";
 var ca = document.cookie.split(';');
 for(var i=0;i < ca.length;i++) {
  var c = ca[i];
  while (c.charAt(0)==' ') c = c.substring(1,c.length);
  if (c.indexOf(nameEQ) == 0) return c.substring(nameEQ.length,c.length);
 }
 return null;
}

function eraseCookie(name) {
 createCookie(name,"",-1);
}

Label: cookies, Javascript

diposting oleh Unknown  # 22:40 0 Komentar

#!/bin/bash

MONTH="$((`date +%m`-1))"
YEAR=$(date +"%Y")

cd /var/www/

for f in $(ls /var/www | grep web); do
             cd /var/www/$f/log
             if [ -a $YEAR ];
             then
                     cd $YEAR
                          if [ -a 0$MONTH ];
                          then
                                  tar -zcvf 0$MONTH.tar.gz 0$MONTH
                                  rm -rf /var/www/$f/log/$YEAR/0$MONTH
                          fi
             fi
done

Label: apache, bash

diposting oleh Unknown  # 13:09 0 Komentar

#!/usr/bin/perl
#This is .latest.cgi
$|++; my @file = `ls -1 -t -p | grep -v -P '/'`; 
print "Location: $file[0]\n\n";
exit;

Label: bash, files, perl

diposting oleh Unknown  # 17:09 0 Komentar

#!/bin/sh

PSAW=`ps -o "%p" -C named --no-heading`
PSW=`echo $PSAW | cut -d" " -f 1`

if [ -z "$PSW" ]; then
    echo "Named not running!"
    . /etc/init.d/named start
fi

exit

Label: Bind, fedoracore3, sh

diposting oleh Unknown  # 17:04 0 Komentar

#!/usr/bin/perl
#This is .latest.cgi
$|++; my @file = `ls -1 -t -p | grep -v -P '/'`; 
print "Location: $file[0]\n\n";
exit;

Label: files, perl

diposting oleh Unknown  # 17:01 0 Komentar

@ 1D IN SOA dns.yourdomain.you dnsadmin.yourdomain.you. (
 3520070822 1D 120M 3D 1W
;SNYYYYMMDD
)

@ NS dns.yourdomain.you.
@ A  192.168.192.254

server  A 192.168.192.254
www CNAME server

;end

Label: Bind, DNS

diposting oleh Unknown  # 08:28 0 Komentar

#!/usr/bin/perl

# require common rutins.

my $USER = $ARGV[0]; my $DOMAIN = $ARGV[1]; &error(1) if (!$USER || !$DOMAIN);

$thepath = "/var/www/$USER";

system "useradd $USER -d $thepath -s /bin/bash";
system "mkdir $thepath" if (!-e $thepath);
system "mkdir $thepath/.log";
system "mkdir $thepath/.tmp";

$vhostconf = &load_as_string("/yourpath/vhost-prop/vhost.txt");
$vhostconf =~ s/\%DOMAIN\%/$DOMAIN/gi;
$vhostconf =~ s/\%USER\%/$USER/gi;
&save_file("/yourpath/vhost.d/$USER.conf",$vhostconf,0);

$logrotate = &load_as_string("/yourpath/vhost-prop/log.txt");
$logrotate =~ s/\%USER\%/$USER/gi;
&save_file("/etc/logrotate.d/httpd-$USER",$logrotate,0);

$phpini = &load_as_string("/yourpath/vhost-prop/php.ini.txt");
$phpini =~ s/\%USER\%/$USER/gi;
&save_file("$thepath/php.ini",$phpini,0);

system "cp -f /yourpath/vhost-prop/favicon.ico $thepath";
system "cp -f /yourpath/vhost-prop/robots.txt $thepath";
system "chmod 755 $thepath";
system "touch $thepath/.log/access.log";
system "touch $thepath/.log/error.log";
system "chmod 755 $thepath/.log";
system "chmod 755 $thepath/.tmp";
system "chown $USER:$USER $thepath -R";

#$newrec  = "$USER CNAME farm\n";
#$dnshead = &load_as_string("/yourpath/vhost-prop/in-dns.txt")."\n".$newrec;
#$serial = &serialize();
#$dnshead =~ s/\%SERIAL\%/$serial/gi;

#&save_file("/yourpath/vhost-prop/in-dns.txt",$newrec,1);
#&save_file("/var/named/yourdomains.dns",$dnshead);

#system "rndc reload yourdomains.net";

system "passwd $USER";

exit;

sub error { my $e = shift;
print "syntax: $ARGV[0] [user] [domain]\n" if ($e == 1);
exit;
}

Label: apache, linux, perl

diposting oleh Unknown  # 01:17 0 Komentar

sub pathdir {
        my $d=$_[0]; my (@d,@dir);
        opendir (D, $d); @d=grep(!/^\./, readdir(D)); close (D);
        foreach (@d) { push (@dir,&strip($_)) if (-d "$d/$_") }
        return @dir;
}

sub filedir {
        my $e=$_[1]."\$"; $e=~ s/\,/\$\|/g; my $d=$_[0];
        my (@d,@dir); opendir (D, $d); @d=grep(!/^\./, readdir(D)); close (D);
        foreach (grep(/$e/, @d)) { push (@dir,&strip($_)) if (-f "$d/$_") }
        return @dir;
}

sub load_as_string {
        my ($f,$k) = @_; my @R; my $t; return if (! -e $f && ! -f $f);
        open (F,"$f"); flock F, 2 if ($k eq 1); @R = ; close (F); flock F, 8 if ($k eq 1);
        $t =join("",@R); ~ s/\r//gi; return $t;
}

sub load_as_array {
        my ($f,$k) = @_; my @R; return if (! -e $f && ! -f $f);
        open (F,"$f"); flock F, 2 if ($k eq 1); @R = ; close (F); flock F, 8 if ($k eq 1);
        return @R
}

sub save_file {
        my ($rf,$rtext,$md,$k) = @_; if ($md eq 1) { $md=">>" } else { $md=">" }
        open (F, "$md$rf"); if ($k eq 1) {flock F, 2}
        print F $rtext; close (F); if ($k eq 1) {flock F, 8}
}

sub safestr {
        my $str=shift; $str=~ s/^\$.*//g; $str=~ s/^#.*//g;
        $str=~ s/^\s*//g; $str=~ s/\s*$//g;
        $str=~ s/\s*\s/ /g;$str=~ s/==\s/==/g; $str=~ s/\s==/==/g;
        $str=~ s/\n//g; $str=~ s/\r//g; $str =~ s/\t//g;
        return $str;
}

sub slash { my $str=shift; $str =~ s/\/\//\//gi; return $str }
sub strip { my $str=shift; $str =~ s/\n//gi; $str =~ s/\r//gi; return $str }
sub rstrip { my $str=shift; chop($str) if ($str=~ /\r$/); return $str }
sub htmlize { print "Content-type: text/html\n\n"; }
sub htmlize_nocache { print "Pragma: no-cache\nContent-type: text/html\n\n"; }
sub get_input {
        my $nossi = shift; my ($b,$p);
        if ($ENV{'QUERY_STRING'}) { $b = $ENV{'QUERY_STRING'}; }
        elsif ($ENV{REQUEST_METHOD} eq "POST") { read(STDIN, $b, $ENV{'CONTENT_LENGTH'});}
        if ($b) {
        foreach $p(split(/&/, $b)) {
                ($name, $value) = split(/=/, $p);
                $name =~ tr/+/ /; $value =~ tr/+/ /;
                $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
                $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
                $value =~ s///g if ($INPUT{$name});
                if ($INPUT{$name}) { $INPUT{$name} = "$INPUT{$name},$value";}
                else { $INPUT{$name} = $value;}
        }
        return %INPUT;
        }
}

sub get_filesize {
        my $size=0; if (-e $file) { $size= (stat($_))[7] }
        return $size;
}# end of get_filesize

sub serialize {
    my $time = shift; $time or ($time = time);
    my @months = qw!Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec!;

    my ($min, $hr, $day, $mon, $yr) = (localtime($time))[1,2,3,4,5];
    $tmon = $mon+1;
    $yr = $yr + 1900;
    ($min < 10) and ($min = "0$min");
    ($hr  < 10) and ($hr  = "0$hr");
    ($day < 10) and ($day = "0$day");
    ($tmon < 10) and ($tmon = "0$tmon");

    return "$yr$tmon$day";
}

tacoen.pm

package tacoenf;

sub winpath { my $path = shift; $path =~ s/\\/\//gi; return $path; }
sub pathwin { my $path = shift; $path =~ s/\//\\/gi; return $path; }
sub slash { my $str=shift; $str =~ s/\/\//\//gi; return $str }
sub strip { my $str=shift; $str =~ s/\n//gi; $str =~ s/\r//gi; return $str }
sub rstrip { my $str=shift; chop($str) if ($str=~ /\r$/); return $str }
sub htmlize { print "Content-type: text/html\n\n"; }
sub trim { my $s = shift; $s=~ s/\s+$//gi; $s=~ s/^\s+//gi; return $s; }
sub notrail { my $l = shift; chomp($l) if ($l=~ /\n$/); chomp($l) if ($l=~ /\r$/); $l=~ s/\s+/ /go; return $l }

sub safestr {
 my $str=shift; $str=~ s/^\$.*//g; $str=~ s/^#.*//g;
 $str=~ s/^\s*//g; $str=~ s/\s*$//g;
 $str=~ s/\s*\s/ /g;$str=~ s/==\s/==/g; $str=~ s/\s==/==/g;
 $str=~ s/\n//g; $str=~ s/\r//g; $str =~ s/\t//g;
 return $str;
}

sub pathdir {
 my $d=$_[0]; my (@d,@dir);
 opendir (D, $d); @d=grep(!/^\./, readdir(D)); close (D);
 foreach (@d) { push (@dir,&strip($_)) if (-d "$d/$_") }
 return @dir;
}

sub filedir {
 my $e=$_[1]."\$"; $e=~ s/\,/\$\|/g; my $d=$_[0];
 my (@d,@dir); opendir (D, $d); @d=grep(!/^\./, readdir(D)); close (D);
 foreach (grep(/$e/, @d)) { push (@dir,&strip($_)) if (-f "$d/$_") }
 return @dir;
}

sub load_as_string {
 my ($f,$k) = @_; my @R; my $t; return if (! -e $f && ! -f $f);
 open (F,"$f"); flock F, 2 if ($k eq 1); @R = ; close (F); flock F, 8 if ($k eq 1);
 $t =join("",@R); ~ s/\r//gi; return $t;
}


sub load_as_array {
 my ($f,$k) = @_; my @R; return if (! -e $f && ! -f $f);
 open (F,"$f"); flock F, 2 if ($k eq 1); @R = ; close (F); flock F, 8 if ($k eq 1);
 return @R
}

sub save_file {
 my ($rf,$rtext,$md,$k) = @_; if ($md eq 1) { $md=">>" } else { $md=">" }
 open (F, "$md$rf"); if ($k eq 1) {flock F, 2}
 print F $rtext; close (F); if ($k eq 1) {flock F, 8}
}

sub scopy {
 my ($src,$dst) = @_;
 if (-e $src) {
  open(FILE,"$src"); flock(FILE,2) if $operatingsystem eq "unix";
  @filedata = ; chomp @filedata;
  close(FILE);
  open(FILE,">$dst");
  foreach $_ (@filedata) { print FILE "$_\n"; }
  close(FILE);
 }
}


sub serialize {
 my $time = shift; $time or ($time = time);
 my @months = qw!Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec!;
 my ($sec,$min, $hr, $day, $mon, $yr) = (localtime($time))[0,1,2,3,4,5];
 $tmon = $mon+1;
 $yr = $yr + 1900;
 ($sec < 10)  and ($sec  = "0$sec");
 ($min < 10)  and ($min  = "0$min");
 ($hr < 10)   and ($hr   = "0$hr");
 ($day < 10)  and ($day  = "0$day");
 ($tmon < 10) and ($tmon = "0$tmon");
 return "$yr$tmon$day$hr$min$sec";
}

sub IniRead {
 my($file,$section,$key)=@_;
 my %ini = &IniLoad("v:\\claudio-b\\conf\\claudio.ini");
 return $ini{"$section:$key"};
}

sub IniLoad {
 # my %ini = &IniLoad("v:\\claudio-b\\conf\\claudio.ini");
 # print $ini{"path:autocue"};
 my $file=shift; my %ini; my @INI = &tacoenf::load_as_array($file);
 for $l(@INI) {
  $l=tacoenf::notrail($l);
  if ($l=~/^\[(.*)\]/) {
   $vsection = $l; $vsection =~ s/^\[(.*)\]$/$1/ie;
  }
  next if ($l eq "");
  next if ($l=~/^\[(.*)\]/);
  my $value=$vkey=$l;
  $vkey =~ s/(.*)\=(.*)/$1/gie; $vkey=tacoenf::trim($vkey);
  $value=~ s/(.*)\=(.*)/$2/gie; $value=tacoenf::trim($value);
  $ini{"$vsection:$vkey"} = $value;
 }
 return %ini

}

sub unix2dos   { my $f = shift; $f =~ s#/#\\#gi; return $f; } 
sub compatible { my $f = shift; $f =~ s#\\#/#gi; return $f; } 

1;

Label: common, perl

diposting oleh Unknown  # 01:08 0 Komentar

#!/usr/bin/perl
$|=1;

while (<>) {

    @X = split; $url = $X[0]; $url =~s/[\n|\r]//gi; $gurl = $url;

    # kecuali address mu
 
    if (
        ($gurl =~ /^http\:\/\/what\.youraddress\.net/) ||
        ($gurl =~ /^http\:\/\/192\.168\.192\.254/) ||
        ($gurl =~ /^http\:\/\/other\.youraddress\.net/)
    ){
        print "$gurl\n";
    } else {
        print "http://youraddress.net/togo\n";
    }

}

exit;

url_rewrite_program /yourpath/this-redirect-script
url_rewrite_children 12

Label: perl, squid

diposting oleh Unknown  # 00:34 0 Komentar

#!/usr/bin/perl
#
# untuk membersihkan file yang diakses terakhir $hari
# di directory $path
#
my $hari = 49;
my $path = $ARGV[1];
my $query = $ARGV[0];
if ((!$query) && (!$path)) { print "Sytanx: rdelete [pattern] [path]\n"; exit }

&destroy(`find $path -iname $query`);

sub destroy {
    my @filelist = @_;
    foreach $file(@filelist) {
        chomp($file);
        print "$file\n";
        unlink "$file";
    }
}

reset;
exit;

Label: files, perl

diposting oleh Unknown  # 22:16 0 Komentar