climbo

#!/usr/bin/perl -T

##################################################################
# contador.cgi      CONTADOR DE ACCESOS
#
# (c) Ivan Nieto Perez
# Este CGI puede descargarse de El Codigo:
# http://www.elcodigo.com
#
# Puede usarse libremente y modificarse siempre que se conserve
# esta cabecera intacta
#
##################################################################
#
# Contador de visitas a una pagina que se invoca desde una etiqueta <img>
# Sintaxis:
# <img src="/ruta_cgis/contador.pl?pagina=mi_pagina.html">
#
# Ejemplo:
# <img src="/cgi-bin/contador.pl?pagina=index.html">
#
# Este CGI debe tener permisos chmod 755, y el fichero con la
# cuenta chmod 666 o 777
#
##################################################################
#
# Codigos de error:
#   1   Error abriendo fichero para lectura ($FicheroCuenta)
#   2   Error abriendo fichero para escritura ($FicheroCuenta)
#   3   Este CGI no puede ser invocado directamente en la barra de direcciones del navegador
#   4   Faltan par�metros en la llamada al CGI
#   5   Este CGI no puede ejecutarse desde este dominio o pagina
#   6   Hay caracteres no permitidos en el nombre del fichero ($FicheroCuenta)
#
##################################################################

# CONFIGURACION

# Ruta fisica y nombre fichero de cuentas
$FicheroCuenta = '/var/www/htdocs/contador.txt';

# Dominio desde el que se puede ejecutar, separados por comas
$DOMINIOS_VALIDOS = "www.elcodigo.com,www.elcodigo.com,elcodigo.com,elcodigo.net";

#formato digitos
$digitos_por_bmp = 6;   # numero minimo de digitos en un bipmap
$flagAltura = 0;    # si a 1, los digitos seran de 16 pixels de alto, para dejar espacio para el borde
$flagNegativo = 0;  # a 1, los digitos son blancos sobre fondo negro, a 0 negros sobre fondo blanco

# FIN CONFIGURACION, NO TOCAR NADA A PARTIR DE AQUI (SALVO QUE SE SEPA LO QUE SE HACE)

# VARIABLES GLOBALES

# Contador
my $cuenta = '';

# Mapa de bits de cada digito
# Cada digito es 8 pixels de ancho x 10 de alto
# @digitos_negativo son blanco sobre fondo negro, @digitos son negro sobre fondo blanco
@digitos_negativo = ("c3 99 99 99 99 99 99 99 99 c3",  # 0
                     "cf c7 cf cf cf cf cf cf cf c7",  # 1
                     "c3 99 9f 9f cf e7 f3 f9 f9 81",  # 2
                     "c3 99 9f 9f c7 9f 9f 9f 99 c3",  # 3
                     "cf cf c7 c7 cb cb cd 81 cf 87",  # 4
                     "81 f9 f9 f9 c1 9f 9f 9f 99 c3",  # 5
                     "c7 f3 f9 f9 c1 99 99 99 99 c3",  # 6
                     "81 99 9f 9f cf cf e7 e7 f3 f3",  # 7
                     "c3 99 99 99 c3 99 99 99 99 c3",  # 8
                     "c3 99 99 99 99 83 9f 9f cf e3"); # 9

@digitos = ("3c 66 66 66 66 66 66 66 66 3c",  # 0
            "30 38 30 30 30 30 30 30 30 30",  # 1
            "3c 66 60 60 30 18 0c 06 06 7e",  # 2
            "3c 66 60 60 38 60 60 60 66 3c",  # 3
            "30 30 38 38 34 34 32 7e 30 78",  # 4
            "7e 06 06 06 3e 60 60 60 66 3c",  # 5
            "38 0c 06 06 3e 66 66 66 66 3c",  # 6
            "7e 66 60 60 30 30 18 18 0c 0c",  # 7
            "3c 66 66 66 3c 66 66 66 66 3c",  # 8
            "3c 66 66 66 66 7c 60 60 30 1c"); # 9

# FIN VARIABLES GLOBALES

# Comprueba dominio valido
   &comprueba_dominio;

# Lee query string
   &lee_querystr;

# Comprueba que se ha introducido el parametro necesario
   if ( $INFO{'pagina'} eq '' ) { die('Falta parametro nombre pagina.'); }

# Incremento de la cuenta del fichero
   &incrementaContador;

# Obtencion imagenes
   &generaMapaBits;

# Salida
   &escribeMapaBits;

   exit(0);

##################################################################
sub escribeMapaBits {
   print ("Content-type: image/x-xbitmap\n");
   print "Pragma: no-cache\n";
   print "Expires: now\n\n";

   if ($flagAltura) {
      printf ("#define count_width %d\n#define count_height 16\n",
              $len*8);
   }
   else {
      printf ("#define count_width %d\n#define count_height 10\n",
              $len*8);
   }
   printf STDOUT "static char count_bits[] = {\n";
   for($i = 0; $i < ($#bytes + 1); $i++) {
      print("0x$bytes[$i]");
      if ($i != $#bytes) {
         print(",");
         if (($i+1) % 7 == 0) {
            print("\n");
         }
      }
   }
   print("};\n");
}

##################################################################
# generaMapaBits() - $cuenta        numero a mostrar
#                    $digitos_por_bmp   minimo numero de digitos a mostrar
#                    $flagAltura    a 1 si digitos de 16 pixels alto
#                    $flagNegativo  a 1 si negativo (blanco sobre negro)
sub generaMapaBits {
   @bytes = ();
   $len = length($cuenta) > $digitos_por_bmp ? length($cuenta) : $digitos_por_bmp;
   $formattedCount = sprintf("%0${len}d",$cuenta);
   if ($flagAltura) {
      for ($i = 0; $i < $len*3; $i++ ) {
         if ($flagNegativo) {
            push(@bytes,"ff");
         }
         else {
            push(@bytes,"00");
         }
      }
   }
   for ($y=0; $y < 10; $y++) {
       for ($x=0; $x < $len; $x++) {
           $digit = substr($formattedCount,$x,1);
           if ($flagNegativo) {
               $byte = substr(@digitos_negativo[$digit],$y*3,2);
           }
           else {
               $byte = substr(@digitos[$digit],$y*3,2);
           }
           push(@bytes,$byte);
       }
   }
   if ($flagAltura) {
      for ($i = 0; $i < $len*3; $i++ ) {
         if ($flagNegativo) {
            push(@bytes,"ff");
         }
         else {
            push(@bytes,"00");
         }
      }
   }
}

###############################################################################
# $INFO{'pagina'} = nombre de la pagina cuyos accesos se desea contabilizar
sub incrementaContador {

   $pagina = $INFO{'pagina'};

   $encontrados = 0;
   $cuenta = 1;

   open(COUNT,"$FicheroCuenta") || die("Imposible abrir $FicheroCuenta.");
   &lock;
   @lineas = <COUNT>;
   &unlock;
   close(COUNT);

   # Espera aleatoria para accesos concurrentes
   srand(time ^ $$);

   # Contador especial para permitir contar en cualquier pagina
   open (FILE, ">$FicheroCuenta") || die("Imposible abrir $FicheroCuenta.");
   &lock;

   foreach $linea (@lineas) {
      my ($temppagina, $tempcuenta, $crlf) = split(/;/, $linea);
      if ( $temppagina eq $pagina ) {
         $cuenta = $tempcuenta + 1;
         print FILE "$pagina;$cuenta;\n";
      } else {
         print FILE "$linea";
      }
   }

   # Primer acceso a la pagina
   if ($cuenta eq '') {
      print FILE "$pagina;1;\n";
   }

   &unlock;
   close (FILE);
}


###############################################################################
sub lee_querystr {

    @vars = split(/&/, $ENV{QUERY_STRING});
    foreach $var (@vars) {
            ($v,$i) = split(/=/, $var);
            $v =~ tr/+/ /;
            $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
            $i =~ tr/+/ /;
            $i =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
            $i =~ s/<!--(.|\n)*-->//g;
            $INFO{$v} = $i;
    }
}


##################################################################
sub lock {
  local($file)=@_;
  flock($file, $LOCK_EX);
}


##################################################################
sub unlock {
  local($file)=@_;
  flock($file, $LOCK_UN);
}


##################################################################
sub comprueba_dominio {

  # Obtencion de la pagina desde la que se llama al CGI
  $pagina = $ENV{'HTTP_REFERER'};
  if ( $pagina eq '' ) { die('Referrer no presente.'); }
  ($http, $dominioypagina) = split(/\/\//,$pagina); # Separa por //
  ($dominio, @resto) = split(/\//, $dominioypagina);    # Separa por /

  # Comprobacion de dominio
  my $domvalido = 0;
  my $valido = 0;
  (@dominios_validos) = split(/,/, $DOMINIOS_VALIDOS);  # Lista de dominios validos
  foreach $dom (@dominios_validos) {
     if ( $dominio eq $dom ) { $domvalido = 1; }
  }

  if ( $domvalido != 1 ) {
     die('Dominio no valido.');
  }
}