Powered by ViewCVS 1.0-dev
bad Craig
#! /usr/bin/perl -Tw
$vsn = q$Id: hifi.pl,v 1.4 2002/10/09 02:42:55 mca1001 Exp $;
BEGIN {
$ENV{'PATH'} = '/bin:/sbin:/usr/bin:/usr/sbin';
$ENV{'ENV'} = '';
}
use CGI::Carp qw(fatalsToBrowser);
use HTML::Entities;
use strict;
use vars qw(%cgi $self $vsn);
$self = $ENV{'SCRIPT_NAME'} || die "What's my name today, nurse?";
$self =~ s@^.+/([^/]+)$@$1@;
$| = 1;
# Read input
%cgi = ();
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
CGIgetpairs($ENV{QUERY_STRING});
} else {
die "$ENV{'REQUEST_METHOD'} not method not available for $self";
}
if ($ENV{'SERVER_NAME'} eq 'troop.granta.internal') {
my %okhosts;
@okhosts{map {"$_.granta.internal"}
qw(
carraway
robinson
mcgarry
raggy-dan
troop
mr-clamp
dibble
mr-craddock
relapse
aggee
grubb
mr-wilkins
nick-fisher
platt
walter-harkin
philby
nibbs
mrs-cobbit
varley
potter
dappy
mr-antonio
pugh
barney-mcgrew
)} = ();
die "Pah, I'm not talking to you! Ask the administrator (below) to put $ENV{'REMOTE_HOST'} on the list"
unless exists $okhosts{$ENV{'REMOTE_HOST'}};
} else {
warn "Skipping the builting access checks\n";
}
##############################################################################
if (not $cgi{'mode'}) {
# "guess the mode" code
my $quest = 'fuser -v /dev/dsp /tmp/xmms_*'; # ask for PID and name of programs using sound device
my $ans = `$quest 2>&1`;
die "Failed to determine current program from '$quest': $ans / $! ($?)" if $?;
if ($ans =~ m@([-\w/]*(?:xmms|mpg123)[-\w/]*)\s*$@m) {
my $mode = $1;
my %pids = ();
while ($ans =~ s@^.*?\s*(\d+) f\.\.\.\. $mode\s*$@@m) { $pids{$1} = undef }
@cgi{qw(mode pids)} = ($mode, join ".", keys %pids);
warn "HIFIcomment: Greetings to ".who()."\n";
reloc();
} else {
my $choose = "No (recognised) sound program is running. You could pick a mode, but it may not get you very far:\n<ul>\n";
foreach my $m (qw(xmms mpg123)) { $choose .= '<li><a href="'.url(mode=>$m)."\">$m</a>\n" }
$choose .= "</ul>\n<hr><pre>$ans</pre><hr>\n";
output($choose, 2, $self); # exits
}
}
die "I don't understand '$cgi{'mode'}' mode" unless $cgi{'mode'} =~ /^(xmms|mpg123)$/;
# we have a mode .. we assume it's still correct (ie. program hasn't died)
if (exists $cgi{'op'}) {
warn "HIFIcomment: Operation '$cgi{'op'}' from ".who()."\n";
docmd();
reloc();
} elsif (exists $cgi{'vol'}) {
my $v = $cgi{'vol'};
warn "HIFIcomment: Volume set to '$cgi{'vol'}' from ".who()."\n";
die "Volume ($v) must be an integer from 0 to 100. You should know that..."
unless $v =~ /^(\d+)$/ && $v >= 0 && $v <= 100;
$v = $1; # launder
my $oops = `/usr/bin/aumix -w $v 2>&1`;
die "Problem setting volume: $oops / $! / $?" if $? || $oops;
reloc();
} elsif (exists $cgi{'chat'}) {
$cgi{'chat'} =~ s/\s+/ /g;
warn "HIFIcomment: Chat: $cgi{'chat'}\n";
warn "HIFIcomment: from ".who()."...\n";
reloc();
}
my $msgform = 'type quickly... <form action="'.$self.'" method="get">
<input type="text" name="chat" size="40">
'.(join "\n", map { '<input type="hidden" name="'.CGIencode($_).'" value="'.CGIencode($cgi{$_}).'">' }
qw(mode pids seq)).'
<input type="submit" value="chat"></form>';
my $html = ("<table cellpadding=\"15\" border=\"1\">".
"<tr><td colspan=\"2\">\n".
volumecontrol().
"\n</td></tr><tr><td colspan=\"2\">\n".
nowplaying().
"\n</td></tr><tr><td>\n".
skipcontrol(). "</td><td>$msgform".
"\n</td></tr><tr><td colspan=\"2\">\n".
showlog().
"</td></tr></table>\n");
output($html, 0.5, url(), url(mode=>'', pids=>'')); # exits
exit 0;
##############################################################################
sub who # return text indication of who's calling
{
my $who = $ENV{'REMOTE_HOST'}; # ." / ".$ENV{'HTTP_USER_AGENT'};
$who =~ s/\s+/ /g;
return $who;
}
#----------------------------------------------------------------------------
sub volumecontrol # display a volume control
{
my $volume = `/usr/bin/aumix -wq 2>&1`;
return "<strong>Can't read current volume: $volume / $! / $?</strong>" if $?;
return "Volume says '$volume', but that doesn't make much sense to me\n"
unless $volume =~ /^pcm\s*(\d+)\s*,\s*(\d+)\s*(,\s*[RP]\s*)?$/;
my ($l, $r) = ($1, $2);
my $ctrl = '';
if ($l != $r) {
$ctrl = "Balance is off-centre ($l%, $r%) but it will be centred if you change volume from this interface<p>\n";
$l = int(($l + $r) / 2);
}
$ctrl .= "<table border=\"1\">\n";
my ($newvol, @btns);
for ($newvol=0; $newvol < $l && $newvol <= 100; $newvol += 10) { push @btns, volbtn($newvol, $l) }
$ctrl .= '<tr><td align="left"><nobr>' . (join " ", @btns) . "</nobr></td><td></td><td></td></tr>\n";
@btns = ();
for ($newvol = $l<5 ? 0 : $l-5; $newvol <= $l + 5 && $newvol <= 100; $newvol += 1)
{ push @btns, volbtn($newvol, $l) }
$ctrl .= '<tr><td></td><td align="center"><nobr>' . (join " ", @btns) . "</nobr></td><td></td></tr>\n";
@btns = ();
for ($newvol = 100; $newvol > $l; $newvol -= 10) { unshift @btns, volbtn($newvol, $l) }
$ctrl .= '<tr><td></td><td></td><td align="right"><nobr>' . (join " ", @btns) . "</nobr></td></tr>\n";
$ctrl .= "</table>\n";
$ctrl .= "<em>If you want it any louder you will have to walk over and tweak the knob on the speakers!</em>\n"
if $l == 100;
return $ctrl;
}
sub volbtn
{
my ($n, $o) = (shift,shift);
return ($n == $o ?
"<strong>[$n%]</strong>" :
'<a href="'.url(vol=>$n)."\">$n%</a>"
);
}
#----------------------------------------------------------------------------
sub nowplaying # display item currently being played
{
return "Dunno what's playing. Write some code." unless -d "/proc";
die "Wot no pids? You want to start again I think"
unless defined $cgi{'pids'};
die "Can't get a sensible PID from '$cgi{'pids'}', that probably means they've gone home"
unless $cgi{'pids'} =~ /^[\d.]+$/;
my $playing;
my %pids;
@pids{ split /\./, $cgi{'pids'} } = ();
foreach my $pid (keys %pids) {
$playing = `ls -l /proc/$pid/fd 2>&1`; # eww, what a mess!
if ($?) {
$playing .= " $!";
delete $pids{$pid}; # no point coming back to this one
} else {
last;
}
}
$cgi{'pids'} = join ".", keys %pids;
return "I've no idea what's playing at the moment.
I got an error ($playing) while trying to find out\n"
if $?;
return "Can't tell what's playing. Patch the program.\n"
unless $playing =~ /\s+\d+ -> (.+\.(?:mp3|ogg|wav|mid))\s*$/mi;
return encode_entities($1);
}
#----------------------------------------------------------------------------
sub skipcontrol # display remote-control buttons
{
my @ctrls;
if ($cgi{'mode'} eq 'xmms') {
@ctrls = ([back => '<<'],
[play => '>' ],
[pause=> 'pause' ],
[stop => '[]' ],
[forw => '>>'] );
} elsif ($cgi{'mode'} eq 'mpg123') {
@ctrls = ([pause=> 'pause' ],
[play => '>' ],
[forw => '>>'] );
}
return "Can't do skipcontrol for '$cgi{'mode'}' mode\n" unless @ctrls;
return ("<center>[\n".
(join " \n", map {skipbtn(@{$_})} @ctrls).
"\n ]</center>");
}
sub skipbtn
{
my ($op, $sym) = (shift,shift);
return '<a href="'.url(op=>$op)."\">$sym</a>";
}
sub docmd
{
die "Invalid command '$cgi{'op'}'" unless $cgi{'op'} =~ /^([a-z]+)$/;
my $cmd = $1;
$cgi{'mode'} =~ /^(\w+)$/;
$cmd .= ".$1";
my %cmd = ('back.xmms' => '/usr/bin/xmms -r',
'play.xmms' => '/usr/bin/xmms -p',
'pause.xmms' => '/usr/bin/xmms -u',
'stop.xmms' => '/usr/bin/xmms -s',
'forw.xmms' => '/usr/bin/xmms -f',
'pause.mpg123'=> 'killall -STOP mpg123',
'play.mpg123' => 'killall -CONT mpg123',
'forw.mpg123' => 'killall -INT mpg123 ; sleep 1',
);
if (defined $cmd{$cmd}) {
my $oops = `$cmd{$cmd} 2>&1`;
die "Oops - '$cmd{$cmd}': $oops $!" if $?;
} else {
die "Command '$cmd' not implemented";
}
}
#----------------------------------------------------------------------------
sub showlog # display who's been at what
{
# eww, this is hideous; for people with CPU to burn
my $logfile = `/usr/bin/tail -200 /var/log/apache/error.log 2>&1`;
$logfile .= " $!" if $?;
my @logs = grep s/.*HIFIcomment: (.+)/$1/, split /\n/, $logfile;
return (join "<br>\n",
reverse
map { /chat/i ? '<font color="red">'.$_.'</font>' : $_ }
map {encode_entities($_)}
@logs
);
}
#----------------------------------------------------------------------------
sub output # args = (HTML, [optional: refresh time/sec, refresh url, [option: bottom-linked refresh url]])
{
my $html = shift;
my ($reftime, $refurl) = @_ ? (shift, shift) : (undef, undef);
my $clickrefresh = @_ ? shift : ( defined $refurl ? $refurl : undef );
print "Content-type: text/html\nPragma: no-cache\n
<html><head>\n <title>Hifi: $ENV{'SERVER_NAME'}</title>\n";
print ' <meta http-equiv="Refresh" content="'.(60 * $reftime).";URL=$refurl\">\n" if defined $reftime;
print "</head>\n<body>\n$html\n";
print "<i>this page should <a href=\"$clickrefresh\">refresh</a> in $reftime minutes...</i>\n" if defined $reftime;
print "<em>Generated by $vsn</em>\n";
print "</body></html>\n";
exit 0;
}
sub reloc
{
my $where = ("http://$ENV{'SERVER_NAME'}".
substr($ENV{'SCRIPT_NAME'}, 0,
length($ENV{'SCRIPT_NAME'}) - length($self)).
url());
print <<"magic";
Content-type: text/html
Location: $where
<html><head><title>Go to the $cgi{'mode'} mode</title></head>
<body>You want to be <a href="$where">here</a> now.</body>
</html>
magic
exit 0;
}
##############################################################################
sub url # arg = (key => value pairs, as separate items)
{
my %itms = splice @_, 0;
foreach (qw(mode pids seq)) { $itms{$_} = $cgi{$_} if defined $cgi{$_} && not defined $itms{$_} }
$itms{'seq'} = defined $itms{'seq'} ? $itms{'seq'}+1 : 0;
return ("$self?".
join "&", map { CGIencode($_).'='.CGIencode($itms{$_}) } keys %itms
);
}
#
#> CGI library functions
#
sub CGIgetpairs # arg = string to break into key=value
# data is poked into the global %cgi
{
local $_;
foreach (split /[&?]/, $_[0]) {
my ($key, $val) = split '=', $_;
$val = '' unless defined $val;
$cgi{lc(CGIdecode($key))} = CGIdecode($val)
if defined $key;
}
}
# the CGI conversion convention
sub CGIencode # arg = input, returns quoted
{
local $_ = shift;
s/([^\w\/\-., ])/uc sprintf("%%%02x",ord($1))/eg;
s/ /+/g;
return $_;
}
sub CGIdecode # arg = input, returns decoded
{
local $_ = shift;
s/\+/ /g;
s/%([0-9a-f]{2})/pack("c",hex($1))/gie;
return $_;
}
|
Repository owner Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |