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

MP3 server with IO::Socket

by perlmonkey (Hermit)
on Apr 23, 2000 at 12:56 UTC ( [id://8650]=perltutorial: 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.

Replies are listed 'Best First'.
Re: MP3 server with IO::Socket
by Ryszard (Priest) on Jan 31, 2002 at 03:59 UTC
    I've just added a web based playlist configurator to it... :-)

    Pretty much via a web page you create a playlist and store it in an array (a fully qualified mp3 name per element) I've then frozen the array with Storable.pm and stored it in a postgres database.

    #!/usr/bin/perl -w use strict; use IO::Socket; use MIME::Base64; use DBI; use Data::Dumper; use Storable qw/freeze thaw/; #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); open (PIDFILE, '>'.$0.'.pid'); print PIDFILE $$; close PIDFILE; #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"; my (@auth, @ary, $buf); #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! $connection->recv($buf, 1024); @ary = split(/0d0a/,unpack("H*",$buf) ); foreach (@ary){ my $line = pack("H*", $_); @auth = split(/ /,$line ) if ($line =~ /^Auth/); } #close the child's listen socket, we dont need it. $listen_socket->close; #call the main child rountine play_songs($connection,\@auth); #if the child returns, then just exit; undef $kids{$child}; exit 0; } else { #i'm the parent! $kids{$child} = 1; #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; my $ary = shift; my @songs; #get all the possible songs if ($#{$ary} == -1) { #get default playlist local*PLAYLIST; open PLAYLIST, "playlist.m3u" or die; @songs = <PLAYLIST>; close PLAYLIST; chomp @songs; } else { my @user = split(/\:/,decode_base64(@{$ary}[$#{$ary}]) ); @songs = &get_db_playlist(name=>$user[0]); } #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); } } } sub get_db_playlist { my %user = @_; my ($dbh, $sth, @ary); $dbh = DBI->connect('DBI:Pg:dbname=infomgr', <name> , <passwd>, { +RaiseError => 1, AutoCommit => 0 }) || die "could not connect to database: ".$dbh->errstr;; $sth = $dbh->prepare("SELECT a.playlist from playlist a, users b w +here b.name = ?"); $sth->execute($user{name}); @ary = $sth->fetchrow_array; $sth->finish; $dbh->disconnect; if ($dbh->errstr) {warn "Error getting playlist: ".$dbh->errstr }; my $retval = thaw(pack("H*", @ary) ); return @{$retval}; }

    The database table structure is very simple. I have a table of users and a table of playlists. the playlist data comes from a web page where the list songs are stored in an array which is packed and frozen (using Storable.pm) It should be simple enuff to reverse, however if you want me to post the code, let me know.

    The only thing i havent handled is a non existant name in the database. It should choose a default playlist, but it just bombs out now.

    Not the most stylish code for the additions, but it works .. :-)

    the usage via xmms is http://username:password@machine:port

    My next task is to provide handling of the above scenario, and run it via init.d

      MP3 Server in Perl ...hmmm interesting but you know what is more interesting ...
      Here is the Bash version ;)
      #!/bin/bash DIR=`pwd` echo "BASH_MP3D - A Streaming MP3 Server in Bash " echo "And You are as crazy as me if you are running this .... " echo echo "Generating Playlist .....Plz wait" PLAYLIST=`find $DIR -name *.mp3` NUM=`echo $PLAYLIST | wc -w` echo "done." echo "Listening on 5700 ....." { while true do #get seconds for random number rand=`date | cut -d ':' -f 3 |cut -d ' ' -f1` let "rand += 1" while [ "$rand" -gt "$NUM" ] do let "rand -= $NUM" done SONG=`echo $PLAYLIST | cut -d ' ' -f$rand` #Now we play the random song SONG echo "Playing $SONG ... " >& 2 echo "HTTP/1.0 200 OK"; echo "Content-Type: audio/x-mp3stream"; echo "Cache-Control: no-cache "; echo "Pragma: no-cache "; echo "Connection: close "; echo "x-audiocast-name: BASH MP3 Server"; echo; echo; dd if=$SONG bs=1024 done }| nc -l -p 5700
        Hey, I thought this was very clever, but thought I'd shorten it into the worlds smallest (and least feature-full) MP3 server:
        #!/bin/bash PLAYLIST=`find ./content -name *.mp3` NUM=`echo $PLAYLIST | wc -w` { while true; do rand=$(($RANDOM%$NUM)) song=`echo $PLAYLIST | cut -d ' ' -f$rand` echo "HTTP/1.0 200 OK\nContent-Type: audio/x-mp3stream\n\n" dd if=$song bs=1024 done } | nc -l -p 8020
        Broadcasting to the entire world! :)
      As you know the your when client to cut the connection?
Re: MP3 server with IO::Socket
by ryan (Pilgrim) on Jan 07, 2002 at 12:13 UTC
    Child reaping update:

    After yet more experimentation with this fabulously educational node I did what was necessary to make it run via init.d based on this node.

    I soon discovered that when a client was streaming and the parent was killed via the init.d script, the child serving the active client remained running and required manual killing.

    To fix this problem I kept track of the children in the code and provided a clean-up routine when the script received a TERM signal. Below I list the $SIG{"TERM"} code to catch the TERM signal and 2 extra lines inside the main while loop to track the children as marked between the # >> tags:

    # somewhere before the socket is used my %kids; $SIG{"TERM"} = "cleanup_and_exit"; sub cleanup_and_exit { my $sig = @_; foreach my $kid (keys %kids) { #reap them warn("Failed to reap child pid: $kid\n") unless kill + 9, $kid; } # it's a good idea to exit when we are told to exit(0); } # -- bits left out here -- #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; # >> undef $kids{$child}; # >> exit 0; } else { #i'm the parent! # >> $kids{$child} = 1; # >> #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! } # -- bits left out here --
    I'm not a great Perl programmer, but this works flawlessly on my Debian system and has provided my an exceptional motivational tool to start learning socket programming. I hope I havne't overlooked too much error checking or done anything dangerous with my reaping and this can be of some use to someone.

    Thanks again.

RE: MP3 server with IO::Socket
by antihec (Sexton) on Jun 03, 2000 at 16:50 UTC
    There seems to be a minor issue with the open Statement in Line 55.
    If you write it as open( PLAYLIST, "<playlist.m3u" ) || die "Can't open playlist: $!";, it will do what you mean. In its current form it evaluates to open PLAYLIST, ("playlist.m3u" || die);, I think.

    The print doesn't return 0, for me it returns undef, so I changed line 118 to unless( defined( $print_status )) to get rid of "uninitialized value"

    Thanks for sharing this nice code, btw! :-)

    -- bash$ :(){ :|:&};:
      Thanks for your comments. I was surprised, but you seem to be correct on the open statement. In the perlopentut document the two different syntax's used are:
      open FILE, "foo.txt" or die $!; #or open(FILE, "foo.txt") || die $!;
      I did not realize that perl would parse 'or' and '||' differently.

      As for the print, you are also correct, but fortunately my logic still worked. print returns undef if it failed, but the logic still held because if you use the numeric operator '==' on undef it is equivalent to 0. So this code will work: print "hello\n" if undef == 0; But I modified the code as you suggested to be more explicit.
RE: MP3 server with IO::Socket
by takshaka (Friar) on May 21, 2000 at 22:06 UTC
Re: MP3 server with IO::Socket
by ryan (Pilgrim) on Jan 03, 2002 at 11:28 UTC
    I too just tried this out. Works brilliantly first go. I modified it to traverse my MP3 directories instead of using a playlist using a common bit of stolen code:
    use File::Find; my @songs; sub eachFile { if (-e $_ && $_ =~ /\.mp3$/) { push @songs, $File::Find::name;} } find (\&eachFile, "/storage/mp3/");
    I've got this running under Debian on an old Pentium holding over 7000 MP3s and it creates the array suprisingly fast.

    Ryan
Re: MP3 server with IO::Socket
by Anonymous Monk on May 24, 2001 at 23:18 UTC
    Nice work. Exactly what I was looking for. Running it on Macos X. cwaters@digisle.net
(shockme) Re: MP3 server with IO::Socket
by shockme (Chaplain) on Dec 28, 2001 at 06:24 UTC
    ++ This is some seriously good stuff. It worked right "out of the box" on my Linux machine, and solved a huge problem I've been having. I run a wireless network at home, and the transfer speed with the Linux drivers isn't that great. I simply could not stream MP3s across the network using NFS. However, with this server, everything streams perfectly.

    Great work. Thanks!

    If things get any worse, I'll have to ask you to stop helping me.

Re: MP3 server with IO::Socket
by PaRsE (Initiate) on Aug 18, 2001 at 12:40 UTC
    maybe you could fork sockets with IO::Select instead of using fork(); because it seems to eat up all my background processes ;( i would do it myself, but i've tried, and haven't succeeded...
Re: MP3 server with IO::Socket
by Eradicatore (Monk) on Feb 16, 2003 at 15:29 UTC
    Does anyone know what meta data to send to send the name of the song to players like XMMS or winamp? I see how to send the station name, but I don't see how to change that between songs... Thanks!

    Update: Ahh, I see. I had to add code to send out icy-metaint in the header, and then puncture the stream with that meta data. There is a good description here:

    here at http://www.smackfu.com/stuff/programming/shoutcast.html

    and here at http://ample.sourceforge.net/developers.shtml

    New Question Does anyone know how to downsample the MP3 that is being streamed here by the Perl Monkey code? Thanks!

    Justin Eltoft

    "If at all god's gaze upon us falls, its with a mischievous grin, look at him" -- Dave Matthews

      Further icy headers that winamp looks for, not sure about xmms. just replace your current headers with the below content.
      print $socket "ICY 200 OK\r\n"; print $socket "Content-Type: audio/mpeg \r\n"; print $socket "Cache-Control: no-cache \r\n"; print $socket "Pragma: no-cache \r\n"; print $socket "Connection: close \r\n"; print $socket "icy-name: Fuelradio \r\n"; print $socket "icy-genre: Techno \r\n"; print $socket "icy-url: http://www.fuelradio.com \r\n"; print $socket "icy-notice1:This stream requires Winamp \r\n"; print $socket "icy-notice2:Perl Streamer v0.1a \r\n"; print $socket "icy-metadata: 1 \r\n\r\n";
      additionaly you can add
      print $socket "icy-metaint:8192\r\n";
      althoug my tests with the metaint caused alot of skipping and chirps, maybe someone can shed some light on the proper interval, im sure its different than 8192 since the mp3's are not being decoded and re-encoded within the scope of the app, there just being shoved down the throat. Anyone have ideas on how to do title streaming (i.e. showing what song is playing in the winamp/xmms title bar) maybe a id3 lib for perl??
        Altho' I've not done any structured testing ( and i use XMMS ), I've notices some mp3's titles appear and some dont. I'm taking a guess here, but i think it could be ID3 tag related..
      As well as that, I am interested in creating a buffer to allow more connections.

      I tested this script with 4 connections at a stream rate of 128kbp for the MP3's i have
      They said it would stall every couple of minutes
      I am gonig to be working on this tomorrow in case any monks have ideas
RE: MP3 server with IO::Socket
by Anonymous Monk on May 11, 2000 at 00:52 UTC
    It doesn't play the song for me. Just cycles through them all randomly without playing.
      If the server is not writting anything to the socket, then it was not able to open the song, or your client is just disconnecting. Make sure the server has acess to read all the songs in your playlist. The playlist should have one song per line, with the absolute path (ie /usr/lcoal/share/music/mysong.mp3 or something like that).

      If that doesnt help, then what is your actuall error. It could be a problem with your mp3 client. I assume you can play music with the client without the server?

      If you cant resolve your problem, provide a more exact description of the problems. Or try to step through it with the debugger.

      You can always telnet to the server (assuming it is running on port 8000) and see the file contents being written to you. telnet localhost 8000 This will cause the server to spew out the file contents. If no random characters appear on your screen, then the server was not able to open any files in you playlist.
        It's printing out the song, and it's sending it to the port, but it's cycling through songs VERY fast.
      I was having a problem getting XMMS to play. Connecting to the server in Firefox though I could see the server was sending data. I was using XMMS 1.2.10. I turned the prebuffer percent to 0% for libmpg123.so plugin and it worked fine after that.
Re: MP3 server with IO::Socket
by Anonymous Monk on Jan 28, 2004 at 19:40 UTC
    The Code gr8 ;) It gave me come more ideas to my box but how do i invoke it in xinetd.d ?????
Re: MP3 server with IO::Socket
by Anonymous Monk on Sep 20, 2004 at 20:01 UTC
    Hi, I can't quite figure out how to get this server to stream NSV files, rather than MP3 files. I can connect and keep the connection open, in fact the video file is served. It just doesn't show up in the client application. I think it's a header problem but I can't figure it out. Any ideas?
      Setup wireshark to sniff the wire while you play the NSV song from a live website. I would imagine the header just needs to be application/nsv-stream or something like that. Addendum: pulled this from the winamp support site. Was my first google hit searching for 'http header + NSV stream' Content-Type: application/vnd.ms.wms-hdr.asfv1 Might help
Re: MP3 server with IO::Socket
by Anonymous Monk on Jan 19, 2007 at 01:52 UTC
    It is sad that the comments on this wonderful thread ended where we should send metadata to the player! Yes it's 2007 and I'm still looking for a solution to send song titles to winamp. Please be a great Monk and post 6 lines of code that exactly shows how to stream the metadata to the client!
Re: MP3 server with IO::Socket
by wizbancp (Sexton) on Feb 14, 2007 at 08:42 UTC
    i notice that the playlist saved by winamp have extra line with the info about song immediately follow in the playlist file...

    example:
    ... #EXTINF Queen - Radio GaGa D:\queen\radiogaga.mp3 ...
    why don't you use this "info line" for streaming the song title to the player?
    <----------------->
    Feel the Dark Power of Regular Expressions...
      Getting the info is not so much the point. Streaming the info at the right moment and with the right way is what we are missing here. Imagine the info is already available. Do you have a code snippet that will stream the info?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perltutorial [id://8650]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (6)
As of 2024-03-19 07:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found