From 8fc81da8a858102a46f2237ca690b48379d27302 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Sun, 3 Oct 2021 14:47:30 +0100 Subject: [PATCH] Delete the Disorder hacks. These now live in a separate `disorder-toys' repository. --- Makefile | 7 - bin/disorder-autoplay | 97 ----------- bin/disorder-notify | 414 --------------------------------------------- bin/disorder-switch-config | 34 ---- pl/DisOrder.pm | 190 --------------------- 5 files changed, 742 deletions(-) delete mode 100755 bin/disorder-autoplay delete mode 100755 bin/disorder-notify delete mode 100755 bin/disorder-switch-config delete mode 100644 pl/DisOrder.pm diff --git a/Makefile b/Makefile index 992fdab..be1e688 100644 --- a/Makefile +++ b/Makefile @@ -227,13 +227,6 @@ DOTLINKS += .tclshrc .wishrc .tclshrc_SRC = tclshrc .wishrc_SRC = tclshrc -## Jukebox things. -MISCLINKS += lib/perl/DisOrder.pm -lib/perl/DisOrder.pm_SRC = pl/DisOrder.pm -SCRIPTLINKS += disorder-switch-config -SCRIPTLINKS += disorder-autoplay -SCRIPTLINKS += disorder-notify - ## Random scripts. SCRIPTLINKS += mdw-editor mdw-pager SCRIPTLINKS += mdw-conf diff --git a/bin/disorder-autoplay b/bin/disorder-autoplay deleted file mode 100755 index 7b0eca3..0000000 --- a/bin/disorder-autoplay +++ /dev/null @@ -1,97 +0,0 @@ -#! /usr/bin/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/bin/disorder-notify b/bin/disorder-notify deleted file mode 100755 index 2b0d5e8..0000000 --- a/bin/disorder-notify +++ /dev/null @@ -1,414 +0,0 @@ -#! /usr/bin/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/bin/disorder-switch-config b/bin/disorder-switch-config deleted file mode 100755 index 86201f3..0000000 --- a/bin/disorder-switch-config +++ /dev/null @@ -1,34 +0,0 @@ -#! /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 diff --git a/pl/DisOrder.pm b/pl/DisOrder.pm deleted file mode 100644 index ab609b3..0000000 --- a/pl/DisOrder.pm +++ /dev/null @@ -1,190 +0,0 @@ -### -*-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; -- 2.11.0