Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
I was surprised to discover how easy it was to write a fairly robust server that will wow your friends, and impress your colleagues. Well maybe.

The IO::Socket package provides a very easy object oriented interface to the nitty-gritty details of socket control. To start, all servers need a listening socket, that is a socket to which clients connect to. Creating a listen socket is trivial:
#create the listen socket my $listen_socket = IO::Socket::INET->new(LocalPort => 8000, Listen => 10, Proto => 'tcp', Reuse => 1);
This will create a listening socket on localhost port 8000, using the tcp protocal. The 'Listen' is the max number of client requests to queue. And 'Reuse' will let you stop then start the server rebinding to port 8000. With 'Reuse=>0' it could take several minutes before the kernal allows the port to be reused. These are the basic paramaters that you will need. For the full details reference the IO::Socket perldoc pages.

To actually deal will a client trying to connect, the following line will create the client socket: my $connection = $listen_socket->accept Here $connection is a socket object, which can be treated as a normal file handle. So you can print to it or read from is as a normal file handle:
#write to the client socket print $connection "Hello Client!"; #read from the client socket my $message = <$connection>;
The last little tidbit of knowledge which is really relevent does not have to do with sockets exactly, but has to do with forking servers. When a child process dies, it does not free system resources until the parent recognizes that it is dead with a 'wait' or 'waitpid' function call. Since servers generally run a long time, and fork off many children, it becomes necessary to make sure the parent notices that children are dead If the parent does not notice then the child process will become 'zombies'. Servers generally spend most of their time at the 'accept' call just waiting for a client to connect. But the problem is that it also has to be waiting for the children to die, so how can it wait for two different things at once? Easy: signals. Whenever a child dies it sends a SIGCHLD to the parent. So our server just has to register a signal handler which calls waitpid every time the SIGCHLD is sent:
#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; }
An easier alternative to this is to use: $SIG{CHLD} = 'IGNORE'; This will prevent zombie processes like the above signal handling routine, but it is all implicit. No explicit signal handling is necessary.

I just got a report that $SIG{'CHLD'} does not get used on Solaris but $SIG{'CHILD'} does, so if you are getting zombies on Solaris try changing CHLD to CHILD.

So for the mp3 player there is not a lot to add. Basically the server starts up, then a client comes in (like xmms or mpg123) opening up a socket. Then the server forks and hands off the socket to the child process. Finally the parent goes back to listening for another client. The child will simply go into an endless loop playing random songs from your playlist until the client stops listening. The child dies when the client closes its half of the socket. To create a playlist the easy way (assuming you have mp3s on your disk) do some like: find / -name "*.mp3" > playlist.m3u Here is the server in all it glory:
#!/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 = <PLAYLIST>; 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); } } }
So now you can start up there server and connect to it with your client. I suggest xmms. In xmms just do a 'Play Location', then enter "http://localhost:8000" or whatever port you started it on. To see who is listening use netstat to look at the open connections: netstat | grep 8000 You can completely ellaborate on this code with out too much trouble. I have it hooked up at my work to play custom playlists depending on what the IP address is of the client, so my friends can listen to only the music they want to. So have fun, and remember: If you cant do it with perl it is not worth doing.
Update: I removed the signal handler and set $SIG{CHLD} = 'IGNORE'. This is an easier way to prevent zombies, and from reports that I have got, the old signal hanlder failed on some versions of Solaris.
Update: I added in the binmode, and the Solaris CHILD comment per dicussions in subnodes or private email.

In reply to MP3 server with IO::Socket by perlmonkey

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others imbibing at the Monastery: (4)
    As of 2020-05-27 09:46 GMT
    Find Nodes?
      Voting Booth?
      If programming languages were movie genres, Perl would be:

      Results (154 votes). Check out past polls.