Scripts de seguridad en Perl

Written in...: 
2000

Tutorial I presented at Computer Security conference 2000, giving many examples of small Perl scripts that can help improve security at a site.

Resumen: 

Tutorial que presenté en el congreso Seguridad en Cómputo 2000, dando varios ejemplos de pequeños scripts en Perl que pueden ayudar a la seguridad de un sitio.

1. Introducción

¿Y quién es el tal Gunnar?

  • Administrador de sistemas en la ENEP Iztacala
    • Si bien sé algo de programación, disto mucho de ser programador
  • Miembro externo del DSC
  • Administrador de sistemas desde 1993
  • Paranóico - La paranoia es úncamente la realidad vista a mayor resolución<

¿Y qué es Perl?

Un maravilloso y últimamente muy popular lenguaje de programación de todo propósito, fácilmente extensible.
El lenguaje está diseñado particularmente para buena parte de las necesidades que como administradores de sistemas podemos requerir: Procesar grandes cantidades de datos, buscar patrones en grandes cantidades de datos, manejar conexiones de red, etc.

Acerca de la licencia del código

Todo el código que encuentres aquí está disponible bajo la Licencia Pública de GNU (GPL) versión 2 o posterior, a elección del usuario.
La licencia GPL estipula que el código puede ser libremente distribuído, leído, modificado y redistribuído, incluído en otros proyectos, tomar fragmentos, o utilizado en cualquier manera, siempre y cuando éste y todo código derivado de él sean siempre distribuídos bajo la licencia GPL.
Para mayor información acerca de las licencias libres (copyleft y no copyleft) y no libres, aquí hay una interesante exposición.

¿Y por qué en inglés?

No, no es porque me guste el inglés. No hago esto por facilitarme el copiar ejemplos de un libro ni por pocho.
Creo que alguno de estos scripts será útil cuando menos a una persona que no sea hispanoparlante. Espero que así sea. Entre los hispanoparlantes con nivel técnico medio o elevado es mucho más
frecuente el dominio del inglés que en el caso contrario.
Espero que esta decisión mía no ofenda a ninguno de ustedes.

Formato del tutorial

En este tutorial analizaremos varios scripts de Perl de diferentes grados de complejidad. Dada la naturaleza de éste medio, no reproduciré los scripts en la presentación, sino que daré un esbozo estructural y daré ligas a páginas donde éstos estén disponibles.
Los scripts no están preparados, procesados y listos, sino que son muestras de diferentes técnicas que ustedes podrán utilizar en sus programas, o primeros esbozos de programas que requieren ser
perfeccionados para utilizarse en ambientes de producción.

2. Analizando datos

Expiración

En un servidor con más de cien cuentas se puede volver imposible llevar a mano el registro de qué cuentas están activas, qué cuentas ya expiraron y hace cuánto tiempo. Este sencillo script de menos de 70 líneas puede generar un reporte periódico al administrador del estado de las cuentas en su sistema.
Por simplicidad, el script está construído alrededor de la estructura fija del archivo /etc/shadow. Transportarlo a otros sistemas, sin embargo, debe ser trivial.

Consideraciones de seguridad

Estamos ante uno de los mayores riesgos de seguridad: un programa que debe correr con privilegio de root, el único usuario con derecho de leer el archivo /etc/shadow. Es muy importante tomar todas las precauciones; el script corre con use strict y en modo -Tw (tainted y warnings). Fuera de la lectura inicial no tiene ninguna interacción con el mundo; la salida la envía a STDOUT. Esto es para evitar que alguien se aproveche de sus elevados atributos para atacar al sistema.
Este script está pensado para correr desde el crontab de root.

Funcionamiento general

El funcionamiento de este script es muy sencillo. Tras cargar el módulo Date::Calc y activar el pragma strict, iteramos sobre cada línea del archivo /etc/shadow, revisando su octavo campo (recuerden que el número base de un arreglo es 0), acomodándolo acorde a su estado respecto a la fecha actual en uno de cinco arreglos.Posteriormente, por medio de otra muy simple rutina, imprime cada uno de estos arreglos en órden. El programa nos reportará en este órden las cuentas próximas a expirar o recién expiradas, las que expiraron en el último mes, las que llevan ya más de un mes expiradas, las que no han expirado y las que no tienen fecha de expiración.

Funcionamiento: Obtención y comparación de la fecha

En la línea 12 vemos que:

  1. $dias=Delta_Days(1970,1,1,@fecha);

En los sistemas Unix, las fechas se guardan como el número de días transcurridos desde el 1 de enero de 1970. Las fechas de expiración en
/etc/shadow están en este mismo formato, por lo cual compararlas posteriormente será únicamente comparar dos valores numéricos.

Funcionamiento: Generación del reporte

Al poblar los cinco arreglos pueden haber notado que lo hacemos con una referencia a un arreglo [$login,$dias]. Esto es para pasar dos datos en una sola variable escalar.
Al recibir estos datos en &reporta los separamos expresamente en $login y $dias para evitar que los datos nos lleguen en un formato no
previsto y afecten de alguna manera la ejecución y seguridad de nuestro programa.

  1. #!/usr/bin/perl -Tw
  2. # expira.pl
  3. #
  4. # Reporta las fechas de expiracion de las cuentas de los usuarios
  5. #
  6. use strict;
  7. use Date::Calc qw(Today Delta_Days);
  8. my ($dias,@fecha,$file,@linea,@nuncaExpira,@expiraPronto,@expiraMes,@expiraAntes,@noExpirada);
  9. @fecha=Today;
  10. $dias=Delta_Days(1970,1,1,@fecha);
  11. $file='/etc/shadow';
  12. # Solo root puede abrir el archivo /etc/shadow
  13. open(FILE,$file) or die 'Es necesario ejecutar este script como root';
  14. while (@linea=split(/:/,&lt;FILE&gt;)) {
  15. if ($linea[7] eq '' || $linea[7] &lt; 0) {
  16. # La cuenta no expira
  17. push (@nuncaExpira,[$linea[0],$linea[7]]);
  18. } elsif (($linea[7]-5)&lt;$dias &amp;&amp; ($linea[7]+5)&gt;$dias) {
  19. # La cuenta expira o expiro en estos dias
  20. push (@expiraPronto,[$linea[0],$linea[7]]);
  21. } elsif ($linea[7]+30&gt;=$dias &amp;&amp; $linea[7]&lt;$dias) {
  22. # La cuenta expiro hace menos de 30 dias
  23. push (@expiraMes,[$linea[0],$linea[7]]);
  24. } elsif ($linea[7]&lt;$dias) {
  25. # La cuenta expiro hace mas de un mes
  26. push (@expiraAntes,[$linea[0],$linea[7]]);
  27. } else {
  28. # La cuenta no ha expirado
  29. push (@noExpirada,[$linea[0],$linea[7]]);
  30. }
  31. }
  32. close(FILE);
  33. print &quot;\n&quot;;
  34. print '='x37,&quot;\n Cuentas que expiran en estos dias \n&quot;,'='x37,&quot;\n&quot;;
  35. &amp;reporta(\@expiraPronto);
  36. print '='x37,&quot;\n Cuentas que expiraron el ultimo mes \n&quot;,'='x37,&quot;\n&quot;;
  37. &amp;reporta(\@expiraMes);
  38. print '='x37,&quot;\n Cuentas que expiraron hace tiempo \n&quot;,'='x37,&quot;\n&quot;;
  39. &amp;reporta(\@expiraAntes);
  40. print '='x37,&quot;\n Cuentas que no han expirado \n&quot;,'='x37,&quot;\n&quot;;
  41. &amp;reporta(\@noExpirada);
  42. print '='x37,&quot;\n Cuentas que no expiran \n&quot;,'='x37,&quot;\n&quot;;
  43. &amp;reporta(\@nuncaExpira);
  44. sub reporta {
  45. my ($login,$dias);
  46. foreach (@{$_[0]}) {
  47. ($login,$dias)=@{$_};
  48. printf(&quot; %-15s %6s\n&quot;,$login,$dias);
  49. }
  50. }

Atributos

Es muy importante mantener verificada la integridad de nuestro sistema. Si no llevamos registro de los cambios efectuados a nuestros equipos, un atacante podrá entrar y modificar nuestro sistema sin ninguna dificultad, y será imposible determinar el alcance de los daños provocados por él.
Hay varios paquetes que hacen algo parecido a este script, el más conocido de ellos Tripwire. Todos ellos, sin embargo, pueden ser perfeccionados de más de una manera. Ilustramos aquí el funcionamiento del módulo central.

Dos versiones - El dilema de la firma

Presentamos dos versiones del programa - una que revisa únicamente los atributos de los archivos y una que calcula las firmas MD5 de cada
uno de ellos. ¿Por qué?

  • Seguridad- Si firmamos cada archivo, nos es necesario poder leer cada uno de ellos. Muchos archivos claves del sistema requieren tener root para leerlos. Si buscamos que un usuario cualquiera ejecute el programa, sólo podremos revisar los atributos.
  • Velocidad- Calcular la firma MD5 de un par de archivos es muy rápido. Sin embargo, calcular la de cientos o miles de archivos puede tomar mucho más tiempo del que estamos dispuestos a invertir. Cada usuario deberá poder elegir lo que juzgue mejor.

Consideraciones de seguridad

Aparte del punto de seguridad antes mencionado, nuestro programa debe poder listar todos los directorios a los que entre, ya que de ellos sacará la información necesaria. Si tenemos directorios protegidos con permisos 700, por ejemplo, nuestro programa no podrá entrar a este a menos que corra como el dueño del directorio.
Si decidimos no correr la versión MD5 del programa, un atacante con cierto conocimiento del sistema puede sin ningún problema alterar los
datos para cubrir sus huellas. Esta es una protección contra cambios no deseados y contra script kiddies.

Funcionamiento general

El programa revisa primero que nada si fue llamado en modo de creación de la base de datos o de revisión del sistema. En el primer caso, es llamado para únicamente procesar un archivo. La operación es muy sencilla - Imprime una línea con las características que stat arroja sobre el archivo. Esta línea la podemos guardar en nuestra base de datos.
Al verificar archivos, el programa itera sobre el archivo con los datos y, si hay alguna discrepancia con el estado actual, lo reporta de
una manera fácil de leer y comprender.

Funcionamiento general: Ejemplo de salida

  1. [gwolf@server gwolf]$ ./atributos.pl -p /home/gwolf/archivo_prueba.txt
  2. /home/gwolf/archivo_prueba.txt|1811|246064|33188|2|1160|0|1035916|2543|973982482|973982482|8192|6
  3. [gwolf@server gwolf]$ ./atributos.pl -p /home/gwolf/archivo_prueba.txt &gt; database.ck
  4. [gwolf@server gwolf]$ ./atributos.pl -c database.ck
  5. [gwolf@server gwolf]$ echo 'modificando' &gt;&gt; archivo_prueba.txt
  6. [gwolf@server gwolf]$ ./atributos.pl -c database.ck
  7. /home/gwolf/archivo_prueba.txt:
  8. size is now 2918 (should be 2907)
  9. mtime is now 973982824 (should be 973982482)
  10. ctime is now 973982824 (should be 973982482)

Funcionamiento: Procesando opciones

En el script utilizamos el módulo Getopt::Std. Con él, las opciones de línea de comando que son especificadas con el comando

  1. getopt('p:c:');</code
  2. son recibidas en las variables <code>$opt_p
y $opt_c.

Funcionamiento: stat

Para conseguir los atributos de un archivo, no hay nada más útil que stat. Esta función nos regresa el siguiente arreglo:

  • dev Dispositivo físico
  • ino Número de i-nodo
  • mode Tipo y permisos del archivo
  • nlink Número de ligas duras
  • uid UID
  • gid GID
  • rdev Identificador de dispositivo (archivos especiales)
  • size Longitud total
  • atime Último acceso (formato epoch)
  • mtime Última modificación (formato epoch)
  • ctime Tiempo de modificación del inodo (formato epoch)
  • blksize Tamaño de bloques preferido para el sistema de archivos
  • blocks Número de bloques utilizados

  1. #!/usr/bin/perl -Tw
  2. use Getopt::Std;
  3. # We use this for prettier output later in &amp;printchanged()
  4. @statnames = qw(dev ino mode nlink uid gid rdev size mtime ctime blksize blocks);
  5. getopt('p:c:');
  6. die &quot;Usage: $0 [-p &lt;filename&gt;|-c &lt;filename&gt;]\n&quot; unless ($opt_p or $opt_c);
  7. if ($opt_p) {
  8. die &quot;Unable to stat file $opt_p: $!\n&quot; unless (-e $opt_p);
  9. print $opt_p,&quot;|&quot;,join('|',(lstat($opt_p))[0..7,9..12]),&quot;\n&quot;;
  10. exit;
  11. }
  12. if ($opt_c) {
  13. open(CFILE,$opt_c) or die &quot;Unable to open check file $opt_c: $!\n&quot;;
  14. while (&lt;CFILE&gt;){
  15. chomp;
  16. @savedstats = split('\|');
  17. die &quot;Wrong number of fields in line beginning with $savedstats[0]&quot; unless ($#savedstats == 12);
  18. @currentstats = (lstat($savedstats[0]))[0..7,9..12];
  19. # print the changed fields only if something has changed
  20. &amp;printchanged(\@savedstats,\@currentstats) if (&quot;@savedstats[1..12]&quot; ne &quot;@currentstats&quot;);
  21. }
  22. close(CFILE);
  23. }
  24. # iterates through attributes lists and prints any changes between
  25. # the two
  26. sub printchanged{
  27. my ($saved,$current) = @_;
  28. # print the name of the file after popping it off of the array read
  29. # from the check file
  30. print shift @{$saved},&quot;:\n&quot;;
  31. for (my $i = 0 ; $i &lt; $#{$saved} ; $i++) {
  32. if ($saved-&gt;[$i] ne $current-&gt;[$i]) {
  33. print &quot;\t&quot;.$statnames[$i].&quot; is now &quot;.$current-&gt;[$i];
  34. print &quot; (should be &quot;.$saved-&gt;[$i].&quot;)\n&quot;;
  35. }
  36. }
  37. }

Atributos y MD5

Es muy importante mantener verificada la integridad de nuestro sistema. Si no llevamos registro de los cambios efectuados a nuestros equipos, un atacante podrá entrar y modificar nuestro sistema sin ninguna dificultad, y será imposible determinar el alcance de los daños provocados por él.
Hay varios paquetes que hacen algo parecido a este script, el más conocido de ellos Tripwire. Todos ellos, sin embargo, pueden ser perfeccionados de más de una manera. Ilustramos aquí el funcionamiento del módulo central.

Dos versiones - El dilema de la firma

Presentamos dos versiones del programa - una que revisa únicamente los atributos de los archivos y una que calcula las firmas MD5 de cada
uno de ellos. ¿Por qué?

  • Seguridad- Si firmamos cada archivo, nos es necesario poder leer cada uno de ellos. Muchos archivos claves del sistema requieren tener root para leerlos. Si buscamos que un usuario cualquiera ejecute el programa, sólo podremos revisar los atributos.
  • Velocidad- Calcular la firma MD5 de un par de archivos es muy rápido. Sin embargo, calcular la de cientos o miles de archivos puede tomar mucho más tiempo del que estamos dispuestos a invertir. Cada usuario deberá poder elegir lo que juzgue mejor.

Consideraciones de seguridad

Aparte del punto de seguridad antes mencionado, nuestro programa debe poder listar todos los directorios a los que entre, ya que de ellos sacará la información necesaria. Si tenemos directorios protegidos con permisos 700, por ejemplo, nuestro programa no podrá entrar a este a menos que corra como el dueño del directorio.
Si decidimos no correr la versión MD5 del programa, un atacante con cierto conocimiento del sistema puede sin ningún problema alterar los
datos para cubrir sus huellas. Esta es una protección contra cambios no deseados y contra script kiddies.

Funcionamiento general

El programa revisa primero que nada si fue llamado en modo de creación de la base de datos o de revisión del sistema. En el primer caso, es llamado para únicamente procesar un archivo. La operación es muy sencilla - Imprime una línea con las características que stat arroja sobre el archivo. Esta línea la podemos guardar en nuestra base de datos.
Al verificar archivos, el programa itera sobre el archivo con los datos y, si hay alguna discrepancia con el estado actual, lo reporta de
una manera fácil de leer y comprender.

Funcionamiento general: Ejemplo de salida

  1. [gwolf@server gwolf]$ ./atributos.pl -p /home/gwolf/archivo_prueba.txt
  2. /home/gwolf/archivo_prueba.txt|1811|246064|33188|2|1160|0|1035916|2543|973982482|973982482|8192|6
  3. [gwolf@server gwolf]$ ./atributos.pl -p /home/gwolf/archivo_prueba.txt &gt; database.ck
  4. [gwolf@server gwolf]$ ./atributos.pl -c database.ck
  5. [gwolf@server gwolf]$ echo 'modificando' &gt;&gt; archivo_prueba.txt
  6. [gwolf@server gwolf]$ ./atributos.pl -c database.ck
  7. /home/gwolf/archivo_prueba.txt:
  8. size is now 2918 (should be 2907)
  9. mtime is now 973982824 (should be 973982482)
  10. ctime is now 973982824 (should be 973982482)

Funcionamiento: Procesando opciones

En el script utilizamos el módulo Getopt::Std. Con él, las opciones de línea de comando que son especificadas con el comando
getopt('p:c:');
son recibidas en las variables $opt_p y $opt_c.

Funcionamiento: stat

Para conseguir los atributos de un archivo, no hay nada más útil que stat. Esta función nos regresa el siguiente arreglo:

  • dev Dispositivo físico
  • ino Número de i-nodo
  • mode Tipo y permisos del archivo
  • nlink Número de ligas duras
  • uid UID
  • gid GID
  • rdev Identificador de dispositivo (archivos especiales)
  • size Longitud total
  • atime Último acceso (formato epoch)
  • mtime Última modificación (formato epoch)
  • ctime Tiempo de modificación del inodo (formato epoch)
  • blksize Tamaño de bloques preferido para el sistema de archivos
  • blocks Número de bloques utilizados

  1. #!/usr/bin/perl -Tw
  2. use Getopt::Std;
  3. use Digest::MD5 qw(md5);
  4. # We use this for prettier output later in &amp;printchanged()
  5. @statnames = qw(dev ino mode nlink uid gid rdev size mtime ctime blksize blocks md5);
  6. getopt('p:c:');
  7. die &quot;Usage: $0 [-p &lt;filename&gt;|-c &lt;filename&gt;]\n&quot; unless ($opt_p or $opt_c);
  8. if ($opt_p) {
  9. die &quot;Unable to stat file $opt_p: $!\n&quot; unless (-e $opt_p);
  10. open(F,$opt_p) or die &quot;Unable to open $opt_p: $!\n&quot;;
  11. $digest = Digest::MD5-&gt;new-&gt;addfile(F)-&gt;hexdigest;
  12. close(F);
  13. print $opt_p,&quot;|&quot;,join('|',(lstat($opt_p))[0..7,9..12]),&quot;|$digest\n&quot;;
  14. exit;
  15. }
  16. if ($opt_c) {
  17. open(CFILE,$opt_c) or die &quot;Unable to open check file $opt_c: $!\n&quot;;
  18. while (&lt;CFILE&gt;){
  19. chomp;
  20. @savedstats = split('\|');
  21. die &quot;Wrong number of fields in line beginning with $savedstats[0]&quot; unless ($#savedstats == 13);
  22. @currentstats = (lstat($savedstats[0]))[0..7,9..12];
  23. open(F,$savedstats[0]) or die &quot;Unable to open $opt_c: $!\n&quot;;
  24. push(@currentstats,Digest::MD5-&gt;new-&gt;addfile(F)-&gt;hexdigest);
  25. close(F);
  26. # print the changed fields only if something has changed
  27. &amp;printchanged(\@savedstats,\@currentstats) if (&quot;@savedstats[1..13]&quot; ne &quot;@currentstats&quot;);
  28. }
  29. close(CFILE);
  30. }
  31. # iterates through attributes lists and prints any changes between
  32. # the two
  33. sub printchanged{
  34. my ($saved,$current) = @_;
  35. # print the name of the file after popping it off of the array read
  36. # from the check file
  37. print shift @{$saved},&quot;:\n&quot;;
  38. for (my $i = 0 ; $i &lt; $#{$saved} ; $i++) {
  39. if ($saved-&gt;[$i] ne $current-&gt;[$i]) {
  40. print &quot;\t&quot;.$statnames[$i].&quot; is now &quot;.$current-&gt;[$i];
  41. print &quot; (should be &quot;.$saved-&gt;[$i].&quot;)\n&quot;;
  42. }
  43. }
  44. }

3. Búsqueda de patrones

Bitácoras - Uso del sistema

Es muy importante para un administrador de sistemas analizar los datos generados por las bitácoras de su sistema. De ellas podemos, entre otras cosas, sacar posibles errores que estemos cometiendo con nuestra configuración del sistema o encontrar posibles intentos de intrusión. Desafortunadamente, leer bitácoras puede ser tedioso.
Presento aquí un script que analiza la salida de last buscando cuántas veces se ha conectado un usuario y por cuánto tiempo en el último mes.

Consideraciones de seguridad

Las bitácoras del sistema típicamente seran legibles únicamente para root. En este caso decidí utilizar un programa que funciona en el espacio de usuario y nos presenta la bitácora binaria wtmp para evitar hacer otra demostración que requiera correr como superusuario.

Funcionamiento general

El programa itera sobre cada línea resultante de correr el programa indicado en $lastProg, ignorando las líneas que no van asociadas a un login verdadero. Utilizando el hash %usedTime registra en una sencilla estructura cuántas veces entró un usuario, y por cuánto tiempo lo hizo. Por último, nos lo reporta utilizando un formato de printf.

Funcionamiento: Sumando minutos y horas

En la función toMinutes primero que nada verificamos que el formato de la hora sea el correcto: Dos dígitos representando la hora y otros dos representando los minutos, separados por dos puntos. Nos es más fácil guardar un valor fácil de sumar, como lo son los minutos, por lo que multiplicamos las horas por 60 y sumamos el resultado a los minutos. Sumamos esto al valor ya existente en $usedTime{$user}[0].

Funcionamiento: Separando horas de minutos por el camino fácil

Al principio del programa tenemos la directiva use integer;. Esta indica al compilador que use aritmética entera, en vez de trabajar con puntos flotantes, el comportamiento normal de Perl. Esto, además de darnos un poco de velocidad al hacer operaciones, nos permite dar menos rodeos en la función printResults. Para separar horas y minutos basta con que dividamos los minutos entre 60 - El entero resultante son las horas, el residuo los minutos, y no tendremos que pelearnos con fracciones decimales.

  1. #!/usr/bin/perl -w
  2. use integer;
  3. use strict;
  4. my (%usedTime, $lastProg);
  5. $lastProg = '/usr/bin/last';
  6. foreach my $line (`$lastProg`) {
  7. next if ($line =~ /^(reboot|ftp|wtmp begins)/ || $line =~ /^\s*$/);
  8. $line =~ s/\s+$//g;
  9. my $user = substr($line,0,10);
  10. $user =~ s/\s.+//g;
  11. my $time = &amp;toMinutes(substr($line,length($line)-6,5));
  12. $usedTime{$user} = [0,0] unless defined($usedTime{$user});
  13. $usedTime{$user}[0] += $time;
  14. $usedTime{$user}[1] += 1;
  15. }
  16. &amp;printResults(\%usedTime);
  17. exit 0;
  18. sub toMinutes {
  19. my ($in,$hr,$min);
  20. $in = shift;
  21. return 0 unless ($in =~ /^\d\d\:\d\d$/);
  22. $hr = substr($in,0,2);
  23. $min = substr($in,3,2);
  24. return ($hr*60+$min);
  25. }
  26. sub printResults {
  27. my ($totMin,$hr,$min,$numLogins);
  28. print &quot;Login Time used Logins\n&quot;;
  29. print &quot;============================\n&quot;;
  30. foreach my $user (sort(keys(%usedTime))) {
  31. $totMin=$usedTime{$user}[0];
  32. $numLogins=$usedTime{$user}[1];
  33. $hr=$totMin / 60;
  34. $min=$totMin % 60;
  35. printf(&quot;%-10s %02s:%02s %-2s\n&quot;,$user,$hr,$min,$numLogins);
  36. }
  37. }

Bitácoras - Errores del servidor HTTP

Muchos programas analizan, de alguna u otra manera, el contenido de las bitácoras del sistema (como ejemplos, Logcheck (tutorial en español disponible aquí) y Swatch). Hay programas también dedicados a monitorear y reaccionar en tiempo real a los errores producidos por Apache, como el Apache Guardian.
Sin embargo, un programa que recorra un archivo de bitácora de Apache y reporte, de una manera limpia y fácil de entender los errores ocurridos tenía que ser ideado a mano por los administradores. Es eso lo que intento aquí cubrir.

Consideraciones de seguridad

Este script debe correr con un usuario que tenga derecho de ver el archivo de bitácoras de Apache, típicamente localizado en /var/www/logs/error_log/var/log/httpd/error_log. Para evitar que este script requiera privilegios de root para correr, sugiero que dicho archivo pertenezca a un grupo de administración (daemon o wheel, por ejemplo), permitiendo a dicho grupo acceso únicamente de lectura, de la siguiente manera:
-rw-r-----  1 root  daemon  2188152 Dec  7 10:03 /var/www/logs/error_log

Funcionamiento general

El script procesa una tras otra todas las líneas del archivo indicado en la variable $file. Reporta un resúmen de lo que encuentre en dicho archivo con el siguiente formato:

  1. Directory index forbidden by rule
  2. 1
  3. 1 /var/www/htdocs/comun/
  4. 7 /var/www/htdocs/data/Icons/
  5. 2 /var/www/htdocs/images/
  6. File does not exist
  7. 1
  8. 5 /var/www/htdocs/biblio/
  9. 2 /var/www/htdocs/CURSO
  10. 1 /var/www/htdocs/adm_list/approve.cgi
  11. (...)

Funcionamiento: Organizando los datos

El formato de las bitácoras de error de Apache es el siguiente:
[<i>fecha</i>] [<i>categoría</i>] [client <i>w.x.y.z</i>] <i>tipo de error</i>: <i>archivo que lo ocasionó</i>
por ejemplo,
[Thu Dec  7 10:03:27 2000] [error] [client 192.168.2.45] File does not exist: /var/www/htdocs/esta/pagina/no/existe
Lo dividimos, entonces, utilizando el caracter ] como separador de campo. Descartamos todas las líneas que no lleven error como categoría, y de las líneas que nos interesen, el último campo lo dividimos en tipo de error y archivo que lo ocasiona utilizando el
caracter :.
En el hash %errores guardamos los datos resultantes, utilizando como llave el tipo de error, y agregando el archivo que lo ocasionó a la lista guardada por referencia relacionada a esa llave.

Funcionamiento: Reportando

Al reportar, recorremos los tipos de error y, para cada uno de ellos, recorremos el arreglo, guardando ahora en el hash %sumado como llave el nombre de cada uno de los causantes de error, y sumándole uno al valor de esta llave cada que lo encontremos. Una vez procesado el arreglo completo, reportamos primero el tipo de error, y después (indentando por claridad) cada uno de los archivos que lo ocasionaron, con el número de veces que fue llamado.

  1. #!/usr/bin/perl -Tw
  2. use integer;
  3. use strict;
  4. my (%errores, $file);
  5. $file = '/var/www/logs/error_log';
  6. open(IN,&quot;&lt;$file&quot;) or die &quot;Could not open $file - $@ $!&quot;;
  7. foreach my $line (&lt;IN&gt;) {
  8. chomp($line);
  9. my (@datos,@detalles);
  10. @datos = split(/\]/,$line);
  11. next if ($datos[1] ne ' [error');
  12. @detalles = split(/: /,$datos[3]);
  13. $errores{$detalles[0]} = [] if (not defined $errores{$detalles[0]});
  14. my ($tipoErr,$archErr) = @detalles;
  15. push(@{$errores{$tipoErr}},$archErr);
  16. }
  17. &amp;printResults(\%errores);
  18. sub printResults {
  19. my ($llave,%hash,%sumado);
  20. %hash = %{$_[0]};
  21. foreach $llave (sort(keys(%hash))) {
  22. print &quot;$llave\n&quot;;
  23. while (@{$hash{$llave}}) {
  24. my ($tmp);
  25. $tmp=shift(@{$hash{$llave}});
  26. $sumado{$tmp}++;
  27. }
  28. foreach my $file (sort(keys(%sumado))) {
  29. printf (&quot; %3d %25s\n&quot;,$sumado{$file},$file);
  30. }
  31. }
  32. }

Formato

Hay varios archivos fundamentales para la operación de nuestro sistema que requieren seguir un formato específico - probablemente, el mejor ejemplo de esto sea el archivo de información de los usuarios, /etc/passwd, y los archivos íntimamente relacionados con él, /etc/groups y /etc/shells. Además de esto, no es difícil para un atacante esconder su presencia utilizando trucos muy sencillos, algunos de los cuales encontraremos con este programa.

Consideraciones de seguridad

No me cansaré de repetirlo: Si no hay una razón que nos obligue a correr como root determinado programa, no tenemos por qué hacerlo
Este script todavía puede ser muy mejorado - No porque este programa no nos reporte una situación riesgosa en estos archivos significa que están seguros. Podríamos agregar verificaciones para cuentas 0 que no pertenecieran única y exclusivamente a root, cuentas con login root que no tuvieran UID 0, cuentas de usuario con UID 65536 (equivalente a root), nombres de usuario pertenecientes a cuentas del sistema (kmem, mail, adm, wheel, etc.) y otras muchas posibles situaciones.

Funcionamiento general

Primero que nada, creamos dos arreglos, uno con el contenido relevante de /etc/group y otro con el de /etc/shells. Al hacer esto, aprovechamos para verificar su correcto formato - En /etc/group revisamos que tenga el número correcto de campos y que no haya ni nombres de grupo ni GIDs repetidos. Después de esto, revisamos que cada uno de los shells listados en /etc/shells exista y sea ejecutable.
Utilizando las mismas estrategias, finalmente abrimos y analizamos línea por línea /etc/passwd. Revisamos número de campos, usernames/UIDs duplicados, directorio home existente y shell listado en /etc/shells.

  1. #!/usr/bin/perl -Tw
  2.  
  3. use strict;
  4.  
  5. my ($grpFileName,$shellFileName,$pwdFileName,%groups,%shells,@pwdData);
  6.  
  7. $grpFileName = '/etc/group';
  8. $shellFileName = '/etc/shells';
  9. $pwdFileName = '/etc/passwd';
  10.  
  11. # First, load all the needed groups into memory. Check, by the way, for
  12. # repeated groups and incorrect line length.
  13. %groups = &getGroups($grpFileName);
  14. %shells = &getShells($shellFileName);
  15. &checkPasswd($pwdFileName,\%groups,\%shells);
  16.  
  17. sub getGroups {
  18. my ($filename,@groups,%groupids,%groupnames);
  19. $filename = shift;
  20. open(IN,"<$filename") or die "Could not open $filename";
  21. while (my $line = &lt;IN&gt;) {
  22. # We do not chomp($line), because even an empty members field
  23. # is valid, and if we chopped it, we would get false positives.
  24. next if $line =~ /^\s*#/;
  25. my @data = split(/:/,$line);
  26. print "WARNING: Line in $filename with incorrect number of fields (should have four):\n $line\n" if ($#data != 3);
  27. print "WARNING: Duplicate GID: $data[2] refers to $data[0] and $groupids{$data[2]}\n" if (defined $groupids{$data[2]});
  28. $groupids{$data[2]} = $data[0];
  29. print "WARNING: Duplicate group name: $data[0] refers to $data[2] and $groupnames{$data[0]}\n" if (defined $groupnames{$data[0]});
  30. $groupnames{$data[0]} = $data[2];
  31. }
  32. return(%groupids);
  33. }
  34.  
  35. sub getShells {
  36. my ($filename,%shells);
  37. $filename = shift;
  38. open(IN,"<$filename") or die "Could not open $filename";
  39. while (my $line = &lt;IN&gt;) {
  40. next if ($line =~ /^\s*#/);
  41. chomp($line);
  42. print "WARNING: Shell $line does not exist\n" unless (-e $line);
  43. print "WARNING: Shell $line appears twice\n" if (defined $shells{$line} );
  44. $shells{$line} = 1;
  45. }
  46. return(%shells);
  47. }
  48.  
  49. sub checkPasswd {
  50. my (%userid,%username,$filename,%groups,%shells);
  51. $filename = $_[0];
  52. %groups = %{$_[1]};
  53. %shells = %{$_[2]};
  54. open(IN,"<$filename");
  55. while (my $line = &lt;IN&gt;) {
  56. chomp($line);
  57. next if ($line =~/^\s*#/);
  58. my @data = split(/:/,$line);
  59. print "WARNING: Line in $filename with incorrect number of fields (should have 7):\n $line\n" if ($#data != 6);
  60. print "WARNING: Duplicate UID: $data[2] refers to $data[0] and $userid{$data[2]}\n" if (defined $userid{$data[2]});
  61. $userid{$data[2]} = $data[0];
  62. print "WARNING: Dulpicate username: $data[0] refers to $data[2] and $username{$data[0]}\n"if (defined $username{$data[0]});
  63. $username{$data[0]} = $data[2];
  64.  
  65. print "WARNING: Home directory non-existant for user $data[0] ($data[5])\n" unless (-e $data[5]);
  66. print "WARNING: Shell non-existant for user $data[0] ($data[6])\n" unless (-e $data[6]);
  67. }
  68. }

4. Conexiones de red

Arpmap

Todo administrador de una red grande basada en TCP/IP se topará tarde o temprano con que algún usuario que cree saber lo que hace ha modificado su dirección IP. Esto puede llevar al caos, imposibilitándonos saber qué computadora está causando choques de direcciones o dónde está determinada dirección. Este programa nos ayuda tomando fotografías de la red en determinado momento, para que podamos compararla con fotografías futuras.

Funcionamiento general

El programa es invocado dándole la interfaz sobre la cual trabajar - recuerden que arp es un protocolo no ruteable. El programa obtiene la configuración de la red del comando definido en $ifconfigCmd. Para guardar los resultados abre el archivo indicado en $filename, y si este ya existe lee los datos ya existentes para no volver a buscar direcciones ya resueltas. Posteriormente, revisa todo el segmento (funciona únicamente con redes clase B o clase C).
Sugiero correr el programa a través de cron cada media hora por un par de días para encontrar también a las computadoras apagadas a la hora de la ejecución.

Funcionamiento: Obteniendo la configuración de la red

arpmap utiliza ampliamente la capacidad de encontrar patrones de Perl. Al llamar a ifconfig itera sobre el arreglo resultante, buscando primero que nada una línea que calce con ^[\w\d\:]+ indicando el nombre de una interfaz de red. Si no especificamos al llamar al programa, pregunta cuál de las interfaces es la que nos interesa. Después de esto, asigna la siguiente línea a $ip y a $mask, para seleccionar en ambas únicamente la porción que nos interesa, reduciéndolas a cadenas [\d\.]+

Funcionamiento: Resolviendo las direcciones

Para poder resolver una dirección IP hacia su MAC correspondiente tenemos que tenerla ya en el cache del kernel, es por ello que corremos $findCmd, que típicamente será un ping. Después de esto preguntamos por la IP utilizando $arpCmd, y buscamos en el resultado calzar con el patrón /Address.*HWtype/ (indicando una dirección encontrada) o /incomplete/ (indicando falla, usualmente por ser la dirección local). Para guardar la dirección utilizamos print a secas, dado que en la función &openFile tenemos un select(OUT), enviando toda salida estándar al archivo.

Reporte de resultados

El resultado de ejecutar este script es un archivo
con un formato como el siguiente:

  1.  
  2. 192.168.1.1 - 00:50:DA:66:DB:5C
  3. 192.168.1.3 - 08:00:20:AE:C9:0C
  4. 192.168.1.6 - 00:50:DA:1F:00:7C
  5. 192.168.1.7 - 00:50:DA:66:DB:60
  6. 192.168.1.8 - 00:50:DA:0D:12:F2
  7. 192.168.1.9 - 00:A0:24:16:92:CA
  8. 192.168.1.10 - 00:60:97:60:60:50
  9. 192.168.1.20 - 00:50:DA:60:9A:E2
  10. 192.168.1.22 - 00:01:02:60:3B:EA
  11. 192.168.1.25 - 00:A0:24:16:93:BD
  12. 192.168.1.29 - 00:50:04:01:3D:A7
  13. 192.168.1.31 - 00:60:08:48:C2:5B
  14. 192.168.1.32 - 00:A0:24:C3:F9:49
  15. 192.168.1.33 - 08:00:20:76:8D:98
  16. 192.168.1.38 - 00:60:08:C7:5B:FB
  17. 192.168.1.41 - 00:60:08:C7:5C:00
  18. 192.168.1.44 - 00:A0:24:16:93:65
  19. 192.168.1.45 - 00:60:08:C6:77:3F
  20. 192.168.1.47 - 00:A0:24:1B:51:79
  21. 192.168.1.49 - 00:A0:24:15:97:D5
  22. (...)

donde nos indica cada dirección IP localizada y su dirección
MAC correspondiente.
  1. #!/usr/bin/perl -w
  2. #
  3. # Maps the IP addresses on your local Ethernet to their ARP equivalents
  4. #
  5. # REQUIRES: Being run by any user authorized to run ping, arp and ifconfig
  6. use strict;
  7. use vars qw($ifconfigCmd $findCmd $arpCmd $interactive %done);
  8. my ($ip,$mask,$class,$filename);
  9. # ---------configuration area--------
  10. # Path to the ifconfig binary
  11. $ifconfigCmd = '/sbin/ifconfig';
  12. # Command to run to find a host
  13. # (a simple ping will do, just take care not to
  14. # execute an eternal ping)
  15. #
  16. # Put %ip% where the IP should be given.
  17. $findCmd = '/bin/ping -c 1 %ip%';
  18. # Path to the arp binary
  19. $arpCmd = '/sbin/arp';
  20. # filename for output. If the file already exists, it
  21. # will be checked, in order not to repeat the whole
  22. # process.
  23. # If left empty, output will go to STDOUT.
  24. if ($ARGV[1]) {
  25. $filename=$ARGV[1];
  26. } else {
  27. $filename = 'arpmap.txt';
  28. }
  29. # -----end of configuration area-----
  30. #
  31. # Run in interactive mode if called with no arguments
  32. $interactive = ($#ARGV==-1);
  33. ($ip,$mask) = &findIp();
  34. $class=&checkMask($mask);
  35. &openFile($filename) if (defined $filename && $filename ne '');
  36. $|=1;
  37. &getArp($ip,$class);
  38. close(OUT) if (defined $filename && $filename ne '');
  39. exit 0;
  40. sub openFile {
  41. my ($filename);
  42. $filename=$_[0];
  43. &readFile($filename) if (-f $filename);
  44. open (OUT,">>$filename") or die "Could not open $filename for output";
  45. select(OUT);
  46. }
  47. sub readFile {
  48. my ($filename,@in,$line,$ip,$mac);
  49. $filename=$_[0];
  50. open (IN,$filename) or die "Could not open $filename for input";
  51. @in=<IN>;
  52. close (IN);
  53. while ($line=shift(@in)) {
  54. ($ip,$mac) = split(' - ',$line);
  55. $done{$ip}=$mac;
  56. }
  57. }
  58. sub findIp {
  59. my ($line,@ifconfig,%interfaces,$int,$ip,$mask);
  60. @ifconfig=`$ifconfigCmd`;
  61. while ($line = shift(@ifconfig)) {
  62. chomp $line;
  63. if ($line =~ s/^([\w\d\:]+).*/$1/ && $line ne 'lo') {
  64. $interfaces{$line} = shift(@ifconfig);
  65. chomp($interfaces{$line});
  66. }
  67. }
  68. if ($interactive) {
  69. $int='';
  70. while (not defined $interfaces{$int}) {
  71. print "\nThe following interfaces were found on your system:\n";
  72. print join ("\n ",keys(%interfaces));
  73. print "\nWhich interface do you want to map? ";
  74. $int = <STDIN>;
  75. chomp ($int);
  76. }
  77. } else {
  78. if (defined $interfaces{$ARGV[0]}) {
  79. $int = $ARGV[0];
  80. } else {
  81. print "\nInterface $ARGV[0] not found\n\n";
  82. exit 0
  83. }
  84. }
  85. $ip = $mask = $interfaces{$int};
  86. $ip =~ s/^.*inet addr:([\d\.]+).*/$1/;
  87. $mask =~ s/^.*Mask:([\d\.]+).*/$1/;
  88. return ($ip,$mask);
  89. }
  90. sub checkMask {
  91. my ($mask,@mask,$class);
  92. $mask=$_[0];
  93. @mask = split(/./,$mask);
  94. if ($mask eq '255.255.255.0') {
  95. $class=24;
  96. } elsif ($mask eq '255.255.0.0') {
  97. $class=16;
  98. } elsif ($mask eq '255.0.0.0' || $mask eq '0.0.0.0') {
  99. print "Your network is too large - Stay out of troubles, don't try to map it.\n";
  100. exit 0;
  101. } elsif ($mask eq '255.255.255.255') {
  102. print "This is a point-to-point network or something weird.\n";
  103. print "I'd better cowardly stay away from it...";
  104. exit 0;
  105. } else {
  106. print "Sorry, arpmap does not handle subclasses yet.\n";
  107. exit 0;
  108. }
  109. return $class;
  110. }
  111. sub getArp {
  112. my ($myip,$class,$ip,$oct3,$oct4);
  113. $myip = $_[0];
  114. $class = $_[1];
  115. $ip = $myip;
  116. # $class must be either 16 or 24
  117. if ($class == 24) {
  118. $ip =~ s/^(\d+\.\d+\.\d+\.).*/$1/;
  119. for ($oct4=1;$oct4<255;$oct4++) {
  120. &getIp($ip.$oct4);
  121. }
  122. } elsif ($class == 16) {
  123. $ip =~ s/^(\d+\.\d+\.).*/$1/;
  124. for ($oct3=1;$oct3<255;$oct3++) {
  125. for ($oct4=0;$oct4<=255;$oct4++) {
  126. &getIp($ip.$oct3.$oct4);
  127. }
  128. }
  129. } else {
  130. die "I was waiting for a 16 or a 24 and got a $class!";
  131. }
  132. }
  133. sub getIp {
  134. my ($ip,$command,@arp,@arp2,$arp,$line);
  135. $ip=$_[0];
  136. return if (defined $done{$ip});
  137. $command = $findCmd;
  138. $command =~ s/\%ip\%/$ip/;
  139. system("$command > /dev/null");
  140. @arp=`$arpCmd $ip`;
  141. foreach $line (@arp) {
  142. chomp $line;
  143. # Go to next line if this one is the header
  144. next if ($line =~ /Address.*HWtype/ || $line =~ /incomplete/);
  145. @arp2=split(/\s+/,$line);
  146. $arp = $arp2[2];
  147. print "$ip - $arp\n" if ($arp !~ /--/);
  148. }
  149. }

spam

Todos nosotros odiamos el spam. ¿Cómo consiguen nuestras direcciones los spammers? Buscándolas por Web. Cualquiera de nuestros correos aparece casi seguramente en al menos una página.
Ahora... Si tan solo pudiéramos alimentar con basura a los recolectores de direcciones para que su trabajo fuera inútil... ¡Pero podemos! Podemos darles cantidades ilimitadas de direcciones falsas... Eso es lo que hace este script.
Gracias a Jason Costomiris por el escribirlo y publicarlo en http://www.jasons.org, de donde lo bajé.

Consideraciones de seguridad

Este CGI es bastante sencillo y está programado con cuidado. Sin embargo, hay algunos puntos a considerar:

  • La página tiene una liga que conduce de vuelta a sí misma, lo cual -con un robot recolector suficientemente rápido- puede llevar a una negación de servicio. No olviden que levantar un CGI cuesta bastante tiempo.
  • El levantar un CGI nos obliga doblemente a estar al día en problemas que pueda presentar nuestro servidor Web y el mismo Perl, dado que abrimos al mundo entero una ventana que permite ejecutar código -aunque sea nuestro- en el servidor. Si aparece algún método para explotar al servidor a través de CGIs, o algún problema con Perl, seremos vulnerables.

Funcionamiento general

Es un script muy sencillo. Después de crear dos arreglos, uno con las 26 letras del alfabeto y uno con varios top-level domains. Genera hasta 500 direcciones consistentes de hasta ocho letras para login y hasta 10 letras mas el TLD para el dominio, presentándolas en un CGI como ligas (<a href="mailto:..."&gt). Por último, genera una liga hacia el mismo script, para que un robot recolector de direcciones sin mucha inteligencia caiga en un ciclo infinito de recolección de direcciones.

  1. #!/usr/bin/perl -T
  2. # Copyleft 1997 Jason Costomiris (whois:JC1011).
  3. # Rights? You had rights? When I was a kid......
  4. require 5.003;
  5. use strict;
  6. use CGI;
  7. my ($i, $j, $k);
  8. my @abc = ('a'..'z');
  9. my @tld = ('com', 'net', 'org', 'mil', 'gov', 'hey-dork', 'spam-sucks');
  10. my $fodder = new CGI;
  11. print $fodder->header;
  12. print $fodder->start_html(-title=>'Spam fodder',
  13. -BGCOLOR=>'#FFFFFF');
  14. print "&lt;a href=\"mailto:abuse\?subject=I am a spamming luser\"&gt;abuse&lt;/a&gt;&lt;br/&gt;\n";
  15. srand;
  16. my $number = int(rand(500));
  17. for ($i = 0 ; $i <= $number ; $i++) {
  18. my $name = "";
  19. my $domain = "";
  20. my $num_name = int(rand(8));
  21. for ($j = 0 ; $j <= $num_name ; $j++) {
  22. $name .= $abc[int(rand($#abc))];
  23. }
  24. my $num_domain = int(rand(10));
  25. for ($k = 0 ; $k <= $num_domain ; $k++){
  26. $domain .= $abc[int(rand($#abc))];
  27. }
  28. my $tld = $tld[int(rand($#tld))];
  29. my $address = $name . '@' . $domain . '.' . $tld;
  30. print "&lt;a href=\"mailto:$address\?subject=I am a spamming luser\"&gt;$address&lt;/a&gt;&lt;br/&gt;\n";
  31. }
  32. #
  33. # Now that we've given lots of bad addresses to them, let's put them in an
  34. # endless loop
  35. #
  36. print "\n&lt;pgt;\n&lt;a href=\"$ENV{SCRIPT_NAME}\"&gt;endless loop of these pages for spam-spiders. Yay.&lt;/a&gt;\n";
  37. print $fodder->end_html;

honeypot

Tras un ataque a nuestro sitio es muy importante analizar qué hizo el atacante - No sólo los pasos que siguió para penetrar en nuestro sistema, sino que también qué hizo una vez dentro. Muchas veces quisiéramos poder analizar qué intentos de intrusión ha habido, o frustrarlos dando al posible atacante información falsa. Para esto podemos crear sistemas trampa, que aparenten dar cierto servicio pero en realidad no lo estén dando, y sólo estén registrando todo lo que reciban. Perl es ideal para esto, dada su facilidad para la programación en red.

Consideraciones de seguridad

  • Estamos ante un atacante. Si bien nuestro programa no debe tener ninguna característica que pueda comprometer al sistema, es importante que no lo corramos como root sino que como un usuario sin ningún privilegio, posiblemente desde inetd.conf
  • El uso de estos sistemas es un tanto controversial - Por un lado, porque al dar información falsa estamos practicando seguridad por obscuridad, lo cual nunca sirve de mucho, y por otro lado, porque si un atacante se da cuenta de que está atacando a un sistema trampa, puede reaccionar empeñándose más en lograr penetrar el sistema.

Funcionamiento general

Hay varios servicios que son muy sencillos de emular, y que pueden no ser necesarios para nuestro sistema. Los ejemplos más clásicos son finger, SMTP, POP3 y HTTP. Claro, el juzgarlos innecesarios depende de cada sitio. Nuestro programa emulará respuestas válidas de estos servicios, registrando en syslog cualquier uso que el atacante intente hacer de ellos.
Como todos estos servicios pueden ser iniciados desde inetd.conf, no nos preocuparemos de los sockets, manejando toda entrada y salida por las vías estándar.

Funcionamiento: Interacción con la red

La interacción será manejada por el demonio inet, lo cual nos simplifica mucho la tarea: Toda entrada y salida la manejamos con STDIN y STDOUT.
STDIN puede ser manejado como un socket, y lo hacemos en la función connData, donde obtenemos la dirección y puerto de la cual procede la comunicación.

Funcionamiento: Registro

Con un sistema trampa querremos registrar todo lo que el posible atacante intente hacer. Para hacerlo, utilizamos el Syslog, utilizando el módulo Sys::Syslog que viene incluído con la distribución estándar de Perl. Inicializamos el servicio con las siguientes líneas:

  1. use Sys::Syslog qw(:DEFAULT setlogsock);
  2. setlogsock('unix');
  3. openlog('honeypot','cons,pid','honeypot');

y registramos cada línea recibida a través de la función logger que simplemente hace:
syslog('info',join(' ',@_));

Funcionamiento: Lo implementado

En este script están implementados emuladores de tres populares protocolos: Finger, SMTP y POP3. Finger es un protocolo suficientemente sencillo como para poder sido emulado por completo con sólo un par de líneas. Cuando recibe una solicitud sobre cualquier usuario -válido o no- responde algo que aparenta éxito, al reportar conexiones marca que no hay nadie conectado, y al solicitar una redirección la niega.
POP3 responde en un formato similar al del servidor imapd incluído en muchas distribuciones de Linux; reporta siempre éxito al recibir nombre de usuario y error al recibir la contraseña.
SMTP aparenta ser un sendmail. La implementación es muy sencilla, tal vez demasiado simple (no olviden que estos scripts son sólo ejemplos, no deben ser utilizados sin ser estudiados y modificados por el administrador): Responde exitosamente a cualquier HELO/EHLO, y marca error a cualquier MAIL FROM. Es importante responder siempre así, pues de no hacerlo un usuario podría legítimamente enviarnos un correo y nunca llegaría a su destino.

  1. #!/usr/bin/perl -T
  2. #
  3. # This script should be run from /etc/inetd.conf as follows:
  4. #
  5. # (port) stream tcp nowait (user) (path-to-script) (script) (argument)
  6. #
  7. # for example:
  8. # finger stream tcp nowait nobody /usr/local/sbin/honeypot.pl honeypot.pl finger
  9. # pop3 stream tcp nowait nobody /usr/local/sbin/honeypot.pl honeypot.pl pop3
  10. #
  11. # IMPORTANT NOTE
  12. # Having a honeypot system does *NOT* make it any safer. In fact, it makes
  13. # it a GREAT target for attacks. An attacker might get angry at you laughing
  14. # at him and attack with greater strength. Even if you enhance its behavior,
  15. # it is not hard to notice you are not talking to a real server. Use this
  16. # ONLY at machines DEDICATED to network monitoring and information
  17. # gathering. Most important, USE AT YOUR VERY OWN RISK.
  18. use strict;
  19. use Sys::Syslog qw(:DEFAULT setlogsock);
  20. use IO::Socket;
  21. use vars qw($hostname);
  22. # Set to the hostname you want to tell the clients
  23. $hostname = 'asdf.qwerty.org';
  24. $|=1;
  25. setlogsock('unix');
  26. openlog('honeypot','cons,pid','honeypot');
  27. &connData;
  28. if ($ARGV[0] eq 'finger') {
  29. &finger;
  30. } elsif ($ARGV[0] eq 'pop3') {
  31. &pop3;
  32. } elsif ($ARGV[0] eq 'smtp') {
  33. &smtp;
  34. } else {
  35. &logger("ERROR - $ARGV[0] not defined\n");
  36. }
  37. exit 0;
  38. sub pop3 {
  39. # emulates a POP3 connection, accepting every username and
  40. # denying every password. It honors the 'quit' command, in
  41. # case a legitimate client tries to connect and refuses to
  42. # leave unpolitely. Everything else is denied.
  43. my ($request);
  44. print "+OK POP3 $hostname v4.76 server ready\n";
  45. while ($request=<STDIN>) {
  46. &logger("RECEIVED: '$request'");
  47. $request =~ s/[\r\n]//g;
  48. if ($request=~/^user\b.+\w+/i) {
  49. print "+OK User name accepted, password please\n";
  50. } elsif ($request=~/^pass\b.+\w+/i) {
  51. print "-ERR Bad login\n";
  52. } elsif ($request=~/^quit\b/i) {
  53. print "+OK Sayonara\n";
  54. exit 0;
  55. } else {
  56. print "-ERR Unknown AUTHORIZATION state command\n";
  57. }
  58. }
  59. }
  60. sub smtp {
  61. # emulates a SMTP connection, denying access to all senders.
  62. # HELO/EHLO is honored. It honors the 'quit' command, in
  63. # case a legitimate client tries to connect and refuses to
  64. # leave unpolitely. Everything else is denied.
  65. my ($request);
  66. print "220 $hostname ESMTP MailServer 6.4.5\n";
  67. while ($request = <STDIN>) {
  68. &logger("RECEIVED: '$request'");
  69. $request =~ s/[\r\n]//g;
  70. if ($request =~ /^mail\s+from:\s?(.+)/i) {
  71. print "550 $1...Access denied\n";
  72. } elsif ($request =~ /^helo\s+(.+)/i || $request =~ /^ehlo\s+(.+)/i) {
  73. print "250 $hostname Hello $1, pleased to meet you\n";
  74. } elsif ($request =~ /^quit/i) {
  75. print "221 $hostname closing connection\n";
  76. exit 0;
  77. } else {
  78. print "Command unrecognized: $request\n";
  79. }
  80. }
  81. }
  82. sub finger {
  83. # emulates a finger connection. If a user request is recieved
  84. # (no '@' characters), it is served with a dummy template, making
  85. # each and every user searched appear as valid. If an empty request
  86. # is recieved, it shows no users logged in. If a redirect request is
  87. # recieved, it is denied right away.
  88. my ($request);
  89. $request = <STDIN>;
  90. &logger("RECEIVED: '$request'");
  91. $request =~ s/[\r\n]//g;
  92. if ($request =~ /\@/) {
  93. # Forwarding
  94. print "fingerd: forwarding not allowed\n";
  95. } elsif ($request =~ /^$/) {
  96. # Who is online
  97. print "Login Name Tty Idle Login Time Office Office Phone\n";
  98. } elsif ($request =~ /^\w+$/) {
  99. # user's login information
  100. print "Login: $request".' 'x(33-length($request)).
  101. "Name:$request\nDirectory: /home/$request".
  102. ' 'x(23-length($request))."Shell: /bin/bash\nNever logged in.
  103. \nNo mail.\nNo Plan.\n";
  104. }
  105. }
  106. sub connData {
  107. # Gets and logs connection data
  108. my ($src_conn,$src_port,$src_iaddr,$src_ip_address);
  109. $src_conn=getpeername(STDIN);
  110. ($src_port,$src_iaddr)=unpack_sockaddr_in($src_conn);
  111. $src_ip_address=inet_ntoa($src_iaddr);
  112. &logger("Connection recieved from $src_ip_address, source port $src_port for $ARGV[0]");
  113. }
  114. sub logger {
  115. syslog('info',join(' ',@_));
  116. }

ProtoWrap

Concepto general:

Para evitar ataques a diferentes servicios, ProtoWrap envuelve la comunicación, permitiendo que pase únicamente lo que sea validado como correcto.
Consultar http://www.gwolf.org/seguridad/wrap

5. Conclusión

Bibliografía

Varios de los ejemplos aquí presentados fueron tomados del libro Perl for System Administration, de David N. Blank-Edelman, publicado por O’Reilly en junio del 2000 (ISBN 1-56592-609-9).
Otras importantes fuentes de recursos para scripts aplicables a la seguridad son:

  • The Perl Journal, revista cuatrimestral dedicada exclusivamente a Perl.
  • SysAdmin, revista mensual dedicada a la administración de sistemas.
  • Programming Perl 3rd edition, Larry Wall, Tom Christiansen y Jon Orwant (O’Reilly 2000)
  • Perl Cookbook, Tom Christiansen y Nathan Torkington (O’Reilly 1998)
  • Advanced Perl Programming, Sriram Srinivasan (O’Reilly 1997)
  • http://www.ora.com/ - O’Reilly Associates, editores de una gran cantidad de libros de Perl y de administración de sistemas de muy buena calidad.
  • http://www.cpan.org/ - Comprehensive Perl Archive Network, miles de módulos, scripts, ports y documentación de Perl.
  • http://www.perl.com/ y http://www.perl.com - Los sitios oficiales de Perl
  • http://use.perl.org/ - Noticias de Perl
  • http://www.metronet.com/1/perlinfo/scripts/ - Colección de juguetes, trucos y trampas en Perl