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
