Quick and very dirty perl script to dump the Bluesky moderation service websocket

mod-websocket.pl

# to run this you will need to be on a *nix system (or Windows with Strawberry Perl but no guarantees)
# you will have to install Mojolicious, IO::Socket::SSL and CBOR::XS (cpanm Mojolicious IO::Socket::SSL CBOR::XS) 
# run the script and wait. Some of the output may be duplicated because this is just my little test script. 
#!/usr/bin/perl
use v5.36;
use feature 'signatures';
use Mojo::IOLoop;
use Mojo::Util qw/dumper/;
use Mojo::UserAgent qw//;
use CBOR::XS qw//;
use Mojo::File qw/path/;
use Mojo::JSON qw/encode_json/;

$|=1;

my $ua = Mojo::UserAgent->new;
my $cbor = CBOR::XS->new;

$CBOR::XS::FILTER{42} = sub($tag, $value) {
    return 'DAGCBOR CID: ' . $value;
};

my $did_pds_cache = {};

sub print_label($label) {
    print encode_json($label), "\n";
}

$ua->websocket('wss://mod.bsky.app/xrpc/com.atproto.label.subscribeLabels' => sub($ua, $tx) {
    $tx->on(finish => sub($tx, $code, $reason) {
        print "Websocket finished with code $code, reason $reason\n";
        exit(0);
    });
    $tx->on(binary => sub($tx, $bytes) {
        # this is a single websocket message/frame situation; a single frame can contain multiple
        # cbor values, it seems. The only one we're interested in has a 'labels' key 

        while(length($bytes)) {
            my ($d, $l) = $cbor->decode_prefix($bytes);
            substr($bytes, 0, $l, '');
            if(exists($d->{labels})) {
                # labels is an arrayref of labeling actions, 'src' is the did of the labeling service that 
                # provided it which, well, kind of useless since we're tapping mod.bsky.app 
                foreach my $label (@{$d->{labels}}) {
                    delete($label->{sig});
                    $label->{seq} = $d->{seq}; # transport that 

                    # for the sheets and the giggles grab the PDS too
                    my $did;
                    if($label->{uri} =~ /^did:plc/) {
                        $did = $label->{uri};
                    } elsif($label->{uri} =~ m{at://(.*?)\/.*}) {
                        $did = $1;
                    }

                    if(defined($did)) {
                        $label->{did} = $did;
                        if(defined($did_pds_cache->{$label->{did}})) {
                            $label->{pds} = $did_pds_cache->{$label->{did}};
                            print_label($label);
                        } else {
                            $ua->get('https://plc.directory/' . $label->{did} => sub($ua, $tx) {
                                my $res = $tx->result;
                                foreach my $svc (@{$res->json('/service')}) {
                                    next unless $svc->{id} eq '#atproto_pds';
                                    $label->{pds} = $svc->{serviceEndpoint};
                                    $did_pds_cache->{$label->{did}} = $svc->{serviceEndpoint};
                                }
                                $label->{pds} ||= '--UNKNOWN--';
                                print_label($label);
                            });
                        }
                    } else {
                        $label->{did} = $label->{pds} = '--UNKNOWN--';
                        print_label($label);
                    }
                }
            }
        }
    });
});

Mojo::IOLoop->start;