File: iceserver.pl

package info (click to toggle)
gmusicbrowser 1.1.9-2
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 6,908 kB
  • sloc: perl: 33,804; makefile: 91; sh: 3
file content (66 lines) | stat: -rwxr-xr-x 1,917 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
#!/usr/bin/perl
# Copyright (C) 2005-2006 Quentin Sculo <squentin@free.fr>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 3, as
# published by the Free Software Foundation

use strict;
use warnings;
use Socket;
use constant { EOL => "\015\012" };
my ($file,$sec,$title);
my $port=8000;
while (my $arg=shift)
{	if    ($arg eq '-p') {$port=shift||8000}
	elsif ($arg eq '-b') {shift}
	elsif ($arg eq '-K') {$sec='-k '.shift}
	elsif ($arg eq '-title') {$title=shift}
	elsif (-f $arg) {$file=$arg}
}

$title||=$file;
my $mime='audio/x-unknown';  #FIXME
if	($file=~m/mp3$/i) { $mime='audio/mpeg'; }
elsif	($file=~m/ogg$|oga$/i) { $mime='application/ogg'; }
elsif	($file=~m/flac$/i) { $mime='audio/x-flac'; }
elsif	($file=~m/mpc$/i) { $mime='audio/x-musepack'; }

sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

my $proto = getprotobyname('tcp');
($port) = $port =~ /^(\d+)$/			or die "invalid port";
socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
				pack('l', 1))	|| die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!";
listen(Server,SOMAXCONN)			|| die "listen: $!";
logmsg "server started on port $port";

my $paddr = accept(Client,Server);
my($port2,$iaddr) = sockaddr_in($paddr);
#my $name = gethostbyaddr($iaddr,AF_INET);
logmsg 'connection from ',inet_ntoa($iaddr), " at port $port2";

#shoutcast and icecast protocol :
# http://sander.vanzoest.com/talks/2002/audio_and_apache/
while (<Client>)
{	#warn $_;
	last if $_ eq EOL;
}
my $answer=
	'HTTP/1.0 200 OK'.EOL.
	'Server: iceserver/0.2'.EOL.
	"Content-Type: $mime".EOL.
	"x-audiocast-name: $title".EOL.
	'x-audiocast-public: 0'.EOL;
send Client,$answer.EOL,0;
#warn $answer;
open FILE,$file;
while (read FILE,$_,16384)
{	send Client,$_,0;
}
close Client;
exit;