perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Support external handle resolution and updates
+175
-9
+5
-1
lib/ATProto/PDS/API/Builtins.pm
+5
-1
lib/ATProto/PDS/API/Builtins.pm
···
10
10
use Mojo::URL;
11
11
use Mojo::UserAgent;
12
12
13
-
use ATProto::PDS::Identity qw(account_did_doc normalize_handle service_did service_did_doc);
13
+
use ATProto::PDS::Identity qw(account_did_doc normalize_handle resolve_handle_to_did service_did service_did_doc);
14
14
use ATProto::PDS::PLC qw(is_plc_did refresh_plc_did_doc);
15
15
16
16
our @EXPORT_OK = qw(register_builtin_handlers);
···
77
77
return {
78
78
did => service_did($c->app->settings),
79
79
};
80
+
}
81
+
82
+
if (my $did = resolve_handle_to_did($c->app->settings, $handle)) {
83
+
return { did => $did };
80
84
}
81
85
82
86
if (my $did = _resolve_remote_handle_via_appview($c, $handle)) {
+9
-1
lib/ATProto/PDS/API/Misc.pm
+9
-1
lib/ATProto/PDS/API/Misc.pm
···
19
19
TOKEN_AUD_ACCESS
20
20
);
21
21
use ATProto::PDS::EventStream qw(encode_message_frame);
22
-
use ATProto::PDS::Identity qw(account_did_doc normalize_handle service_did service_did_doc);
22
+
use ATProto::PDS::Identity qw(account_did_doc normalize_handle resolve_handle_to_did service_did service_did_doc);
23
23
use ATProto::PDS::Moderation qw(assert_report_allowed);
24
24
use ATProto::PDS::PLC qw(create_signed_plc_operation is_plc_did plc_rotation_did plc_update_handle recommended_did_credentials refresh_plc_did_doc submit_plc_operation);
25
25
use ATProto::PDS::Repo::CID;
···
163
163
my $body = $c->req->json || {};
164
164
my $domain = $c->config_value('service_handle_domain', 'localhost');
165
165
my $handle = normalize_handle($body->{handle}, $domain);
166
+
$handle = normalize_handle($body->{handle}, undef, { no_append => 1 })
167
+
unless defined $handle;
166
168
xrpc_error(400, 'InvalidHandle', 'Requested handle is invalid') unless defined $handle;
169
+
my $service_handle = normalize_handle($handle, $domain, { no_append => 1 });
170
+
if (!defined $service_handle) {
171
+
my $resolved_did = resolve_handle_to_did($c->app->settings, $handle);
172
+
xrpc_error(400, 'InvalidRequest', 'External handle did not resolve to DID')
173
+
unless defined $resolved_did && lc($resolved_did) eq lc($account->{did});
174
+
}
167
175
my $existing = $c->store->get_account_by_handle($handle);
168
176
xrpc_error(400, 'HandleNotAvailable', 'That handle is already registered')
169
177
if $existing && ($existing->{did} // q()) ne $account->{did};
+50
lib/ATProto/PDS/Identity.pm
+50
lib/ATProto/PDS/Identity.pm
···
7
7
8
8
use Exporter 'import';
9
9
use Mojo::URL;
10
+
use Mojo::UserAgent;
11
+
use Net::DNS::Resolver;
10
12
11
13
use ATProto::PDS::PLC qw(account_did_method format_plc_did_doc is_plc_did recommended_did_credentials);
12
14
···
16
18
did_to_path
17
19
is_valid_handle
18
20
normalize_handle
21
+
resolve_handle_to_did
19
22
service_did
20
23
service_did_doc
21
24
service_host
···
148
151
return $handle;
149
152
}
150
153
154
+
sub resolve_handle_to_did ($config_or_url, $handle) {
155
+
my $config = _coerce_config($config_or_url);
156
+
my $normalized = normalize_handle($handle, undef, { no_append => 1 });
157
+
return undef unless defined $normalized;
158
+
159
+
return _resolve_handle_dns($normalized)
160
+
// _resolve_handle_well_known($normalized);
161
+
}
162
+
151
163
sub _coerce_config ($config_or_url) {
152
164
return $config_or_url if ref($config_or_url) eq 'HASH';
153
165
return {
154
166
base_url => $config_or_url,
155
167
service_did_method => 'did:web',
156
168
};
169
+
}
170
+
171
+
sub _resolve_handle_dns ($handle) {
172
+
state $resolver = Net::DNS::Resolver->new;
173
+
my $packet = eval { $resolver->search('_atproto.' . $handle, 'TXT') };
174
+
return undef if $@ || !$packet;
175
+
176
+
for my $rr ($packet->answer) {
177
+
next unless ($rr->type // q()) eq 'TXT';
178
+
for my $txt ($rr->txtdata) {
179
+
next unless defined $txt && $txt =~ /\Adid=(did:[^\s]+)\z/i;
180
+
return $1;
181
+
}
182
+
}
183
+
184
+
return undef;
185
+
}
186
+
187
+
sub _resolve_handle_well_known ($handle) {
188
+
state $ua = do {
189
+
my $client = Mojo::UserAgent->new(max_redirects => 0);
190
+
$client->request_timeout(15);
191
+
$client->inactivity_timeout(15);
192
+
$client;
193
+
};
194
+
195
+
my $url = Mojo::URL->new('https://' . $handle)->path('/.well-known/atproto-did');
196
+
my $tx = eval { $ua->get($url) };
197
+
return undef if $@ || !$tx;
198
+
199
+
my $res = eval { $tx->result };
200
+
return undef if $@ || !$res;
201
+
return undef unless ($res->code // 0) == 200;
202
+
203
+
my $did = $res->body // q();
204
+
$did =~ s/^\s+|\s+$//g;
205
+
return undef unless $did =~ /\Adid:[^\s]+\z/;
206
+
return $did;
157
207
}
158
208
159
209
1;
+98
t/external-handle-update.t
+98
t/external-handle-update.t
···
1
+
use v5.34;
2
+
use warnings;
3
+
4
+
use Config ();
5
+
use File::Path qw(remove_tree);
6
+
use File::Spec;
7
+
use FindBin qw($Bin);
8
+
use Test::More;
9
+
10
+
BEGIN {
11
+
require lib;
12
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
13
+
lib->import(
14
+
File::Spec->catdir($root, 'lib'),
15
+
File::Spec->catdir($root, 'local', 'lib', 'perl5'),
16
+
File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname}),
17
+
);
18
+
}
19
+
20
+
use Test::Mojo;
21
+
use ATProto::PDS;
22
+
23
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
24
+
my $tmp = File::Spec->catdir($root, 'data', 'tmp-tests', 'external-handle-update');
25
+
remove_tree($tmp) if -d $tmp;
26
+
27
+
my $t = Test::Mojo->new(ATProto::PDS->new(
28
+
project_root => $root,
29
+
settings => {
30
+
base_url => 'http://127.0.0.1:7755',
31
+
service_did_method => 'did:web',
32
+
service_handle_domain => 'localhost',
33
+
jwt_secret => 'external-handle-secret',
34
+
data_dir => $tmp,
35
+
db_path => File::Spec->catfile($tmp, 'perlsky.sqlite'),
36
+
},
37
+
));
38
+
39
+
$t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
40
+
handle => 'alice',
41
+
email => 'alice@example.com',
42
+
password => 'password123',
43
+
})->status_is(200)
44
+
->json_is('/handle' => 'alice.localhost');
45
+
46
+
my $session = $t->tx->res->json;
47
+
my $did = $session->{did};
48
+
my $access = $session->{accessJwt};
49
+
50
+
{
51
+
no warnings 'redefine';
52
+
local *ATProto::PDS::Identity::_resolve_handle_dns = sub {
53
+
my ($handle) = @_;
54
+
return $did if $handle eq 'alice.external';
55
+
return 'did:web:127.0.0.1%3A7755:users:someone-else' if $handle eq 'bob.external';
56
+
return undef;
57
+
};
58
+
local *ATProto::PDS::Identity::_resolve_handle_well_known = sub {
59
+
my ($handle) = @_;
60
+
return undef;
61
+
};
62
+
63
+
$t->post_ok('/xrpc/com.atproto.identity.updateHandle' => {
64
+
Authorization => "Bearer $access",
65
+
} => json => {
66
+
handle => 'alice.external',
67
+
})->status_is(200)
68
+
->json_is({});
69
+
70
+
$t->get_ok('/xrpc/com.atproto.identity.resolveHandle?handle=alice.external')
71
+
->status_is(200)
72
+
->json_is('/did' => $did);
73
+
74
+
$t->post_ok('/xrpc/com.atproto.server.createSession' => json => {
75
+
identifier => 'alice.external',
76
+
password => 'password123',
77
+
})->status_is(200)
78
+
->json_is('/did' => $did)
79
+
->json_is('/handle' => 'alice.external');
80
+
81
+
$t->post_ok('/xrpc/com.atproto.identity.updateHandle' => {
82
+
Authorization => "Bearer $access",
83
+
} => json => {
84
+
handle => 'bob.external',
85
+
})->status_is(400)
86
+
->json_is('/error' => 'InvalidRequest')
87
+
->json_is('/message' => 'External handle did not resolve to DID');
88
+
89
+
$t->post_ok('/xrpc/com.atproto.identity.updateHandle' => {
90
+
Authorization => "Bearer $access",
91
+
} => json => {
92
+
handle => 'missing.external',
93
+
})->status_is(400)
94
+
->json_is('/error' => 'InvalidRequest')
95
+
->json_is('/message' => 'External handle did not resolve to DID');
96
+
}
97
+
98
+
done_testing;
+13
-7
t/remote-handle-resolution.t
+13
-7
t/remote-handle-resolution.t
···
89
89
);
90
90
my $t = Test::Mojo->new($app);
91
91
92
-
$t->get_ok("/xrpc/com.atproto.identity.resolveHandle?handle=$remote_handle")
93
-
->status_is(200)
94
-
->json_is('/did' => $remote_did);
92
+
{
93
+
no warnings 'redefine';
94
+
local *ATProto::PDS::Identity::_resolve_handle_dns = sub { return undef; };
95
+
local *ATProto::PDS::Identity::_resolve_handle_well_known = sub { return undef; };
96
+
97
+
$t->get_ok("/xrpc/com.atproto.identity.resolveHandle?handle=$remote_handle")
98
+
->status_is(200)
99
+
->json_is('/did' => $remote_did);
100
+
101
+
$t->get_ok('/xrpc/com.atproto.identity.resolveHandle?handle=missing.example.test')
102
+
->status_is(404)
103
+
->json_is('/error' => 'HandleNotFound');
104
+
}
95
105
96
106
$t->get_ok("/xrpc/com.atproto.identity.resolveDid?did=$remote_did_web")
97
107
->status_is(200)
98
108
->json_is('/didDoc/id' => $remote_did_web)
99
109
->json_is('/didDoc/service/0/serviceEndpoint' => 'https://actor.example.test');
100
-
101
-
$t->get_ok('/xrpc/com.atproto.identity.resolveHandle?handle=missing.example.test')
102
-
->status_is(404)
103
-
->json_is('/error' => 'HandleNotFound');
104
110
105
111
done_testing;
106
112