Sintaxis de sockets en perl

Función Socket

Crea un socket y lo asocia a un descriptor (similar a uno de archivo)

Sintaxis

socket(descriptor, dominio, tipo, formato)

Descriptor: Nombre asignado al socket

Dominio: Código de familia de protocolos a utilizar. Los valores permitidos se
encuentran en el archivo de cabecera del sistema (/usr/include/sys/socket.h),
representados por las constantes PF_UNIX, PF_INET, PF_IMPLINK, PH_NS.
Tipo: Determina el tipo de socket a crear. Los valores permitidos se encuentran en el
archivo de cabecera del sistema (/usr/include/sys/socket.h), representados por las
constantes SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET, SOCK_RDM.
Formato: Es un número que indica el protocolo de transporte a asociarse al socket (por
ejemplo, el número correpondiente a TCP es 6). La función getprotobyname() se puede
utilizar para obtener tal número a partir del mnemónico asociado.

La invocación a la función Socket retorna un valor distinto de cero si la ejecución fue exitosa, ó cero
en caso de que haya ocurrido un error.

Ejemplo

$pf_inet = PF_INET();
$sock_stream = SOCK_STREAM();
$numero_protocolo = getprotobyname("TCP");
$estado=socket(SOCKET, $PF_INET, $SOCK_STREAM, $numero_protocolo);
if ($estado != 0) { print ("Error en creación de socket!") }
else { print ("Socket creado!") }

Función Bind

Asocia un socket con una dirección de red determinada.

Sintaxis

bind (descriptor, dirección)

Descriptor: Nombre asignado al socket

Dirección: Es la dirección de red que se pretende asociar al socket. Esta dirección
está compuesta por un conjunto de valores:
a) tipo de dirección, entero corto sin signo y siempre es AF_INET (definido en el
archivo /usr/include/netdb.h)
b) número de puerto local a utilizar en la conexión, es un entero corto.
c) dirección internet (IP) de la interface a la cual se pretende ligar el socket.

A los efectos de armar el argumento dirección en la función Bind, se requiere la conversión a un

formato empaquetado de los valores enunciados anteriormente. Esto se realiza utilizando la función
Pack, con el formato Sna4x8.

Ejemplo
 $numero_puerto = 7593;
$direccion = pack("Sna4x8", 2, $numero_puerto, $direccion_ip);
bind (SOCKET, $direccion);

La invocación a la función Bind retorna un valor distinto de cero si la ejecución fue exitosa, ó cero en
caso de que haya ocurrido un error.

La dirección de red de un host puede ser obtenida por medio de la función gethostbyname(), que
utiliza como argumento el nombre mnemónico del host en cuenstión.

Ejemplo

$numero_puerto = 7593;
($d1,$d2,$d3,$d4,$dirección_ip)= gethostbyname("www.unlu.edu.ar");
$direccion = pack("Sna4x8", 2, $numero_puerto, $direccion_ip);
bind (SOCKET, $direccion);

La función auxiliar getservbyport() permite determinar si un número de puerto se encuentra

disponible para ser utilizado en un nuevo socket. Los argumentos que recibe son: número de puerto
a verificar y nombre del protocolo de transporte asociado. La función retorna un valor de verdad
asociado al estado del puerto.

Ejemplo

$numero_puerto = 7593;
while (getservbyport($numero_puerto, "tcp")
{
$numero_puerto++
}

($d1,$d2,$d3,$d4,$dirección_ip) = gethostbyname("www.unlu.edu.ar");
$direccion = pack("Sna4x8", 2, $numero_puerto, $direccion_ip);
bind (SOCKET, $direccion);

Función connect

Si se trabaja sobre un transporte orientado a la conexión (socket de tipo SOCK_STREAM), esta

función intenta establecer una conexión a otro socket. Si el tipo de socket es SOCK_DGRAM
(transporte no orientado a la conexión), especifica la dirección a la cual se enviarán los datagramas,
y la dirección desde la que serán recibidos.

Sintaxis

connect (descriptor, dirección)

Descriptor: Nombre asignado al socket

Dirección: Es la dirección de red que del socket al cual se pretende conectar. El
formato es el mismo que el utilizado en la funcion bind.

Ejemplo

listen (SOCKET, 5)
La invocación a la función connect retorna un valor distinto de cero si la ejecución fue exitosa, ó cero
en caso de que haya ocurrido un error.

Función listen

A partir de un socket creado, esta función lo pasa a estado de apertura pasiva (ó modo escucha). Si
se trabaja sobre un transporte orientado a la conexión, se espera por conexiones entrantes. En caso
sobre transporte no orientado a la conexión, se espera por datagramas entrantes.

Sintaxis

listen (descriptor, largo_cola)

Descriptor: Nombre asignado al socket

Largo_cola: Cantidad máxima de conexiones entrantes que se pueden encolar.

Ejemplo

listen (SOCKET, 5)

La invocación a la función Listen retorna un valor distinto de cero si la ejecución fue exitosa, ó cero
en caso de que haya ocurrido un error.

Función accept

Esta función espera hasta que un proceso solicite conexión y -una vez conectado- retorna la
dirección de este.

Sintaxis

accept (nuevo_descriptor, descriptor)

Nuevo_descriptor: Nombre asignado al socket del proceso que se ha conectado

Descriptor: Nombre asignado al socket

Ejemplo

$direccion_cliente = accept(NUEVO_SOCKET, SOCKET)

El módulo Socket

Ejemplo 1: Cliente web básico

#################################################
#!/usr/bin/perl

use Socket;
$server = "www.unlu.edu.ar";
$port = 80;

# Establecimiento de conexión
$server_addr =(gethostbyname($server));
$server_struct = pack("S n a4 x8", AF_INET, $port, $server_addr);
$proto = (getprotobyname('tcp'));

socket(MISOCK, PF_INET, SOCK_STREAM, $proto)|| die "Error en creacion $!\n";

connect(MISOCK, $server_struct) || die "Error en conexion: $!\n";

#Conexión establecida, transmisión de datos

select(MISOCK);
$| = 1;
select(STDOUT);
print MISOCK "GET /\n\n";
while (<MISOCK>) { print; }

# cierre de conexión
close(MISOCK);
#################################################

El módulo utilizado “Socket” contiene la definición de una serie de constantes utilizadas en el código
anterior. En las variables $server y $port se hallan la dirección de red -en formato nemónico- y el
puerto del servicio al que se quiere acceder.

Una estructura de datos (en formato C) es creada con la función pack, la cual contiene la constante
AF_INET (extraida del módulo Socket) que indica el tipo de dirección de red a utilizar (en este caso
protocolo internet), $port y $server_addr que son datos propios del equipo a conectar.

Antes de crear un socket es necesario obtener el parámetro código de protocolo de transporte a

utilizar (la variable $proto lo contiene). En el ejemplo se utiliza TCP, la función getprotobyname() a
partir de un nemónico devuelve su correspondiente código de protocolo de transporte.

La función socket() permite crear sockets, donde en nuestro caso, MISOCK es un descriptor, PF_INET
la constante que indica que se utilizará protocolo de red de internet, SOCK_STREAM que el transporte
será orientado a la conexión y $proto contiene el código de protocolo de transporte a utilizar (en el
ejemplo TCP).

Una vez que el socket ha sido creado se procederá a realizar una conexión con el servicio remoto (en
nuestro caso con www.unlu.edu.ar puerto 80), para lo cual se utiliza la función connect() que lleva
por parámetros: el descriptor del socket local (MISOCK), y la estructura creada que contiene datos
del hosts que brindará servicio (en nuestro caso $server_struct).

Una vez establecida la conexión se dispone de una canal bidireccional confiable para el intercambio
de datos entre el equipo local y el equipo remoto que brinda servicio. Utilizando el descriptor de
socket (MISOCK) se pueden realizar operaciones de lectura (recepción de datos) y escritura (envio de
datos). Las dos primeras líneas se utilizan a los efectos de deshabilitar operaciones de buffer, dado
que se trabajará con mensajes cortos no es necesario contar con buffers. La función select()
selecciona por defecto un canal de salida (siempre se inicia con STDOUT por defecto) y asignando un
valor distinto de cero a la variable $| se desactivan las operaciones de buffer sobre tal canal. A
continuación se volvio a seleccionar el canal de salida por defecto y se envió al socket el mensaje
HTTP “GET /” (recuperar la página web establecida por defecto). Mientras la conexión siga
establecida se leeran datos enviados por el servidor web (recordar que un servidor web luego de
enviar un archivo cierra su conexión). Un cierre de conexión realizado por el servidor es interpretado
como el evento fin de archivo por parte del cliente.

Ejemplo 2: un proceso servidor

#################################################
#!/usr/bin/perl

use Socket;
$este_host = 'localhost';
$port = 4000;

# Creación del socket

$server_addr = (gethostbyname($este_host));
$server_struct = pack("S n a4 x8", AF_INET, $port, $server_addr);
$proto = (getprotobyname('tcp'));
socket(SSOCK, PF_INET, SOCK_STREAM, $proto)|| die "Error en creación: $!\n";

# Establecimiento del estado de apertura pasiva

setsockopt(SSOCK, SOL_SOCKET, SO_REUSEADDR,1) ||
die "Error operación setsockopt(): $!\n";
bind(SSOCK, $server_struct) || die "Error en operación bind(): $!\n";
listen(SSOCK, SOMAXCONN) || die "Error en operación listen(): $!\n";

# Atendiendo clientes
for (;;) {
$host_remoto = accept(NUEVOSOCK, SSOCK);
die "Error en operación accept(): $!\n" unless ($remote_host);
#
# Aquí se situa el código específico del protocolo de aplicación
#
close(NUEVOSOCK);
}
#################################################

Este programa define un proceso servidor bajo protocolo TCP que atenderá por conexiones entrantes
en el puerto 4000. Los comentarios del ejemplo anterior se puede observar que rigen para el
presente código. Se arma una estructura que contiene la dirección local y luego se crea un socket
con descriptor SSOCK.

La función setsockopt() permite modificar parámetros asociados a un socket, definiendo

SO_REUSEADDR se permite la reutilización del puerto luego de finalizada la ejecución del programa.
Bind asocia el socket definido (SSOCK) con la dirección de red y puerto sobre el que se brindará
servicio. La función listen() activa el estado de apertura pasiva a los efectos de atender peticiones de
conexión, el parámetro SOMAXCONN establece la cantidad máxima de pedidos de conexión (5 por de
defecto) que se pueden encolar. Cualquier nuevo pedido que no pueda encolarse será rechazado.

Accept() espera por una conexión entrante, en caso de no existir en la cola, espera hasta que se
detecte una. Cuando accept detecte una conexión se crea un nuevo socket que la identifica, en el
ejemplo se utiliza el descriptor NUEVOSOCK para su referencia, toda la escritura y lectura se realiza a
través de NUEVOSOCK. Accept retorna una estructura que contiene la dirección del equipo remoto,
la estructura instanciada es igual a la definida en la variable $server_struct, para desempaquetarla
se utiliza la función unpack() de la siguiente forma:

$raw_addr = (unpack("S n a4 x8",$remote_host));

@octetos = unpack("C4", $raw_addr);
$dirección = join(".", @octetos);
$nombre_host = (gethostbyaddr($raw_addr,AF_INET));

Ejemplo 3: Un servidor de web mínimo

#################################################
#!/usr/bin/perl

use Socket;
$docroot = '/home/florge';
$this_host = 'localhost';
$port = 4000;

# Definición del socket

$server_addr =(gethostbyname($this_host))[4];
$server_struct = pack("S n a4 x8", AF_INET,$port, $server_addr);
$proto = (getprotobyname('tcp'))[2];
socket(SOCK, PF_INET, SOCK_STREAM,$proto)|| die "Error creación socket:$!\n";

# Ligar socket y setear estado de apertura pasiva

setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR,1) || die "Error setsockopt: $!\n";
bind(SOCK, $server_struct) || die "Error bind: $!\n";
listen(SOCK, SOMAXCONN) || die "Error listen: $!\n";

# Atender Conexiones entrantes

for (;;) {

# Tomar conexión de la cola

$remote_host = accept(NEWSOCK, SOCK);
die "Error accept: $!\n" unless ($remote_host);

# Leer requerimiento del cliente

while (<NEWSOCK>) {
last if (/^\s*$/);
next unless (/^GET /);
$path = (split(/\s+/))[1];
}

# Se muestra el requerimiento y la dirección del equipo remoto

$raw_addr = (unpack("S n a4 x8", $remote_host))[2];
$dot_addr = join(".", unpack("C4", $raw_addr));
$name = (gethostbyaddr($raw_addr, AF_INET))[0];
print "$dot_addr\t$name\t$path\n";

# Devolver página o mensaje de error

if (open(FILE, "< $docroot$path")) {
@lines = <FILE>;
print NEWSOCK @lines;
close(FILE);
} else {
print NEWSOCK <<FIN;
<TITLE>Error</TITLE><H2>Error</H2>
Ha ocurrido el siguiente error:
$!
FIN

# Cierre de conexión
close(NEWSOCK);
}
#################################################

Un requerimiento HTTP se implementa en líneas -que definen el comando- en formato ASCII,

finalizando con una línea en blanco. El servidor analiza el requerimiento (en el ejemplo solo se
acepta el comando GET) y se devuelve el archivo solicitado o un mensaje de error.
Conexiones y Procesos concurrentes

Una manera de dotar a un proceso servidor de la capacidad de atender múltiples conexiones de

forma concurrente es a través de la función fork(), la cual se utiliza para crear nuevos procesos. Fork
crea una copia exacta del proceso en el que se ejecutó y ambos procesos ( padre e hijo) continuan
su ejecución a partir del punto en que la función fork se realizó. La diferencia entre el proceso hijo y
el proceso padre radica en el hecho de que el valor retornado por la función fork será siempre cero
para el nuevo proceso (proceso hijo) y el valor de proceso original para el caso del proceso padre.

Fork es utilizado para que cuando se detecte una conexión entrante (por medio de accept) se invoke
a fork para generar un proceso hijo que la atienda y paralelamente seguir esperando por nuevas
conexiones.

En el ejemplo siguiente si luego de ejecutar al función fork se obtiene un cero (se está en presencia
del proceso hijo) se sale de la estructura for {(last unless(fork())} y en caso de ser el padre se cierra
el socket y se continua atendiendo nuevas conexiones entrantes.

for ( ;; )
{
$remote_host = accept(NEWSOCK, SOCK);
die "accept() error: $!\n" unless ($remote_host);
# Si fork devuelve <> 0 soy el padre e ire a atender nuevas conexiones,
# de lo contrario (fork devolvio 0) soy el hijo y saldré del for
last unless (fork());
close(NEWSOCK);
}
# He descubierto (sin ayuda de terapia) que soy el hijo
# de aquí en más continua el código a ejecutar como hijo

Existe una notificación al padre por parte del proceso hijo, informándole que ha finalizado su
ejecución. Se realiza mediante el uso de la interfaz de señales. SIGCHLD es la señal que recibe el
padre informando tal evento y ademas debe dar acuse de recibo (si el hijo no lo recibe queda en un
estado denominado zombie). La forma para que un programa responda a tal señal es a través de la
siguiente instrucción $SIG{"CHLD"} = "IGNORE"; la cual se instancia en la apertura de todo
programa que utilize la función fork.

Agregando seguridad

Es necesario restringir el acceso solamente al directorio ($docroot) donde se almacenan las páginas
webs. Para ello se puede utilizar la función chroot() la cual convierte a un directorio pasado como
argumento en la raiz del sistema de archivos de un proceso determinado.

Servidor de web modificado. Concurrencia y seguridad

#################################################
#!/usr/bin/perl

use Socket;
$SIG{"CHLD"} = "IGNORE";
$docroot = '/home/florge/html';
$this_host = 'localhost';
$port = 4000;
$user = "nobody";

# Get userid for $user. Abort if userid is zero (superuser) or

# non-existent.
#
unless ($uid = (getpwnam($user))[2]) {
die "Attempt to run server as non-existent or superuser\n"; }
# Initialize C structure
#
$server_addr = (gethostbyname($this_host))[4];
$server_struct = pack("S n a4 x8", AF_INET, $port,
$server_addr);

# Set up socket
#
$proto = (getprotobyname("tcp"))[2];
socket(SOCK, PF_INET, SOCK_STREAM, $proto) ||
die "Failed to initialize socket: $!\n";

# Bind to address/port and set up pending queue

#
setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, 1) ||
die "setsockopt() failed: $!\n";
bind(SOCK, $server_struct) || die "bind() failed: $!\n";
listen(SOCK, SOMAXCONN) || die "listen() failed: $!\n";

# Deal with requests

#
for ( ;; ) {
# Grab next pending request
#
$remote_host = accept(NEWSOCK, SOCK);
die "accept() error: $!\n" unless ($remote_host);

# We're the parent if fork() returns non-zero

#
last unless (fork());
close(NEWSOCK);
}

# *** If we've fallen out of the loop, then we're the child. ***

# Close master socket

#
close(SOCK);

# Resolve hostname of remote machine before calling chroot()

#
$raw_addr = (unpack("S n a4 x8", $remote_host))[2];
$dot_addr = join(".", unpack("C4", $raw_addr));
$name = (gethostbyaddr($raw_addr, AF_INET))[0];

# chroot() to docroot and then change our effective userid

#
chroot($docroot) || die "chroot() failed: $!\n";
$> = $uid;

# Read client request and get $path

#
while (<NEWSOCK>) {
last if (/^\s*$/);
next unless (/^GET /);
$path = (split(/\s+/))[1];
}

# Print a line of logging info to STDOUT

#
print "$dot_addr\t$name\t$path\n";

# Respond with info or error message

#
if (open(FILE, "< $path")) {
@lines = <FILE>;
print NEWSOCK @lines;
close(FILE);
}
else {
print NEWSOCK <<FIN;
<TITLE>Error</TITLE><H2>Error</H2>
Ha ocurrido el siguiente error:
$!
FIN

# All done
#
close(NEWSOCK);
#################################################
El módulo IO::Socket – Condensado de [http://perlnet.sander.tsx.org].

IO::Socket es una interface que posibilita que scripts Perl puedan acceder a servicios de red
operando bajo protocolo TCP/IP. La creación de un socket se realiza invocando a una función
constructor de la clase IO::Socket::INET, donde retornará un descriptor asociado. En el siguiente
ejemplo se crea un socket:

use IO::Socket;

$socket = IO::Socket::INET->new(Proto=>"tcp",
LocalPort=>"3322",
Listen=>1)
or die "Error en apertura de socket \n";

Parámetros asociados a una creación de un socket son¨:

PeerAddr Dirección IP remota <hostname>[:<port>]

PeerPort Puerto remoto <service>[(<no>)] | <no>
LocalAddr Dirección IP local hostname[:port]
LocalPort Puerto local <service>[(<no>)] | <no>
Proto Protocolo de transporte "tcp" | "udp" | ...
Type Tipo de socket SOCK_STREAM | SOCK_DGRAM | ...
Listen Largo de la cola de escucha
Reuse Se define SO_REUSEADDR despues de binding
Timeout Se define el valor timeout para varias operaciones

El siguiente programa ejemplifica el uso de funciones de red con la finalidad de recuperar un archivo
HTML de un servidor HTTP:

#################################################
#!/usr/bin/perl

use IO::Socket;

if ($#ARGV < 1) { die "Sintaxis: recupag.pl host documento\n" }

$host = $ARGV[0]; $documento = $ARGV[1];

$socket = IO::Socket::INET->new(Proto=>"tcp",
PeerAddr=>$host,
PeerPort=>"80",
Reuse=>1)
or die "Error en conexion\n";
# buffering off
# $socket->autoflush(1);
# Solicitar recurso
print $socket "GET $documento HTTP/1.0\n\n";
# Recepcion del documento
while (<$socket>) { print }
close $socket;
#################################################

Por defecto los sockets operan en modo blocking.

El siguiente programa demuestra el envio y recepción de información implementando un servicio

tipo echo en el puerto 2244:

#################################################
#!/usr/bin/perl
use IO::Socket;
$mi_socket = IO::Socket::INET->new(Proto=>"tcp",
LocalPort=>"2244",
Listen=>1)
or die "No se puede abrir socket\n";

# Esperando por una conexión, establecer modo de apertura pasiva

$con = $mi_socket->accept;
print "Conexion desde ".$con->peerhost.":".$con->peerport."\n";
$con->autoflush(1);
while (<$con>) { print; print $con $_ }
close $con, $mi_socket;
#################################################

A continuación se presenta un programa que implementa un servidor HTTP con mínimas

funcionalidades.

#################################################
#!/usr/bin/perl

# Ejemplo provisto por http://perlnet.sander.tsx.org

use IO::Socket;
use Time::localtime;

$root = "C:/libro"; # Directorio donde se encuentran los archivos HTML

$port = 80; # Ppuerto TCP de servicio
$maxconn = SOMAXCONN; # Largo de la cola de conexiones

$server = IO::Socket::INET->new(Proto=>"tcp",
LocalPort=>$port,
Listen=>$maxconn,
Reuse=>1)
or die "Error en creacion de socket\n";

print "Servidor en puerto: $port max.conexiones: $maxconn\n";

binmode(STDOUT);

while ($client = $server->accept) {

$client->autoflush(1);
# Analisis del requerimiento
@header = split(' ', <$client>);
$url = $header[1]; $httpver = $header[2];

# Procesar si el header es valido

if ($header[0] eq "GET" && ($httpver eq "HTTP/1.0" || $httpver eq "HTTP/1.1")) {
# Si no se especifica un archivo se devuelve el documento index.html
if (rindex($url, "/") == length($url)-length("\n")) { $url.= "index.html" }
if (open(FILE, $root.$url)) {
binmode(FILE);
# envio de header HTTP
print $client "$httpver 200 OK\n\n";
# envio del archivo
while (<FILE>) { print $client $_ }
close(FILE);
# Imprimir log
print "[", $client->peerhost, "] ", ctime, " enviado \"$url\"\n";
} else {
# Si el recurso no existe muestro:
print $client "$httpver 404 archivo inexistente\n\n";
 print $client "<HEAD><TITLE>404 Archivo Inexistente”;
print $client "</TITLE></HEAD>\n";
print $client "<BODY><H1>Archivo no hallado</H1>\n";
print $client "La URL $url no se halla en este servidor.\n";
print $client "</BODY>";
# Imprimir log
print "[", $client->peerhost, "] ", ctime, " error \"$url\"\n";
}
}
close $client;

}
close $server;
#################################################

Puede resultar útil verificar periodicamente por el estado de una conexión. La función defined
permite realizar tal acción y determinar si el vínculo sigue activo o se ha roto. El ejemplo siguiente
deterrmina tal estado cada 10 segundos.

#################################################
#!/usr/bin/perl

use IO::Socket;

$socket = IO::Socket::INET->new( Proto=>"tcp",

PeerPort=>"2222",
PeerAddr=>"localhost")
|| die "Error en creacion de socket\n";

while (defined($socket)) {
print "Conexión Activa !!!\n";
sleep(5);
}

print "Conexión rota !!!\n";

close $socket;
#################################################

El módulo IO::Select

A menudo es necesario que un servidor atienda comunicaciones concurrentes. La función select

(proveniente del módulo IO::Select) permite definir un mecanismo por el cual ,el módulo principal,
detecte mensajes entrantes. El método add agreda descriptores y remove los elimina . El método
can_read retorna un arreglo que incluye a todos los descriptores que están listos para lectura y el
método can_write devuelve un arreglo de descriptores que están listos para ser grabados. Por otro
lado, el método count retorna la cantidad de descriptores asociados:

Como ejemplo se presenta un servidor de conferencia (chat) en el cual se aplican técnicas de

servicio múltiple.

#################################################
#!/usr/bin/perl

use IO::Socket;
# include the select package
use IO::Select;

$max_clients = 10;
$port = 1234;
$new_client = IO::Socket::INET->new(Proto=>"tcp", LocalPort=>$port, Listen=>$max_clients,
Reuse=>1);
# create a new selection and add our basic socket for incoming connections
$sel = IO::Select->new($new_client);

while (@ready = $sel->can_read) {

# for every readable socket
foreach $client (@ready) {
# check if it is the basic socket
if ($client == $new_client) {
# if it is establish new connection
$add = $client->accept;
# print status to new user
$count = $sel->count;
print $add "--- $count chatter(s) online ---\n";
print $add "--- enter \"quit\" to quit ---\n";
# add new socket to the selection
$sel->add($add);
# if it is a already established connectection
} else {
# get the message
$message = <$client>;
# remove last newline characters
chop($message);
chop($message);
# if user wants to quit
if ($message eq "quit") {
# remove him from selection
$sel->remove($client);
# note his ip
$ip = $client->peerhost;
# close his socket
close $client;
# send message that user has left
foreach ($sel->can_write) {
print $_ " --- user $ip left the chat. $count chatter(s) online ---\n"
}
# otherwise
} else {
# send the message to all chatters
foreach ($sel->can_write) {
# if $_ is not the writer of the message
if ($_ != $client) {
# add the ip of the writer
print $_ "[".$_->peerhost."] ".$message."\n" }
# or if it is send to the writer put just "You" infront
else { print $_ "[You] ".$message."\n" }
}
}
}
}
}
#################################################

Definición de alarmas

Es posible que bajo ciertas cirunstancias (por ejemplo: exigencia de un protocolo) sea necesario
establecer una alarma (timer). El descriptor ALRM es necesario definir como primer paso, luego,
utilizando la función alarm se controla la duración máxima. El ejemplo que sigue muestra una
implementación de la función alarm:

#################################################
#!/usr/bin/perl

use IO::Socket;

$socket = IO::Socket::INET->new(LocalPort=>2222, Listen=>1);

$conexion = $socket->accept;

eval { # definicion del descriptor de alarma

$SIG{ALRM} = sub { die "alarm\n" };
# activar la alarma, 10 segundos
alarm(10);
$mensaje = <$conexion>; # esperar por mensaje entrante
# desactivar la larma
alarm(0);
};

# Averiguar si la salida fue por que vencio el timer

if ($@ eq "alarm") {
print "Timer expirado. No se recibieron mensajes\n";
} else {
print "Se recibio el mensaje: $mensaje\n";
}

close $conexion;
#################################################

El módulo IO::Socket y el protocolo UDP

El módulo IO::Socket permite operar con el protocolo de transporte UDP. Los métodos send y recv
permiten enviar y recibir datagramas. Los ejemplos siguientes ilustran un cliente y un servidor que
utilizan protocolo UDP

cliente UDP

#################################################
#!/usr/bin/perl
use IO::Socket;
$socket = IO::Socket::INET->new (Proto => 'udp',
PeerPort => 2222,
PeerAddr => 'localhost' );
$socket->send('Este es un mensaje!!!');
close($socket)
#################################################

Servidor UDP

#################################################
use IO::Socket;
$socket = IO::Socket::INET->new( Proto => 'udp'
LocalPort => 2222);
$socket->recv($mensaje, 1024);
print $mensaje;
close($socket);
#################################################

Multicast con IO::Socket::Multicast

El módulo permite habilitar servicios multicast en redes IP. Su utilización principal es el transporte de
flujos de datos multimediales, donde existe un emisor y varios receptores de la misma información.
Los rangos de las direcciones IP entre 224.0.0.0 y 239.255.255.255 son reservados a grupos
multicast. Un mensaje que es enviado a cualquiera de las direcciones antedichas puede ser recibido
por n hosts. Un host que desee integrar un grupo, debe crear un socket con la función
IO::Socket::INET->new() y realizar una liga (bind) a un puerto local. El método mcast_add() permite la
subscripción a grupos multicast. El método recv() permite habilitar la recepción mensajes, el envio
se realiza mediante el método send(). Los métodos auxiliares mcast_set() y mcast_send() permiten
establecer un grupodestino por defecto y enviar mensajes a tal grupo respectivamente.

El máximo número de saltos permitidos para un mensaje puede definirse con el método mcast_ttl().
Para activar o desactivar la recepción de copias de mensajes producidos por la propia se utiliza el
método mcast_loopback().

use IO::Socket::Multicast;
# Creacion de un socket en el puerto 2222
my $s = IO::Socket::Multicast->new(LocalPort=>2222);
# Adicion a un grupo multicast
$s->mcast_add('226.226.226.226');
# Habilitar modo recepcion
$s->recv($datos,1024);
# Dejar un grupo
$s->mcast_drop('226.226.226.226');
# Definir ttl de mensajes
$s->ttl(6);
# Deshabilitar loopbacking
$s->loopback(0);
# Enviar un mensaje a un grupo
$s->mcast_send('Este es el mensaje','226.226.226.226:2222');
$s->mcast_set('226.226.226.226:2222');
$s->mcast_send('Este es otro mensaje');

El siguiente programa ejemplifica el trabajar de un servidor multicast, donde periodicamente

transmite la hora al grupo 224.224.224.224 puerto 2244.

#################################################
#!/usr/bin/perl
use strict;
use IO::Socket::Multicast;
use constant DESTINATION => '224.224.224.224:2244';
my $sock = IO::Socket::INET->new( Proto=>'udp',
PeerAddr=>DESTINATION);
while (1) {
my $mensaje = localtime. "\n";
$sock->send($mensaje) || die "Error en envio: $!";
} continue {
sleep 5;
}

El siguiente es el código del cliente asociado al servicio anterior.

#################################################
#!/usr/bin/perl
use strict;
use IO::Socket::Multicast;
use constant GROUP => '224.224.224.224';
use constant PORT => '2244';
my $sock = IO::Socket::INET->new( Proto=>'udp',
LocalPort=>PORT);
$sock->mcast_add(GROUP) || die "Error en conexion al grupo: $!\n";
while (1) {
my $data;
next unless $sock->recv($data,1024);
print $data;
}
#################################################