#create the listen socket
my $listen_socket = IO::Socket::INET->new(LocalPort => 8000,
Listen => 10,
Proto => 'tcp',
Reuse => 1);
####
#write to the client socket
print $connection "Hello Client!";
#read from the client socket
my $message = <$connection>;
##
##
#set the sig handler for when a child dies
$SIG{CHLD} = \&REAPER;
#signal routine to wait for all children (prevents zombies)
sub REAPER
{
#WNOHANG means to return immediately if no child has exited.
while ((waitpid(-1, WNOHANG)) >0 ){}
#reset the sig for the next child to die;
$SIG{CHLD} = \&REAPER;
}
##
##
$SIG{CHLD} = 'IGNORE';
##
##
#!/usr/bin/perl -w
use strict;
use IO::Socket;
#get the port to bind to or default to 8000
my $port = $ARGV[0] || 8000;
#ignore child processes to prevent zombies
$SIG{CHLD} = 'IGNORE';
#create the listen socket
my $listen_socket = IO::Socket::INET->new(LocalPort => $port,
Listen => 10,
Proto => 'tcp',
Reuse => 1);
#make sure we are bound to the port
die "Cant't create a listening socket: $@" unless $listen_socket;
warn "Server ready. Waiting for connections ... \n";
#wait for connections at the accept call
while (my $connection = $listen_socket->accept)
{
my $child;
# perform the fork or exit
die "Can't fork: $!" unless defined ($child = fork());
if ($child == 0)
{ #i'm the child!
#close the child's listen socket, we dont need it.
$listen_socket->close;
#call the main child rountine
play_songs($connection);
#if the child returns, then just exit;
exit 0;
}
else
{ #i'm the parent!
#who connected?
warn "Connecton recieved ... ",$connection->peerhost,"\n";
#close the connection, the parent has already passed
# it off to a child.
$connection->close();
}
#go back and listen for the next connection!
}
sub play_songs
{
my $socket = shift;
#get all the possible songs
open PLAYLIST, "playlist.m3u" or die;
my @songs = ;
close PLAYLIST;
chomp @songs;
#seed the rand number generator
srand(time / $$);
#loop forever (or until the client closes the socket)
while()
{
#print the HTTP header. The only thing really necessary
# is the first line and the trailing "\n\n"
# depending on your client (like xmms) you can also
# send song title etc.
print $socket "HTTP/1.0 200 OK\n";
print $socket "Content-Type: audio/x-mp3stream\n";
print $socket "Cache-Control: no-cache \n";
print $socket "Pragma: no-cache \n";
print $socket "Connection: close \n";
print $socket "x-audiocast-name: My MP3 Server\n\n";
#get a random song from your playlist
my $song = $songs[ rand @songs ];
#what song are we playing
warn( "play song: $song\n");
#open the song, or continue to try another one
open (SONG, $song) || next;
binmode(SONG); #for windows users
my $read_status = 1;
my $print_status = 1;
my $chunk;
# This parts print the binary to the socket
# as fast as it can. The buffering will
# take place on the client side (it blocks when full)
# because this is *not* non-blocking IO
#
#the read will return 0 if it has reached eof
#
#the print will return undef if it fails
# (ie the client stopped listening)
#
while( $read_status && $print_status )
{
$read_status = read (SONG, $chunk, 1024);
if( defined $chunk && defined $read_status)
{
$print_status = print $socket $chunk;
}
undef $chunk;
}
close SONG;
unless( defined $print_status )
{
$socket->close();
exit(0);
}
}
}