From: Mark Wooding Date: Mon, 28 Jun 2021 18:17:15 +0000 (+0100) Subject: Initial commit. X-Git-Url: https://git.distorted.org.uk/~mdw/disorder-toys/commitdiff_plain/8f6b6ec698be1118d56eb987a588c449d1b90c7c Initial commit. --- 8f6b6ec698be1118d56eb987a588c449d1b90c7c diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..fb1f7b4 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +/Makefile.in +/autom4te.cache/ +/aclocal.m4 +/config/ +/configure diff --git a/DisOrder.pm b/DisOrder.pm new file mode 100644 index 0000000..ab609b3 --- /dev/null +++ b/DisOrder.pm @@ -0,0 +1,190 @@ +### -*-perl-*- + +use autodie qw{:all}; +use strict; + +use Digest::SHA; +use Exporter qw{import}; +use Socket qw{:DEFAULT :addrinfo}; + +our @EXPORT_OK = qw{get_response0 decode_response get_response + send_command0 send_command + split_fields + load_config connect_to_server}; + +use Data::Dumper; + +sub split_response_code ($) { + my ($st) = @_; + my $c = $st%10; $st = int($st/10); + my $b = $st%10; $st = int($st/10); + my $a = $st; + return ($a, $b, $c); +} + +sub get_response0 ($) { + my ($sk) = @_; + (my $st, my $r) = split ' ', (readline $sk), 2; + chomp $r; + + my ($a, $b, $c) = split_response_code $st; + if ($a == 5) { + if ($c == 5) { return $st, undef; } + else { die "server error: $r"; } + } + elsif ($a != 2) { die "unexpected status code $a"; } + else { return $st, $r; } +} + +sub decode_response ($$$) { + my ($sk, $st, $r) = @_; + my ($a, $b, $c) = split_response_code $st; + + if ($c == 0 || $c == 5 || $c == 9) { return undef; } + elsif ($c == 1 || $c == 2) { return $r; } + elsif ($c == 3) { + my @r = (); + LINE: for (;;) { + chomp (my $line = readline $sk); + last LINE if $line eq "."; + $line =~ s/^\.//; + push @r, $line; + } + return @r; + } else { die "unexpected format code $c in $st"; } +} + +sub get_response ($) { + my ($sk) = @_; + my ($st, $r) = get_response0 $sk; + return decode_response $sk, $st, $r; +} + +sub send_command0 ($@) { + my ($sk, @f) = @_; + + my $t = ""; + for my $f (@f) { + if ($f eq "" || $f =~ /[\\"'\s]/) { + $f =~ s/([\\"])/\\$1/g; + $f = '"' . $f . '"'; + } + $t .= " " if $t; + $t .= $f; + } + print $sk "$t\n"; + return get_response0 $sk; +} + +sub send_command ($@) { + my ($sk, @f) = @_; + my ($st, $r) = send_command0 $sk, @f; + return decode_response $sk, $st, $r; +} + +sub split_fields ($) { + my ($l) = @_; + my @f = (); + my $f; + + FIELD: for (;;) { + $l =~ s/^\s*//; + last FIELD if $l eq ""; + if ($l =~ /^(["'])/) { + my $q = $1; + ($f, $l) = $l =~ /^ $q ((?: [^\\$q]+ | \\ .)* ) $q (.*) $/x; + $f =~ s/\\(.)/$1/g; + } else { + ($f, $l) = split ' ', $l, 2; $l //= ""; + } + push @f, $f; + } + return @f; +} + +sub load_config ($) { + my ($conf) = @_; + my %conf = (connect => ["-unix", "/var/lib/disorder/socket"]); + + open my $fh, "<", $conf; + LINE: while (<$fh>) { + chomp; + next LINE unless /^\s*[^\s#]/; + (my $k, my @f) = split; + $conf{$k} = \@f; + } + close $fh; + for my $i (qw{ username password }) + { die "missing configuration keyword `$i'" unless exists $conf{$i}; } + return \%conf; +} + +sub connect_to_server (\%;$) { + my ($conf, $quietp) = @_; + my @f; + + my $af = AF_UNSPEC; + my @a = $conf->{connect}->@*; + die "empty address" unless @a; + if ($a[0] eq "-unix") { $af = AF_UNIX; shift @a; } + elsif ($a[0] eq "-4") { $af = AF_INET; shift @a; } + elsif ($a[0] eq "-6") { $af = AF_INET6; shift @a; } + elsif ($a[0] eq "-") { shift @a; } + die "empty address" unless @a; + + my $a; + my @i; + if ($af == AF_UNIX || ($af == AF_UNSPEC && $a[0] =~ m{^/})) { + @i = ({ family => AF_UNIX, addr => pack_sockaddr_un($a[0]) }); + shift @a; + } else { + die "missing port" unless @a >= 2; + (my $e, @i) = getaddrinfo $a[0], $a[1], + { family => $af, socktype => SOCK_STREAM }; + die "getaddrinfo (host `$a[0]', service `$a[1]'): $e" if $e; + splice @a, 0, 2; + } + die "junk in address" if @a; + + my $sk; + my @e; + ADDR: for my $i (@i) { + eval { + socket $sk, $i->{family}, SOCK_STREAM, 0; + connect $sk, $i->{addr}; + }; + last ADDR unless $@; + close $sk if defined $sk; + push @e, $@->errno; + $sk = undef; + } + + unless (defined $sk) { + die "failed to connect" if $quietp; + print STDERR "failed to connect!\n"; + for (my $i = 0; $i < @i; $i++) { + if ($i[$i]{family} == AF_UNIX) + { $a = unpack_sockaddr_un $i[$i]{addr}; } + else { + my ($e, $host, $svc) = getnameinfo $i[$i]{addr}, + NI_NUMERICHOST | NI_NUMERICSERV; + die "getnameinfo: $e" if $e; + $a = $host . ":" . $svc; + } + print STDERR "\t$a: $e[$i]\n"; + } + die "giving up"; + } + autoflush $sk 1; + + @f = split_fields get_response $sk; + die "expected version 2" unless $f[0] eq "2"; + my $h = Digest::SHA->new($f[1]); + $h->add($conf->{password}[0], pack "H*", $f[2]); + my $d = $h->hexdigest; + send_command $sk, "user", $conf->{username}[0], $d; + + return $sk; +} + +1; diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..02847a9 --- /dev/null +++ b/Makefile.am @@ -0,0 +1,43 @@ +### -*-makefile-*- + +perldir = $(libdir)/site_perl + +EXTRA_DIST = +CLEANFILES = +bin_SCRIPTS = +perl_DATA = + +perl_DATA += DisOrder.pm + +V_SUBST = $(V_SUBST_@AM_V@) +V_SUBST_ = $(V_SUBST_@AM_DEFAULT_V@) +V_SUBST_0 = @echo " SUBST $@"; + +bin_SCRIPTS += disorder-autoplay +EXTRA_DIST += disorder-autoplay.in +CLEANFILES += disorder-autoplay +disorder-autoplay: disorder-autoplay.in + $(V_SUBST)sed 's#@''PERL@#$(PERL)#g' \ + <$(srcdir)/disorder-autoplay.in >disorder-autoplay.new && \ + chmod +x disorder-autoplay.new && \ + mv disorder-autoplay.new disorder-autoplay + +bin_SCRIPTS += disorder-notify +EXTRA_DIST += disorder-notify.in +CLEANFILES += disorder-notify +disorder-notify: disorder-notify.in + $(V_SUBST)sed 's#@''PERL@#$(PERL)#g' \ + <$(srcdir)/disorder-notify.in >disorder-notify.new && \ + chmod +x disorder-notify.new && \ + mv disorder-notify.new disorder-notify + +bin_SCRIPTS += disorder-ondemand +EXTRA_DIST += disorder-ondemand.in +CLEANFILES += disorder-ondemand +disorder-ondemand: disorder-ondemand.in + $(V_SUBST)sed 's#@''PERL@#$(PERL)#g' \ + <$(srcdir)/disorder-ondemand.in >disorder-ondemand.new && \ + chmod +x disorder-ondemand.new && \ + mv disorder-ondemand.new disorder-ondemand + +bin_SCRIPTS += disorder-switch-config diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..4af6283 --- /dev/null +++ b/configure.ac @@ -0,0 +1,12 @@ +dnl -*-autoconf-*- + +AC_INIT([disorder-toys], [1.0], [mdw@distorted.org.uk]) +AC_CONFIG_AUX_DIR([config]) +AM_INIT_AUTOMAKE([foreign]) +AM_SILENT_RULES([yes]) + +AC_PATH_PROG([PERL], [perl perl5], [nil]) +case $PERL in nil) AC_MSG_ERROR([can't find perl]) ;; esac + +AC_CONFIG_FILES([Makefile]) +AC_OUTPUT diff --git a/disorder-autoplay.in b/disorder-autoplay.in new file mode 100755 index 0000000..be7c137 --- /dev/null +++ b/disorder-autoplay.in @@ -0,0 +1,97 @@ +#! @PERL@ -w + +use autodie qw{:all}; +use strict; + +use DisOrder; + +(my $PROG = $0) =~ s:.*/::; + +sub grobble_dir (\@$$$); + +sub grobble_dir (\@$$$) { + my ($list, $sk, $root, $dir) = @_; + my @d; + + for my $f (send_command $sk, "files", "$root$dir") { + my ($tail) = $f =~ /\Q$root\E(.*)$/; + die "`$f' not under root `$root'" unless $tail; + push @$list, $tail; + } + + for my $d (send_command $sk, "dirs", "$root$dir") { + my ($tail) = $d =~ /\Q$root\E(.*)$/; + die "`$d' not under root `$root'" unless $tail; + push @d, $tail; + } + for my $d (@d) { grobble_dir @$list, $sk, $root, $d; } +} + +sub grobble_root ($) { + my ($sk) = @_; + my $root = undef; + my @list = (); + + for my $d (send_command $sk, "dirs", "") { + my ($pre, $tail) = $d =~ m{^(.*/)([^/]*)$}; + die "no root in `$_'?" unless $pre; + if (!defined $root) { $root = $pre; } + elsif ($root ne $pre) { die "root was `$root'; now it's `$pre'"; } + grobble_dir @list, $sk, $root, $tail; + } + return $root, \@list; +} + +sub trim_extension ($) { + my ($f) = @_; + $f =~ s/\.(flac|mp[23]|ogg|wav)$//; + return $f; +} + +sub die_usage () { + print STDERR <) { chomp; $black{$_} = 1; } + my $conf = load_config $cf; + my $sk = connect_to_server %$conf; + my ($root, $list) = grobble_root $sk; + + FILE: for my $f (sort @$list) { + my $pick = send_command $sk, "get", "$root$f", "pick_at_random"; + if (($pick // 1) eq "0") { + next FILE if $black{trim_extension $f}; + send_command $sk, "unset", "$root$f", "pick_at_random"; + print STDERR ";; reinstate <$f>\n"; + } else { + next FILE unless $black{trim_extension $f}; + send_command $sk, "set", "$root$f", "pick_at_random", 0; + print STDERR ";; blacklist <$f>\n"; + } + } + close $sk; +} diff --git a/disorder-notify.in b/disorder-notify.in new file mode 100755 index 0000000..ffdfb8e --- /dev/null +++ b/disorder-notify.in @@ -0,0 +1,414 @@ +#! @PERL@ -w + +use autodie qw{:all}; +use strict; + +use DisOrder; +use File::FcntlLock; +use Getopt::Long qw{:config gnu_compat bundling + require_order no_getopt_compat}; +use POSIX qw{:errno_h :fcntl_h}; + +###-------------------------------------------------------------------------- +### Configuration. + +my %C = (config => "$ENV{HOME}/.disorder/passwd", + lockdir => "$ENV{HOME}/.disorder/", + mixer => "Master,0"); + +(my $PROG = $0) =~ s:^.*/::; +my $TITLE = "DisOrder"; +my $VARIANT = "default"; +if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/) + { $VARIANT = $1; $TITLE .= " ($1)"; } + +###-------------------------------------------------------------------------- +### Random utilities. + +sub run_discard_output (@) { + my $kid = fork(); + if (!$kid) { + open STDOUT, ">/dev/null" or die "open /dev/null: $!"; + exec @_; + } + waitpid $kid, 0; + if ($?) { + my $st; + if ($? >= 256) { $st = sprintf "rc = %d", $? >> 8; } + else { $st = sprintf "signal %d", $?; } + die "$_[0] failed ($st)"; + } +} + +sub notify ($$) { + my ($head, $body) = @_; + + $body =~ s:\&:&:g; + $body =~ s:\<:<:g; + $body =~ s:\>:>:g; + + ##print "****************\n$head\n\n$body\n"; return; + + run_discard_output "notify-send", + "-c", "DisOrder", "-i", "audio-volume-high", "-t", "5000", + $head, $body; +} + +sub try_unlink ($) { + my ($f) = @_; + eval { unlink $f; }; + die $@ if $@ and $@->errno != ENOENT; +} + +###-------------------------------------------------------------------------- +### Locking protocol. + +my $LKFILE = "$C{lockdir}/disorder-notify-$VARIANT.lock"; +my $LKFH; + +sub locked_by () { + + ## Try to open the lock file. If it's not there, then obviously it's not + ## locked. + my $fh; + eval { open $fh, "<", $LKFILE; }; + if ($@) { + return undef if $@->errno == ENOENT; + die $@; + } + + ## Take out a non-exclusive lock on the lock file. + my $lk = new File::FcntlLock; + $lk->l_type(F_RDLCK); $lk->l_whence(SEEK_SET); + $lk->l_start(0); $lk->l_len(0); + if ($lk->lock($fh, F_SETLK)) { close $fh; return undef; } + + ## Read the pid of the current lock-holder. + chomp (my $pid = (readline $fh) // ""); + close $fh; + return $pid; +} + +sub claim_lock () { + sysopen my $fh, $LKFILE, O_CREAT | O_WRONLY; + + my $lk = new File::FcntlLock; + $lk->l_type(F_WRLCK); $lk->l_whence(SEEK_SET); + $lk->l_start(0); $lk->l_len(0); + if (!$lk->lock($fh, F_SETLK)) { + return undef if $! == EAGAIN; + die "failed to lock `$LKFILE': $!"; + } + + truncate $fh, 0; + print $fh "$$\n"; + flush $fh; + $LKFH = $fh; + 1; +} + +###-------------------------------------------------------------------------- +### DisOrder utilities. + +sub get_state0 ($) { + my ($sk) = @_; + my %st = (); + + LINE: for (;;) { + my @f = split_fields readline $sk; + if ($f[1] ne "state") { last LINE; } + elsif ($f[2] eq "enable_random") { $st{random} = 1; } + elsif ($f[2] eq "disable_random") { $st{random} = 0; } + elsif ($f[2] eq "enable_play") { $st{play} = 1; } + elsif ($f[2] eq "disable_play") { $st{play} = 0; } + elsif ($f[2] eq "resume") { $st{pause} = 0; } + elsif ($f[2] eq "pause") { $st{pause} = 1; } + } + return \%st; +} + +my $CONF = undef; + +sub configured_connection (;$) { + my ($quietp) = @_; + $CONF //= load_config $C{config}; + return connect_to_server %$CONF, $quietp // 0; +} + +sub get_state () { + my $sk = configured_connection; + send_command0 $sk, "log"; + my $st = get_state0 $sk; + close $sk; + return $st; +} + +sub decode_track_name ($\%) { + my ($sk, $info) = @_; + return unless exists $info->{track}; + my $track = $info->{track}; + for my $i ("artist", "album", "title") { + my @f = split_fields send_command $sk, "part", $track, "display", "$i"; + $info->{$i} = $f[0]; + } +} + +sub fmt_duration ($) { + my ($n) = @_; + return sprintf "%d:%02d", int $n/60, $n%60; +} + +sub get_now_playing ($) { + my ($sk) = @_; + my $r = send_command $sk, "playing"; + defined $r or return {}; + my %info = split_fields $r; + decode_track_name $sk, %info; + exists $info{sofar} and + $info{length} = send_command $sk, "length", $info{track}; + return \%info; +} + +sub format_now_playing (;\%) { + my ($info) = @_; + unless (defined $info) { + my $sk = configured_connection; + $info = get_now_playing $sk; + close $sk; + } + exists $info->{track} or return "Nothing."; + my $r = "$info->{artist}: ‘$info->{title}’"; + $r .= ", from ‘$info->{album}’" if $info->{album}; + exists $info->{sofar} && exists $info->{length} and + $r .= sprintf " (%s/%s)", + fmt_duration $info->{sofar}, fmt_duration $info->{length}; + $r .= "\n(chosen by $info->{submitter})" if exists $info->{submitter}; + return $r; +} + +sub watch_and_notify0 ($) { + my ($now_playing) = @_; + + my $sk = configured_connection 1; + my $sk_log = configured_connection 1; + + send_command0 $sk_log, "log"; + my $st = get_state0 $sk_log; + my $msg = "playing " . ($st->{play} ? "enabled" : "disabled"); + $msg .= "; random play " . ($st->{random} ? "enabled" : "disabled"); + $msg .= "; " . ($st->{pause} ? "paused" : "playing"); + notify "$TITLE state", "Connected: $msg"; + if ($st->{play} && $now_playing) { + my $info = get_now_playing $sk; + notify "$TITLE: Now playing", format_now_playing %$info; + } + + fcntl $sk_log, F_SETFL, (fcntl $sk_log, F_GETFL, 0) | O_NONBLOCK; + my $buffer = ""; + my @lines = (); + my $rdin = ""; vec($rdin, (fileno $sk_log), 1) = 1; + my $loss; + + WATCH: for (;;) { + for my $line (@lines) { + my @f = split_fields $line; + if ($f[1] eq "state") { + my $msg = undef; + if ($f[2] eq "disable_random") + { $st->{random} = 0; $msg = "Random play disabled"; } + elsif ($f[2] eq "enable_random") + { $st->{random} = 1; $msg = "Random play enabled"; } + elsif ($f[2] eq "disable_play") + { $st->{play} = 0; $msg = "Playing disabled"; } + elsif ($f[2] eq "enable_play") + { $st->{play} = 1; $msg = "Playing enabled"; } + elsif ($f[2] eq "pause") + { $st->{pause} = 1; $msg = "Paused"; } + elsif ($f[2] eq "resume") + { $st->{pause} = 0; $msg = "Playing"; } + notify "$TITLE state", $msg if defined $msg; + } elsif ($f[1] eq "playing") { + my %info; + $info{track} = $f[2]; + $info{submitter} = $f[3] if @f > 3; + decode_track_name $sk, %info; + notify "$TITLE: Now playing", format_now_playing %info; + } elsif ($f[1] eq "scratched") { + my %info; + $info{track} = $f[2]; + decode_track_name $sk, %info; + notify "$TITLE: Scratched by $f[3]", format_now_playing %info; + } elsif ($f[1] eq "completed" && !$st->{play}) { + notify "$TITLE state", "Stopped"; + } + } + + if (!$sk_log) { $loss = "EOF from server"; last WATCH; } + my $nfd = select my $rdout = $rdin, undef, undef, 60; + if (!$nfd) { + eval { print $sk_log "."; flush $sk_log; }; + if ($@) { $loss = "error from write: " . $@->errno; last WATCH; } + @lines = (); + } else { + READ: for (;;) { + my ($b, $n); + eval { $n = sysread $sk_log, $b, 4096; }; + if ($@ && $@->errno == EAGAIN) { last READ; } + elsif ($@) { $loss = "error from read: " . $@->errno; last WATCH; } + elsif (!$n) { close $sk_log; $sk_log = undef; last READ; } + else { $buffer .= $b; } + } + + @lines = split /\n/, $buffer, -1; + $buffer = pop @lines; + } + } + + notify "$TITLE state", "Lost connection: $loss"; + + close $sk; + close $sk_log if defined $sk_log; +} + +sub watch_and_notify ($) { + my ($now_playing) = @_; + + claim_lock or exit 1; + + for (;;) { + eval { watch_and_notify0 $now_playing; }; + $now_playing = 1; + sleep 5; + } +} + +###-------------------------------------------------------------------------- +### User-facing operations. + +my %OP; + +$OP{"volume-up"} = + sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%+"; }; +$OP{"volume-down"} = + sub { run_discard_output "amixer", "sset", $C{mixer}, "5\%-"; }; + +$OP{"scratch"} = sub { + my $sk = configured_connection; + send_command $sk, "scratch"; + close $sk; +}; + +$OP{"enable/disable"} = sub { + my $st = get_state; + my $sk = configured_connection; + if ($st->{play}) { send_command $sk, "disable"; } + else { send_command $sk, "enable"; } + close $sk; +}; + +$OP{"play/pause"} = sub { + my $st = get_state; + my $sk = configured_connection; + if (!$st->{play}) { + send_command $sk, "enable"; + if ($st->{pause}) { send_command $sk, "resume"; } + } else { + if ($st->{pause}) { send_command $sk, "resume"; } + else { send_command $sk, "pause"; } + } + close $sk; +}; + +$OP{"watch"} = sub { + if (defined (my $lkpid = locked_by)) { + print STDERR "$0: already watched by pid $lkpid\n"; + exit 2; + } + watch_and_notify 1; +}; + +$OP{"now-playing"} = sub { + my $sk = configured_connection; + my $info = get_now_playing $sk; + close $sk; + print format_now_playing %$info; + print "\n"; +}; + +$OP{"notify-now-playing"} = sub { + my $sk = configured_connection; + my $info = get_now_playing $sk; + close $sk; + notify "$TITLE: Now playing", format_now_playing %$info; + unless (defined locked_by) { + fork and exit 0; + watch_and_notify 0; + } +}; + +$OP{"next-config"} = sub { + (my $dir = $C{config}) =~ s:/[^/]*$::; + my (@conf, $curr, $conf, $min); + + if (-l $C{config} && (my $t = readlink $C{config}) =~ /^passwd\.(.*)$/) + { $curr = $1; } + + opendir my $dh, +$dir; + FILE: while (my $f = readdir $dh) + { push @conf, $1 if $f =~ /^passwd\.(.*[^~])$/; } + + for (my $i = 0; $i < @conf; $i++) { + $min = $conf[$i] if (!defined $min) || $conf[$i] lt $min; + $conf = $conf[$i] + if ((!defined $curr) || $curr lt $conf[$i]) && + ((!defined $conf) || $conf[$i] lt $conf); + } + $conf = $min unless defined $conf; + + try_unlink "$dir/passwd.new"; + symlink "passwd.$conf", "$dir/passwd.new"; + rename "$dir/passwd.new", "$dir/passwd"; + notify "DisOrder configuration", "Switched to `$conf'"; +}; + +###-------------------------------------------------------------------------- +### Main program. + +sub usage (\*) { + my ($fh) = @_; + print $fh "usage: $PROG [-u CONFIG] COMMAND\n"; +} + +sub help () { + usage *STDOUT; + print < sub { help; exit 0; }, + "u|user-config=s" => \$C{config} + or $bad = 1; +@ARGV == 1 or $bad = 1; +if ($bad) { usage *STDERR; exit 2; } +my $op = $ARGV[0]; +if (!exists $OP{$op}) { print STDERR "$0: unknown op `$op'\n"; exit 2; } +$OP{$op}(); + +###----- That's all, folks -------------------------------------------------- diff --git a/disorder-ondemand.in b/disorder-ondemand.in new file mode 100755 index 0000000..86b9249 --- /dev/null +++ b/disorder-ondemand.in @@ -0,0 +1,170 @@ +#! @PERL@ -w + +use autodie qw{:all}; +use strict; + +use DisOrder; +use Getopt::Long qw{:config gnu_compat bundling + require_order no_getopt_compat}; +use POSIX qw{:errno_h :fcntl_h :sys_wait_h}; + +my $CONFFILE = undef; +my $DEBUG = 0; +(my $PROG = $0) =~ s:^.*/::; + +sub mumble ($) { print STDERR ";; $_[0]\n" if $DEBUG; } + +sub connection () { + my $file = $CONFFILE // "$ENV{HOME}/.disorder/passwd", my $conf; + + if (-f $file || defined $CONFFILE) + { $conf = load_config $file; } + else { + $conf = { connect => ["-unix", "/var/lib/disorder/private/socket"], + username => ["root"], password => ["hunoz"] }; + } + return connect_to_server %$conf; +} + +my $PAUSETIME = 300; +my $PID = undef; +my $STATE = "off"; # `off', `on', `killed' +my $WANT = "off"; # `off', `on', `pause' +my $STOPTIME = undef; # if $WANT eq "pause" +my $NOW = time; + +$SIG{CHLD} = sub { + KID: for (;;) { + my $kid = waitpid -1, WNOHANG; + last if $kid <= 0; + if ($kid == $PID) { + mumble "player exited (st = $?)"; + $PID = undef; $STATE = "off"; + } + } +}; + +$SIG{TERM} = $SIG{INT} = sub { + kill "TERM", $PID if defined $PID; + exit 0; +}; + +sub start () { $WANT = "on"; $STOPTIME = undef; } + +sub pause () { + if ($WANT eq "on") { $WANT = "pause"; $STOPTIME = $NOW + $PAUSETIME; } +} + +sub fix_state () { + + ##mumble "state = $STATE ($PID)"; + ##mumble "want = $WANT ($STOPTIME <=> $NOW)"; + + if ($WANT eq "pause" && $NOW >= $STOPTIME) { + $WANT = "off"; $STOPTIME = undef; + mumble "pause time up: stopping" if $STATE eq "on"; + } + + if ($WANT eq "on" && $STATE eq "off") { + my $kid = fork(); + if (!$kid) { exec @ARGV; } + $STATE = "on"; $PID = $kid; + mumble "player wanted but not running: started pid $kid"; + } elsif ($WANT eq "off" && $STATE eq "on") { + kill "TERM", $PID; + $STATE = "killed"; + mumble "player running but not wanted: killed pid $PID"; + } +} + +sub watch_status () { + my $sk = connection; + + my $pause, my $track = 0; + + my $rdin = ""; vec($rdin, fileno($sk), 1) = 1; + my $buffer = "", my @lines = (); + + $NOW = time; + + my $r = send_command $sk, "playing"; + $track = defined $r; + + print $sk "log\n"; + fcntl $sk, F_SETFL, (fcntl $sk, F_GETFL, 0) | O_NONBLOCK; + WATCH: for (;;) { + + if (!$sk) { mumble "eof from server"; last WATCH; } + my $nfd; + SEL: { + eval { + $nfd = select my $rdout = $rdin, undef, undef, + defined($STOPTIME) ? $STOPTIME - $NOW : 60; + }; + if ($@ && $@->errno == EINTR) { next SEL; } + elsif ($@) { mumble "error from select: " . $@->errno; last WATCH; } + } + if (!$nfd) { + eval { print $sk "."; flush $sk; }; + if ($@) { mumble "error from write: " . $@->errno; last WATCH; } + @lines = (); + } else { + READ: for (;;) { + my ($b, $n); + eval { $n = sysread $sk, $b, 4096; }; + if ($@ && $@->errno == EAGAIN) { last READ; } + elsif ($@ && $@->errno == EINTR) { next READ; } + elsif ($@) { mumble "error from read: " . $@->errno; last WATCH; } + elsif (!$n) { close $sk; $sk = undef; last READ; } + else { $buffer .= $b; } + } + + @lines = split /\n/, $buffer, -1; + $buffer = pop @lines; + } + + for my $line (@lines) { + my @f = split_fields $line; + if ($f[1] eq "state") { + if ($f[2] eq "pause") { mumble "paused"; $pause = 1; } + elsif ($f[2] eq "resume") { mumble "unpaused"; $pause = 0; } + } elsif ($f[1] eq "playing") { mumble "track started"; $track = 1; } + elsif ($f[1] eq "completed") { mumble "track finished"; $track = 0; } + } + + $NOW = time; + + if ($track && !$pause) { start; } else { pause; } + fix_state; + } +} + +sub usage (\*) { + my ($fh) = @_; + print $fh "usage: $PROG [-d] [-u CONFIG] [--] COMMAND ARGS...\n"; +} + +sub help () { + usage *STDOUT; + print < sub { help; exit 0; }, + "d|debug" => \$DEBUG, + "u|user-config=s" => \$CONFFILE + or $bad = 1; +@ARGV > 0 or $bad = 1; +if ($bad) { usage *STDERR; exit 2; } + +for (;;) { + eval { watch_status; }; mumble "watcher exited: $@"; + pause; fix_state; + sleep 5; +} diff --git a/disorder-switch-config b/disorder-switch-config new file mode 100755 index 0000000..86201f3 --- /dev/null +++ b/disorder-switch-config @@ -0,0 +1,34 @@ +#! /bin/sh -e + +prog=${0##*/} +fail () { echo >&2 "$prog: $1"; exit 2; } +usage () { echo "usage: $prog [CONF]"; } + +bogus=nil +while getopts "h" opt; do + case $opt in + h) usage; exit 0 ;; + *) bogus=t ;; + esac +done +shift $(( $OPTIND - 1 )) +case $# in 0) op=query ;; 1) op=set conf=$1 ;; *) bogus=t ;; esac +case $bogus in t) usage >&2; exit 2 ;; esac + +cd "$HOME/.disorder" +case $op in + query) + if ! [ -L passwd ]; then link=bogus + else link=$(readlink passwd) + fi + case $link in + passwd.*) conf=${link#passwd.} ;; + *) fail "\`~/.disorder/passwd' not a link to \`passwd.CONF'" ;; + esac + echo "$conf" + ;; + set) + if ! [ -f "passwd.$conf" ]; then fail "no config \`passwd.$conf'"; fi + ln -sf "passwd.$conf" passwd + ;; +esac