perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
13
fork

Configure Feed

Select the types of activity you want to include in your feed.

Resolve OAuth permission sets via lexicon authorities

alice 4870f678 4d2c241a

+283 -11
+114 -11
lib/ATProto/PDS/Auth/OAuth.pm
··· 28 28 ); 29 29 use ATProto::PDS::Auth::Password qw(random_hex timing_safe_eq); 30 30 use ATProto::PDS::Constants qw(TOKEN_AUD_ACCESS TOKEN_AUD_REFRESH); 31 + use ATProto::PDS::Identity qw(did_to_path); 31 32 use ATProto::PDS::Moderation qw(assert_login_allowed is_repo_takedown); 33 + use ATProto::PDS::PLC qw(is_plc_did refresh_plc_did_doc); 34 + use ATProto::PDS::Repo::CAR qw(read_car); 35 + use ATProto::PDS::Repo::DagCbor qw(decode_dag_cbor); 32 36 use ATProto::PDS::Util::BaseX qw(base64url_decode base64url_encode); 33 37 34 38 our @EXPORT_OK = qw( ··· 755 759 return $cache{$nsid} = $local->{defs}{main}; 756 760 } 757 761 758 - my $authority_handle = _nsid_authority_handle($nsid); 759 - return $cache{$nsid} = undef unless defined $authority_handle && length $authority_handle; 762 + my $authority_did = $self->_resolve_lexicon_authority_did($nsid); 763 + return undef unless defined $authority_did && length $authority_did; 760 764 761 - my $appview_url = $c->config_value('bsky_appview_url', 'https://api.bsky.app'); 762 - return $cache{$nsid} = undef unless defined $appview_url && length $appview_url; 765 + my $did_doc = $self->_resolve_remote_did_doc($authority_did); 766 + return undef unless ref($did_doc) eq 'HASH'; 763 767 764 - my $url = Mojo::URL->new($appview_url)->path('/xrpc/com.atproto.repo.getRecord')->query( 765 - repo => $authority_handle, 768 + my $service_url = _did_doc_atproto_service($did_doc); 769 + return undef unless defined $service_url && length $service_url; 770 + 771 + my $url = Mojo::URL->new($service_url)->path('/xrpc/com.atproto.sync.getRecord')->query( 772 + did => $authority_did, 766 773 collection => 'com.atproto.lexicon.schema', 767 774 rkey => $nsid, 768 775 ); 769 776 my $tx = eval { $self->ua->get($url => { 'Accept-Encoding' => 'identity' }) }; 770 - return $cache{$nsid} = undef if $@ || !$tx; 777 + return undef if $@ || !$tx; 771 778 772 779 my $res = $tx->result; 773 - return $cache{$nsid} = undef unless $res && $res->is_success; 780 + return undef unless $res && $res->is_success; 781 + my $lexicon = _permission_set_lexicon_from_car($res->body, $nsid); 782 + return undef unless ref($lexicon) eq 'HASH'; 783 + return $cache{$nsid} = $lexicon->{defs}{main}; 784 + } 785 + 786 + sub _resolve_lexicon_authority_did ($self, $nsid) { 787 + my $authority = _nsid_authority_handle($nsid); 788 + return undef unless defined $authority && length $authority; 789 + 790 + state $resolver = do { 791 + return undef unless eval { require Net::DNS::Resolver; 1 }; 792 + Net::DNS::Resolver->new; 793 + }; 794 + return undef unless $resolver; 795 + 796 + my $packet = eval { $resolver->search('_lexicon.' . $authority, 'TXT') }; 797 + return undef if $@ || !$packet; 798 + 799 + for my $rr ($packet->answer) { 800 + next unless ($rr->type // q()) eq 'TXT'; 801 + for my $txt ($rr->txtdata) { 802 + next unless defined $txt && $txt =~ /\Adid=(did:[^\s]+)\z/i; 803 + return $1; 804 + } 805 + } 806 + 807 + return undef; 808 + } 809 + 810 + sub _resolve_remote_did_doc ($self, $did) { 811 + if (is_plc_did($did)) { 812 + my $did_doc = eval { refresh_plc_did_doc($self->settings, $did) }; 813 + return undef if $@; 814 + return $did_doc; 815 + } 816 + 817 + return undef unless defined $did && $did =~ /\Adid:web:/i; 818 + 819 + my ($host, $path) = _web_did_origin_and_path($did); 820 + return undef unless defined $host && defined $path; 821 + my $scheme = $host =~ /\A(?:localhost|127\.0\.0\.1|\[::1\])(?::\d+)?\z/i ? 'http' : 'https'; 822 + my $url = Mojo::URL->new("$scheme://$host"); 823 + $url->path($path); 824 + 825 + my $tx = eval { $self->ua->get($url) }; 826 + return undef if $@ || !$tx; 827 + my $res = eval { $tx->result }; 828 + return undef if $@ || !$res; 829 + return undef unless ($res->code // 0) == 200; 774 830 my $json = $res->json; 775 - my $value = ref($json) eq 'HASH' ? $json->{value} : undef; 776 - return $cache{$nsid} = undef unless _is_permission_set_lexicon($value, $nsid); 777 - return $cache{$nsid} = $value->{defs}{main}; 831 + return undef unless ref($json) eq 'HASH' && ($json->{id} // q()) eq $did; 832 + return $json; 833 + } 834 + 835 + sub _did_doc_atproto_service ($did_doc) { 836 + return undef unless ref($did_doc) eq 'HASH'; 837 + my $services = $did_doc->{service}; 838 + return undef unless ref($services) eq 'ARRAY'; 839 + 840 + for my $service (@$services) { 841 + next unless ref($service) eq 'HASH'; 842 + next unless ($service->{type} // q()) eq 'AtprotoPersonalDataServer'; 843 + my $endpoint = $service->{serviceEndpoint}; 844 + return $endpoint if defined $endpoint && length $endpoint; 845 + } 846 + 847 + return undef; 848 + } 849 + 850 + sub _web_did_origin_and_path ($did) { 851 + return unless defined $did && $did =~ s/\Adid:web://i; 852 + my @parts = split /:/, $did; 853 + return unless @parts; 854 + 855 + my $host = shift @parts; 856 + $host =~ s/%3a/:/ig; 857 + if (@parts && $parts[0] =~ /\A\d+\z/ && $host !~ /:/) { 858 + $host .= ':' . shift @parts; 859 + } 860 + 861 + my $path = @parts 862 + ? '/' . join('/', map { s/%3A/:/igr } @parts) . '/did.json' 863 + : did_to_path('did:web:' . $did); 864 + return ($host, $path); 865 + } 866 + 867 + sub _permission_set_lexicon_from_car ($bytes, $nsid) { 868 + return undef unless defined $bytes && length $bytes; 869 + 870 + my $car = eval { read_car($bytes) }; 871 + return undef if $@ || ref($car) ne 'HASH'; 872 + 873 + for my $block (@{ $car->{blocks} || [] }) { 874 + next unless ref($block) eq 'HASH' && defined($block->{bytes}); 875 + my $value = eval { decode_dag_cbor($block->{bytes}) }; 876 + next if $@; 877 + return $value if _is_permission_set_lexicon($value, $nsid); 878 + } 879 + 880 + return undef; 778 881 } 779 882 780 883 sub _is_permission_set_lexicon ($lexicon, $nsid) {
+169
t/oauth-lexicon-resolution.t
··· 1 + use v5.34; 2 + use warnings; 3 + use feature 'signatures'; 4 + no warnings 'experimental::signatures'; 5 + 6 + use Config (); 7 + use File::Spec; 8 + use FindBin qw($Bin); 9 + use Test::More; 10 + 11 + BEGIN { 12 + require lib; 13 + my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..')); 14 + lib->import( 15 + File::Spec->catdir($root, 'lib'), 16 + File::Spec->catdir($root, 'local', 'lib', 'perl5'), 17 + File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname}), 18 + ); 19 + } 20 + 21 + use ATProto::PDS::Auth::OAuth; 22 + use ATProto::PDS::Repo::CAR qw(write_car); 23 + use ATProto::PDS::Repo::CID; 24 + use ATProto::PDS::Repo::DagCbor qw(encode_dag_cbor); 25 + 26 + { 27 + package OAuthLexiconResolutionTestUA; 28 + 29 + sub new ($class, %args) { 30 + return bless { 31 + body => $args{body}, 32 + calls => [], 33 + }, $class; 34 + } 35 + 36 + sub get ($self, $url, @rest) { 37 + push @{ $self->{calls} }, $url->to_string; 38 + return bless { 39 + body => $self->{body}, 40 + }, 'OAuthLexiconResolutionTestTx'; 41 + } 42 + 43 + sub calls ($self) { 44 + return $self->{calls}; 45 + } 46 + } 47 + 48 + { 49 + package OAuthLexiconResolutionTestTx; 50 + 51 + sub result ($self) { 52 + return bless { 53 + body => $self->{body}, 54 + }, 'OAuthLexiconResolutionTestResult'; 55 + } 56 + } 57 + 58 + { 59 + package OAuthLexiconResolutionTestResult; 60 + 61 + sub is_success { return 1 } 62 + sub body ($self) { return $self->{body} } 63 + } 64 + 65 + { 66 + package OAuthLexiconResolutionTestContext; 67 + 68 + sub new ($class) { 69 + return bless {}, $class; 70 + } 71 + 72 + sub app ($self) { 73 + return bless {}, 'OAuthLexiconResolutionTestApp'; 74 + } 75 + } 76 + 77 + { 78 + package OAuthLexiconResolutionTestApp; 79 + 80 + sub lexicons ($self) { 81 + return bless {}, 'OAuthLexiconResolutionTestLexicons'; 82 + } 83 + } 84 + 85 + { 86 + package OAuthLexiconResolutionTestLexicons; 87 + 88 + sub get ($self, $nsid) { 89 + return undef; 90 + } 91 + } 92 + 93 + my $nsid = 'pub.leaflet.authFullPermissions'; 94 + my $lexicon = { 95 + lexicon => 1, 96 + id => $nsid, 97 + defs => { 98 + main => { 99 + type => 'permission-set', 100 + permissions => [{ 101 + type => 'permission', 102 + resource => 'rpc', 103 + inheritAud => 1, 104 + lxm => ['pub.leaflet.reader.getSavedFeeds'], 105 + }], 106 + }, 107 + }, 108 + }; 109 + 110 + my $bytes = encode_dag_cbor($lexicon); 111 + my $car = write_car( 112 + undef, 113 + [{ 114 + cid => ATProto::PDS::Repo::CID->for_dag_cbor($bytes), 115 + bytes => $bytes, 116 + }], 117 + ); 118 + my $ua = OAuthLexiconResolutionTestUA->new(body => $car); 119 + my $oauth = ATProto::PDS::Auth::OAuth->new( 120 + settings => { jwt_secret => 'test-secret' }, 121 + ua => $ua, 122 + ); 123 + 124 + { 125 + no warnings 'redefine'; 126 + local *ATProto::PDS::Auth::OAuth::_resolve_lexicon_authority_did = sub ($self, $loaded_nsid) { 127 + return 'did:plc:btxrwcaeyodrap5mnjw2fvmz' if $loaded_nsid eq $nsid; 128 + return undef; 129 + }; 130 + local *ATProto::PDS::Auth::OAuth::_resolve_remote_did_doc = sub ($self, $did) { 131 + return { 132 + id => $did, 133 + service => [{ 134 + id => '#atproto_pds', 135 + type => 'AtprotoPersonalDataServer', 136 + serviceEndpoint => 'https://chanterelle.us-west.host.bsky.network', 137 + }], 138 + }; 139 + }; 140 + 141 + my $loaded = $oauth->_load_permission_set(OAuthLexiconResolutionTestContext->new, $nsid); 142 + is( 143 + $loaded->{type}, 144 + 'permission-set', 145 + 'permission set is loaded from the authority PDS sync.getRecord response', 146 + ); 147 + is_deeply( 148 + $loaded->{permissions}, 149 + $lexicon->{defs}{main}{permissions}, 150 + 'permission-set permissions are preserved', 151 + ); 152 + is( 153 + scalar(@{ $ua->calls }), 154 + 1, 155 + 'permission-set loader makes a single remote request', 156 + ); 157 + like( 158 + $ua->calls->[0], 159 + qr{\Ahttps://chanterelle\.us-west\.host\.bsky\.network/xrpc/com\.atproto\.sync\.getRecord\?}, 160 + 'loader fetches lexicons from the authority PDS sync.getRecord endpoint', 161 + ); 162 + like( 163 + $ua->calls->[0], 164 + qr{(?:\?|&)did=did%3Aplc%3Abtxrwcaeyodrap5mnjw2fvmz(?:&|\z)}, 165 + 'loader queries the authority DID directly instead of an appview repo handle', 166 + ); 167 + } 168 + 169 + done_testing;