From 8f3f3f67468f74a58cb844aaa50390a498e05f59 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Tue, 26 May 2020 10:20:35 +0100 Subject: [PATCH] bin/disorder-switch-config, bin/disorder-propagate-autoplay: New sripts. --- Makefile | 4 + bin/disorder-propagate-autoplay | 223 ++++++++++++++++++++++++++++++++++++++++ bin/disorder-switch-config | 34 ++++++ 3 files changed, 261 insertions(+) create mode 100755 bin/disorder-propagate-autoplay create mode 100755 bin/disorder-switch-config diff --git a/Makefile b/Makefile index a23e263..3665493 100644 --- a/Makefile +++ b/Makefile @@ -219,6 +219,10 @@ DOTLINKS += .tclshrc .wishrc .tclshrc_SRC = tclshrc .wishrc_SRC = tclshrc +## Jukebox things. +SCRIPTLINKS += disorder-switch-config +SCRIPTLINKS += disorder-propagate-autoplay + ## Random scripts. SCRIPTLINKS += mdw-editor mdw-pager SCRIPTLINKS += mdw-conf diff --git a/bin/disorder-propagate-autoplay b/bin/disorder-propagate-autoplay new file mode 100755 index 0000000..e70bb6a --- /dev/null +++ b/bin/disorder-propagate-autoplay @@ -0,0 +1,223 @@ +#! /usr/bin/perl -w + +use autodie qw{:all}; +use strict; + +use Digest::SHA; +use Socket qw{:DEFAULT :addrinfo}; + +use Data::Dumper; + +(my $PROG = $0) =~ s:.*/::; + +sub get_response ($) { + my ($sk) = @_; + (my $st, my $r) = split ' ', (readline $sk), 2; + chomp $r; + my $c = $st%10; $st = int($st/10); + my $b = $st%10; $st = int($st/10); + my $a = $st; + + if ($a == 5) { + if ($c == 5) { return undef; } + else { die "server error: $r"; } + } + elsif ($a != 2) { die "unexpected status code $a"; } + elsif ($c == 0 || $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"; } +} + +sub send_command ($@) { + 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 STDERR ";; <$t>\n"; + print $sk "$t\n"; + return get_response $sk; +} + +sub split_fields ($) { + my ($l) = @_; + my @f = (); + my $f; + + FIELD: for (;;) { + $l =~ s/^\s*//; + last FIELD unless $l; + 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 connect_to_server ($) { + my ($conf) = @_; + my %conf = (connect => ["-unix", "/var/lib/disorder/socket"]); + my @f; + + 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}; } + + 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) { + 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; +} + +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; +} + +if (@ARGV != 2) { die "usage: $PROG FROM TO\n"; } +my ($from, $to) = @ARGV; + +my $sk = connect_to_server $from; +my ($root0, $list) = grobble_root $sk; +my %black = (); +for my $f (@$list) { + my $pick = send_command $sk, "get", "$root0$f", "pick_at_random"; + if (($pick // 1) eq "0") { $black{trim_extension $f} = 1; } +} +close $sk; + +$sk = connect_to_server $to; +(my $root1, $list) = grobble_root $sk; +FILE: for my $f (@$list) { + my $pick = send_command $sk, "get", "$root1$f", "pick_at_random"; + if (($pick // 1) eq "0") { + next FILE if $black{trim_extension $f}; + send_command $sk, "unset", "$root1$f", "pick_at_random"; + print STDERR ";; reinstate <$f>\n"; + } else { + next FILE unless $black{trim_extension $f}; + send_command $sk, "set", "$root1$f", "pick_at_random", 0; + print STDERR ";; blacklist <$f>\n"; + } +} +close $sk; diff --git a/bin/disorder-switch-config b/bin/disorder-switch-config new file mode 100755 index 0000000..86201f3 --- /dev/null +++ b/bin/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 -- 2.11.0