Re: MP3 server with IO::Socket

[Ryszard]

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