[George Peter Staplin] Mon Sep 17, 2007   I wanted to listen to some music I had, and I looked at the available software such as icecast, and some others, and I was disappointed by the complexity.  I decided it was easier to build my own than read the many pages of documentation and config files to make sure I had a secure audio server.

So this is what I created.  It works with WMP, xmms, and mplayer over a network.

Usage on the client side:
 mplayer http://localhost:6666

Server-side usage:
 tclsh8.5 audio_server.tcl /path/to/*.mp3

By the way, it's easy to change it to use ogg or flac.

----
 set ::clients [list]
 set ::songs [list]
 set ::song_offset 0
 set ::song_fd ""
 set ::packet ""
 
 array set ::ready {}
 
 proc ready sock {
   global ready clients
 
   set ready($sock) $sock
 
   if {[array size ready] >= [llength $clients]} {
     foreach {key sock} [array get ready] {
       send-data $sock
     }
     array unset ready
     array set ready {}
     advance
   }
 }
 
 set ::counter 1
 
 proc send-data sock {
   global packet clients
  
   if {[catch {puts -nonewline $sock $packet} err]} {
     puts stderr $err
     catch {close $sock}
     set i [lsearch -exact $clients $sock]
     set clients [lreplace $clients $i $i]
   }
   puts "sent packet to $sock $::counter"
   incr ::counter
 }
 
 proc advance {} {
   global packet song_fd song_offset songs
 
   if {"" eq $song_fd} {
     set song_fd [open [lindex $songs $song_offset] r]
     fconfigure $song_fd -translation binary
   }
 
   set packet [read $song_fd 4096]
 
   if {[eof $song_fd]} {
     catch {close $song_fd}
     set song_fd ""
     incr song_offset 
     if {$song_offset >= [llength $songs]} {
       set song_offset 0
     }
   }
 }
 
 proc accept {sock addr port} {
   global clients
   lappend clients $sock
   fconfigure $sock -blocking 1 -translation binary
 
   puts "Connection from ${addr}:$port"
 
   if {[catch {puts -nonewline $sock "HTTP/1.1 200 OK\r\n"
   puts -nonewline $sock "Content-Type: audio/mpeg\r\n"
   puts -nonewline $sock "\r\n"
   flush $sock} err]} {
     puts stderr $err
     set i [lsearch -exact $clients $sock]
     set clients [lreplace $clients $i $i]
     catch {close $sock}
   }
 
   fileevent $sock writable [list ready $sock]
 }
 
 proc main {argc argv} {
   set ::songs $argv
   socket -server accept 6666
   advance
 
   vwait _forever_
 }
 main $::argc $::argv
----