#!/usr/bin/perl

# VreeStream 2.0
# Copyright (c) 2001, Fat Freddy <ff@squat.net> and his cat 
# modifications to FreeStream for libshout 2.0 compatibility (c) 2003
# All rights reserved.

# see end of file for license

use strict;
use Shout qw{:constants};
use IO::Socket;
use IO::Select;

$| = 1;

my $ICECAST = 2;
my $DEBUG = 0;

# If I cannot connect to the selected mountpoint (ie, if there is a zombie source),
# should I force Icecast to disconnect any other sources connected to that mountpoint?
# (Warning: Can be dangerous if anyone else really is using that mountpoint!)
my $FORCECONNECT = 1;

my $stream_url = 'http:///';
my $stream_genre = 'Indymedia stream';
my $stream_desc = 'Description Of This Stream';

#Set the icecast passwords here
my $password = 'xxxxxxxx';
my $admin_pw = 'yyyyyyyy';
my $oper_pw = 'zzzzzzzz';

my $server_ip = '194.109.209.34'; #freeteam.xs4all.nl
my $server_port = '9000'; # freeteam.xs4all.nl

#my $server_ip = '192.87.116.7'; # live.waag.org
#my $server_port = 7800; # live.waag.org

# Other stream settings can be changed in the subroutine make_conn at 
# the end of this file.


#my $mount = shift @ARGV || '/vreestream.ogg';
my $mount = shift @ARGV;
my $desc = join ' ', @ARGV;
$desc = $stream_desc
	unless $desc =~ /\S/;

my $kbitrate = shift @ARGV;
my $sample = shift @ARGV;

unless ($mount) {
	print STDERR ("ARGUMENTS:  [mountpoint (default $mount)] [description (default $desc)] [bitrate (in Kb/s)] [samplerate (in Hz)]\n");
	print STDERR ("You must supply Ogg data on standard input.\n");
	exit;
	
}

unless ($mount =~ /\.ogg$/) {
	$mount = $mount . '.ogg';
}


my $errors = 0;
my $timeout = 2;

my $conn = &make_conn
	or die("Can't establish connection\n");

my ($buff, $len);
my $chunksize = 4096;
my $fraction = '';
my $i = 1;
my $starttime = time;
print '[00:00] ';

CHUNK: while ($len = read STDIN, $buff, $chunksize) {

	if ($errors > $timeout) {
		warn("Too many connection errors, trying to re-establish connection\n");
		$errors = 0;
		$conn->disconnect;
		
		$conn = &make_conn($kbitrate)
			or die("Can't re-establish connection\n");
	}

	print ".";
	$buff = $fraction . $buff
		if $fraction;
	if ($len < $chunksize) {
		warn("Incoming buffer underfilled; sleeping 1 sec");
		sleep 1;
		$chunksize -= $len;
		$fraction = $buff;
		next CHUNK;
	}
	$fraction = '';
	$chunksize = 4096;
	unless ($conn->sendData($buff)) {
		my $error = $conn->error;
		warn("Could not send data: $error\n");
		$errors++;
		next CHUNK;
	} else { $errors = 0; $i++; }

	if ($i % 40 == 0) {
		print "\n";
		my $now = time;
		my $timediff = $now - $starttime;
		my $mins = int($timediff / 60);
		my $secs = $timediff % 60;
		$mins = '0'.$mins if $mins < 10;
		$secs = '0'.$secs if $secs < 10;
		print "[$mins:$secs] ";
	}

	
	$conn->sleep;
} # end CHUNK loop

warn("No more incoming data, disconnecting\n");

$conn->disconnect;

exit;

sub make_conn {

        my $connt = new Shout
                ip              => $server_ip,
                port            => $server_port,
                mount           => $mount,
                password        => $password,
		format		=> SHOUT_FORMAT_VORBIS,
		protocol	=> SHOUT_PROTOCOL_HTTP,
                # icy_compat      => 0,
                dumpfile        => undef,
                name            => $desc,
                url             => $stream_url,
                genre           => $stream_genre,
                description     => $desc,
                ispublic        => 0;

	if (($kbitrate != 0) and ($sample != 0)) {
		$connt->set_audio_info(SHOUT_AI_BITRATE => $kbitrate, SHOUT_AI_SAMPLERATE => $sample);
	}
	
        warn ("Starting up stream to Icecast server\n");

	SHOUT: until ($connt->open) {
		warn ("Failed to connect: ", $connt->get_error);

		unless ($FORCECONNECT) { return undef; }

		if ($connt->error =~ /Login failed/i) {
			if ($ICECAST == 1) {
				&_force_icecast_1
					or return $connt;
			} elsif ($ICECAST == 2) {
				&_force_icecast_2
					or return $connt;
			} else {
				print STDERR "Forced login unimplemented for this type of remote server\n";
				return undef;
			}
		} else { return undef; }
	}

        return $connt;
}

sub _force_icecast_1 {
			my ($resp,$buf);
			&_debug("*** ABOUT TO OPEN SOCKET TO ADMIN INTERFACE");
			my $socket = IO::Socket::INET->new(	Proto => 'tcp', 
								PeerAddr => "$server_ip:$server_port",
								Type => SOCK_STREAM,
								Timeout => 5 )
				or do {
					warn("Could not open socket to $server_ip:$server_port",$!);
					return undef;
				};

			my $select = IO::Select->new($socket);
			&_debug("*** OPENED SOCKET, ABOUT TO LOG IN AS ADMIN");
			$socket->send("ADMIN $admin_pw\n\n");
			&_debug("*** SENT REQUEST");

			$resp = '';
                        &_debug("*** WAITING FOR OK");
			sleep 1;
			&_debug("*** ABOUT TO TRY RECEIVING 1000 BYTES");
			&_can_read($select)
				or return undef;
                	$socket->recv($resp,1000);
			if ($resp =~ /OK/) {
				&_debug("*** RECEIVE SUCCEEDED");
			} else { &_debug("*** DID NOT GET OK: $resp"); return undef; }

			my $dout = $resp;
			$dout =~ s/\n/\n# /g;
			&_debug("# $dout");

			my $line = "status off\noper $oper_pw\nsources\n";
			$socket->send($line);
			$dout = $line;
			$dout =~ s/\n/\n#> /g;
			&_debug("#> $dout");
			sleep 3;

			&_debug("*** ABOUT TO TRY RECEIVING 10000 BYTES");
			&_can_read($select)
				or return undef;
                	$socket->recv($resp,10000);
			&_debug("*** RECEIVE SUCCEEDED");

			$dout = $resp;
			$dout =~ s/\n/\n# /g;
			&_debug("# $dout");

			my @lines = split /[\r\n]+/,$resp;
			@lines = grep {/^\[Id:/} @lines;
			my ($id);

			LINE: while (@lines) {
				$line = shift @lines;
				my @data = split /\] \[/, $line;
				# print "\&" . join "\n\&", @data;
				my %data;

				map { 
					my ($label,$value) = split /: /, $_, 2;
					$label =~ s/^\[//;
					$value =~ s/\]$//;
					$data{$label} = $value;
				} @data;

				next LINE
					unless $data{'Id'} && $data{'Mountpoint'};
				next LINE
					unless $data{'Mountpoint'} eq "$mount";
				$id = $data{'Id'};
			}
			&_debug("*** Source on mountpoint $mount has ID $id");
			return undef
				unless $id;
			$socket->send("kick $id\n");
			sleep 1;
			$socket->send("quit\n");
			sleep 1;
			# last SHOUT;
}

sub _force_icecast_2 {
	print STDERR "Forced login not yet implemented for Icecast 2\n";
	return undef;
}

sub _debug {
	my $msg = shift;
	print "$msg\n" if $DEBUG;
}

sub _can_read {
	my $select = shift;
	if (my @ready = $select->can_read(5)) {
		&_debug("*** CAN READ FROM SOCKET");
		return 1;
	}
	else {
		&_debug("*** SOCKET TIMED OUT, EXITING");
		return 0;
	}
}

#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA