perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Require authenticated DID account migration
+376
-4
+4
-2
docs/TEST_AUDIT.md
+4
-2
docs/TEST_AUDIT.md
···
1
1
# Test Audit Status
2
2
3
-
As of 2026-03-12, the focused test-correctness and reference-audit pass is complete on rewritten history through `16c510b`.
3
+
As of 2026-03-12, the focused test-correctness and reference-audit pass is complete on rewritten history through `9a3afbb`.
4
4
5
5
That does not mean every test has been manually revalidated against every other PDS implementation line by line. It means:
6
6
···
13
13
The current baseline for saying "the audited suite is green" is:
14
14
15
15
- `prove -lr t`
16
-
- last full green result in the realigned Meridian worktree: `Files=44, Tests=2525`
16
+
- last full green result in the realigned Meridian worktree before the current migration-auth follow-up: `Files=48, Tests=2758`
17
17
- `prove -lv t/server-auth.t`
18
18
- `perl -c script/differential-validate`
19
19
- `PERLSKY_RUN_REFERENCE_DIFF=1 prove -lv t/reference-differential.t`
···
54
54
- Remote `did:web` DID docs, conservative `resolveIdentity` handle validation, and external handle adoption all need explicit coverage because small resolver-policy drifts turn into visible interop bugs quickly.
55
55
- `com.atproto.repo.getRecord` must honor `cid` when present, and `putRecord` / `deleteRecord` must actually enforce `swapRecord`; those negative edges are now covered directly.
56
56
- `com.atproto.server.requestPasswordReset` and `com.atproto.server.deleteAccount` now follow the reference form-token flow, with focused regression coverage for missing-account and bearerless deletion semantics.
57
+
- `com.atproto.server.createAccount` with an explicit `did` must behave like an authenticated migration flow: require auth from that same DID, keep the existing DID document, and start the new account deactivated until activation catches the DID document up to the new PDS.
57
58
- `com.atproto.server.checkAccountStatus` must validate the stored DID document against the PDS service endpoint and signing key, and `com.atproto.repo.describeRepo` must derive `didDoc` / `handleIsCorrect` from that document instead of hardcoding success.
58
59
- `com.atproto.sync.getBlob` should ship the same download-hardening headers as the reference PDS (`X-Content-Type-Options`, `Content-Disposition`, `Content-Security-Policy`).
59
60
···
82
83
| `t/api-util.t` | audited local regression | helper semantics, cursor validation, service-auth helper behavior |
83
84
| `t/app-routes.t` | local correctness/infrastructure | app route exposure and startup wiring smoke |
84
85
| `t/app.t` | audited local regression | application bootstrap plus malformed-handle rejection and startup hardening |
86
+
| `t/account-migration-auth.t` | audited local regression | explicit-`did` account creation requires authenticated migration service-auth and preserves remote DID-doc state while starting deactivated |
85
87
| `t/auth-jwt.t` | local correctness/infrastructure | JWT signing and validation behavior |
86
88
| `t/browser-smoke.t` | local correctness/infrastructure | optional browser-driven end-to-end wrapper |
87
89
| `t/catalog.t` | local correctness/infrastructure | lexicon/catalog exposure smoke |
+170
-2
lib/ATProto/PDS/API/Server.pm
+170
-2
lib/ATProto/PDS/API/Server.pm
···
5
5
use feature 'signatures';
6
6
no warnings 'experimental::signatures';
7
7
8
+
use Crypt::PK::ECC;
8
9
use Exporter 'import';
9
10
use JSON::PP ();
11
+
use Mojo::URL;
12
+
use Mojo::UserAgent;
10
13
11
14
use ATProto::PDS::API::Helpers qw(find_account invite_code_view issue_account_action_token require_admin update_account_email verify_account_password verify_login_password);
12
15
use ATProto::PDS::API::Util qw(iso8601 xrpc_error);
···
29
32
TOKEN_AUD_ACCESS
30
33
TOKEN_AUD_REFRESH
31
34
);
32
-
use ATProto::PDS::Identity qw(account_did account_did_doc account_did_doc_valid_for_service normalize_handle service_did);
35
+
use ATProto::PDS::Identity qw(account_did account_did_doc account_did_doc_valid_for_service did_to_path normalize_handle service_did);
33
36
use ATProto::PDS::Moderation qw(assert_login_allowed is_repo_takedown);
34
37
use ATProto::PDS::PLC qw(account_did_method create_plc_account is_plc_did refresh_plc_did_doc);
35
38
use ATProto::PDS::Repo::CAR qw(read_car);
39
+
use ATProto::PDS::Util::BaseX qw(base64url_decode decode_base58btc);
36
40
37
41
our @EXPORT_OK = qw(register_server_handlers require_auth session_view);
38
42
···
83
87
my $account_id = random_hex(8);
84
88
my $did_method = account_did_method($c->app->settings);
85
89
my $did = $body->{did};
90
+
my $migration = defined($did) && length($did);
86
91
my $reserved = $body->{did} ? $c->store->get_reserved_signing_key($did) : undef;
87
92
my $keys = ($reserved && !defined $reserved->{claimed_at})
88
93
? {
···
93
98
}
94
99
: $c->repo_manager->generate_signing_key;
95
100
my $did_doc;
101
+
my $deactivated_at;
102
+
if ($migration) {
103
+
_assert_create_account_requester($c, $did, $endpoint->{id});
104
+
$did_doc = _resolve_migration_did_doc($c, $did) // { id => $did };
105
+
$deactivated_at = time;
106
+
}
96
107
if (!$did) {
97
108
if ($did_method eq 'did:plc') {
98
109
my $plc = create_plc_account(
···
123
134
email_confirmed_at => _initial_email_confirmed_at($c, $body->{email}),
124
135
password_hash => $password_record->{hash},
125
136
password_salt => $password_record->{salt},
137
+
deactivated_at => $deactivated_at,
126
138
did_doc => $did_doc,
127
139
private_key => $keys->{private_key},
128
140
public_key => $keys->{public_key},
···
135
147
repo_commit_cid => $repo->{cid},
136
148
repo_root_cid => $repo->{root_cid},
137
149
repo_rev => $repo->{rev},
138
-
did_doc => is_plc_did($account->{did}) ? refresh_plc_did_doc($c->app->settings, $account->{did}) : account_did_doc($c->app->settings, $account),
150
+
did_doc => $migration
151
+
? ($account->{did_doc} || $did_doc || { id => $account->{did} })
152
+
: is_plc_did($account->{did})
153
+
? refresh_plc_did_doc($c->app->settings, $account->{did})
154
+
: account_did_doc($c->app->settings, $account),
139
155
);
140
156
141
157
$c->store->record_invite_code_use(
···
143
159
used_by => $account->{did},
144
160
) if $invite;
145
161
$c->store->claim_reserved_signing_key($did) if $reserved && !defined $reserved->{claimed_at};
162
+
unless (defined $account->{deactivated_at}) {
146
163
$c->append_event(
147
164
did => $account->{did},
148
165
type => EVENT_TYPE_IDENTITY,
···
181
198
did => $account->{did},
182
199
},
183
200
);
201
+
}
184
202
185
203
return _issue_session($c, $account);
186
204
});
···
780
798
return ('InvalidToken', 'Token is malformed')
781
799
if $message =~ /three sections/i;
782
800
return ('InvalidToken', 'Token is invalid');
801
+
}
802
+
803
+
sub _assert_create_account_requester ($c, $did, $lxm) {
804
+
my $message = "Missing auth to create account with did: $did";
805
+
my $requester = eval {
806
+
my (undef, $account) = require_auth($c, audience => TOKEN_AUD_ACCESS, required_scope => 'full');
807
+
return $account->{did};
808
+
};
809
+
return 1 if defined($requester) && _same_did($requester, $did);
810
+
811
+
$requester = _verify_migration_service_auth($c, $did, $lxm);
812
+
xrpc_error(401, 'AuthRequired', $message)
813
+
unless defined($requester) && _same_did($requester, $did);
814
+
return 1;
815
+
}
816
+
817
+
sub _verify_migration_service_auth ($c, $did, $lxm) {
818
+
my $auth = $c->req->headers->authorization // q();
819
+
return undef unless $auth =~ /\ABearer\s+(.+)\z/i;
820
+
my $token = $1;
821
+
822
+
my ($header_b64, $claims_b64, $sig_b64) = split /\./, $token, 3;
823
+
return undef unless defined $sig_b64;
824
+
825
+
my $header = eval { JSON::PP::decode_json(base64url_decode($header_b64)) };
826
+
return undef if $@ || ref($header) ne 'HASH';
827
+
return undef unless ($header->{alg} // q()) eq 'ES256K';
828
+
829
+
my $claims = eval { JSON::PP::decode_json(base64url_decode($claims_b64)) };
830
+
return undef if $@ || ref($claims) ne 'HASH';
831
+
return undef unless _same_did(($claims->{iss} // q()), $did);
832
+
833
+
my $now = time;
834
+
return undef if defined($claims->{nbf}) && $claims->{nbf} > $now;
835
+
return undef if defined($claims->{iat}) && $claims->{iat} > ($now + 60);
836
+
return undef if defined($claims->{exp}) && $claims->{exp} <= $now;
837
+
return undef unless _audience_matches_service($c, $claims->{aud});
838
+
return undef unless lc($claims->{lxm} // q()) eq lc($lxm // q());
839
+
840
+
my $did_doc = _resolve_migration_did_doc($c, $did) or return undef;
841
+
my $public_key = _did_doc_atproto_public_key($did_doc) or return undef;
842
+
843
+
my $pk = eval {
844
+
my $ecc = Crypt::PK::ECC->new;
845
+
$ecc->import_key_raw($public_key, 'secp256k1');
846
+
$ecc;
847
+
};
848
+
return undef if $@ || !$pk;
849
+
850
+
my $verified = eval {
851
+
$pk->verify_message_rfc7518(base64url_decode($sig_b64), "$header_b64.$claims_b64", 'SHA256');
852
+
};
853
+
return undef if $@ || !$verified;
854
+
855
+
return $claims->{iss};
856
+
}
857
+
858
+
sub _audience_matches_service ($c, $aud) {
859
+
my %acceptable = map { ($_ // q()) => 1 } grep { defined && length } (
860
+
service_did($c->app->settings),
861
+
$c->config_value('base_url'),
862
+
);
863
+
if (ref($aud) eq 'ARRAY') {
864
+
return scalar grep { $acceptable{$_ // q()} } @$aud;
865
+
}
866
+
return $acceptable{$aud // q()} ? 1 : 0;
867
+
}
868
+
869
+
sub _resolve_migration_did_doc ($c, $did) {
870
+
my $service_did = service_did($c->app->settings);
871
+
return {
872
+
id => $service_did,
873
+
} if _same_did($did, $service_did);
874
+
875
+
my $account = $c->store->get_account_by_did($did);
876
+
return $account->{did_doc} || account_did_doc($c->app->settings, $account)
877
+
if $account;
878
+
879
+
if (is_plc_did($did)) {
880
+
my $did_doc = eval { refresh_plc_did_doc($c->app->settings, $did) };
881
+
return $did_doc unless $@;
882
+
return undef;
883
+
}
884
+
885
+
return undef unless $did =~ /\Adid:web:/i;
886
+
my ($host, $path) = _web_did_origin_and_path($did);
887
+
return undef unless defined $host && defined $path;
888
+
889
+
state %ua_for_origin;
890
+
my $origin = lc($host);
891
+
my $ua = $ua_for_origin{$origin} //= do {
892
+
my $client = Mojo::UserAgent->new(max_redirects => 0);
893
+
$client->request_timeout(15);
894
+
$client->inactivity_timeout(15);
895
+
$client;
896
+
};
897
+
898
+
my $scheme = $host =~ /\A(?:localhost|127\.0\.0\.1|\[::1\])(?::\d+)?\z/i ? 'http' : 'https';
899
+
my $url = Mojo::URL->new("$scheme://$host");
900
+
$url->path($path);
901
+
902
+
my $tx = eval { $ua->get($url) };
903
+
return undef if $@ || !$tx;
904
+
my $res = eval { $tx->result };
905
+
return undef if $@ || !$res || ($res->code // 0) != 200;
906
+
my $json = $res->json;
907
+
return undef unless ref($json) eq 'HASH' && _same_did(($json->{id} // q()), $did);
908
+
return $json;
909
+
}
910
+
911
+
sub _did_doc_atproto_public_key ($did_doc) {
912
+
return undef unless ref($did_doc) eq 'HASH';
913
+
my $did = $did_doc->{id} // q();
914
+
my ($verification_method) = grep {
915
+
ref($_) eq 'HASH'
916
+
&& length($_->{publicKeyMultibase} // q())
917
+
&& (
918
+
(($_->{id} // q()) eq "$did#atproto")
919
+
|| (($_->{id} // q()) eq '#atproto')
920
+
)
921
+
} @{ $did_doc->{verificationMethod} || [] };
922
+
$verification_method //= (grep {
923
+
ref($_) eq 'HASH' && length($_->{publicKeyMultibase} // q())
924
+
} @{ $did_doc->{verificationMethod} || [] })[0];
925
+
return undef unless $verification_method;
926
+
927
+
my $multibase = $verification_method->{publicKeyMultibase} // q();
928
+
return undef unless $multibase =~ /\Az(.+)\z/;
929
+
return decode_base58btc($1);
930
+
}
931
+
932
+
sub _web_did_origin_and_path ($did) {
933
+
return unless defined $did;
934
+
my $copy = $did;
935
+
return unless $copy =~ s/\Adid:web://i;
936
+
937
+
my @parts = split /:/, $copy;
938
+
return unless @parts;
939
+
my $host = shift @parts;
940
+
$host =~ s/%3a/:/ig;
941
+
if (@parts && $parts[0] =~ /\A\d+\z/ && $host !~ /:/) {
942
+
$host .= ':' . shift @parts;
943
+
}
944
+
my $path = @parts ? '/' . join('/', map { s/%3A/:/igr } @parts) . '/did.json' : did_to_path($did);
945
+
return ($host, $path);
946
+
}
947
+
948
+
sub _same_did ($left, $right) {
949
+
return 0 unless defined($left) && defined($right);
950
+
return lc($left) eq lc($right) ? 1 : 0;
783
951
}
784
952
785
953
sub _issue_session ($c, $account, %opts) {
+202
t/account-migration-auth.t
+202
t/account-migration-auth.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 IO::Socket::INET;
9
+
use Test::More;
10
+
use Time::HiRes qw(sleep);
11
+
12
+
BEGIN {
13
+
require lib;
14
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
15
+
lib->import(
16
+
File::Spec->catdir($root, 'lib'),
17
+
File::Spec->catdir($root, 'local', 'lib', 'perl5'),
18
+
File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname}),
19
+
);
20
+
}
21
+
22
+
use JSON::PP ();
23
+
use Mojo::Server::Daemon;
24
+
use Mojo::URL;
25
+
use Mojo::UserAgent;
26
+
use Test::Mojo;
27
+
use ATProto::PDS;
28
+
29
+
my @pids;
30
+
END {
31
+
my $status = $?;
32
+
kill 'TERM', @pids if @pids;
33
+
waitpid($_, 0) for @pids;
34
+
$? = $status;
35
+
}
36
+
37
+
my $root = File::Spec->rel2abs(File::Spec->catdir($Bin, '..'));
38
+
my $tmp = File::Spec->catdir($root, 'data', 'tmp-tests', 'account-migration-auth');
39
+
remove_tree($tmp) if -d $tmp;
40
+
41
+
my $old_port = _find_free_port();
42
+
my $old_base = "http://127.0.0.1:$old_port";
43
+
44
+
my $old_app = ATProto::PDS->new(
45
+
project_root => $root,
46
+
settings => {
47
+
base_url => $old_base,
48
+
service_did_method => 'did:web',
49
+
service_handle_domain => 'old.test',
50
+
jwt_secret => 'old-migration-secret',
51
+
db_path => File::Spec->catfile($tmp, 'old.sqlite'),
52
+
data_dir => File::Spec->catdir($tmp, 'old-data'),
53
+
},
54
+
);
55
+
my $old_t = Test::Mojo->new($old_app);
56
+
57
+
$old_t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
58
+
handle => 'alice.old.test',
59
+
email => 'alice@example.test',
60
+
password => 'password123',
61
+
})->status_is(200);
62
+
my $alice = $old_t->tx->res->json;
63
+
64
+
$old_t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
65
+
handle => 'bob.old.test',
66
+
email => 'bob@example.test',
67
+
password => 'password123',
68
+
})->status_is(200);
69
+
my $bob = $old_t->tx->res->json;
70
+
my $new_service_did = 'did:web:127.0.0.1%3A7755';
71
+
72
+
$old_t->get_ok(Mojo::URL->new('/xrpc/com.atproto.server.getServiceAuth')->query(
73
+
aud => $new_service_did,
74
+
lxm => 'com.atproto.server.createAccount',
75
+
) => {
76
+
Authorization => "Bearer $alice->{accessJwt}",
77
+
})->status_is(200)
78
+
->json_like('/token' => qr/\w/);
79
+
my $alice_service_jwt = $old_t->tx->res->json->{token};
80
+
81
+
$old_t->get_ok(Mojo::URL->new('/xrpc/com.atproto.server.getServiceAuth')->query(
82
+
aud => $new_service_did,
83
+
lxm => 'com.atproto.server.createAccount',
84
+
) => {
85
+
Authorization => "Bearer $bob->{accessJwt}",
86
+
})->status_is(200)
87
+
->json_like('/token' => qr/\w/);
88
+
my $bob_service_jwt = $old_t->tx->res->json->{token};
89
+
90
+
_start_daemon($old_app, $old_port);
91
+
92
+
my $new_app = ATProto::PDS->new(
93
+
project_root => $root,
94
+
settings => {
95
+
base_url => 'http://127.0.0.1:7755',
96
+
service_did_method => 'did:web',
97
+
service_handle_domain => 'new.test',
98
+
jwt_secret => 'new-migration-secret',
99
+
db_path => File::Spec->catfile($tmp, 'new.sqlite'),
100
+
data_dir => File::Spec->catdir($tmp, 'new-data'),
101
+
},
102
+
);
103
+
my $new_t = Test::Mojo->new($new_app);
104
+
105
+
$new_t->get_ok('/xrpc/com.atproto.server.describeServer')
106
+
->status_is(200)
107
+
->json_is('/did' => $new_service_did);
108
+
109
+
$new_t->post_ok('/xrpc/com.atproto.server.createAccount' => json => {
110
+
did => $alice->{did},
111
+
handle => 'alice.new.test',
112
+
email => 'alice@example.test',
113
+
password => 'password123',
114
+
})->status_is(401)
115
+
->json_is('/error' => 'AuthRequired')
116
+
->json_is('/message' => "Missing auth to create account with did: $alice->{did}");
117
+
118
+
$new_t->post_ok('/xrpc/com.atproto.server.createAccount' => {
119
+
Authorization => "Bearer $bob_service_jwt",
120
+
} => json => {
121
+
did => $alice->{did},
122
+
handle => 'alice.new.test',
123
+
email => 'alice@example.test',
124
+
password => 'password123',
125
+
})->status_is(401)
126
+
->json_is('/error' => 'AuthRequired')
127
+
->json_is('/message' => "Missing auth to create account with did: $alice->{did}");
128
+
129
+
$new_t->post_ok('/xrpc/com.atproto.server.createAccount' => {
130
+
Authorization => "Bearer $alice_service_jwt",
131
+
} => json => {
132
+
did => $alice->{did},
133
+
handle => 'alice.new.test',
134
+
email => 'alice@example.test',
135
+
password => 'password123',
136
+
})->status_is(200)
137
+
->json_is('/did' => $alice->{did})
138
+
->json_is('/active' => JSON::PP::false)
139
+
->json_is('/status' => 'deactivated')
140
+
->json_is('/didDoc/id' => $alice->{did})
141
+
->json_is('/didDoc/service/0/serviceEndpoint' => $old_base);
142
+
143
+
my $migrated = $new_app->store->get_account_by_did($alice->{did});
144
+
ok(defined $migrated->{deactivated_at}, 'migration createAccount stores the new account as deactivated');
145
+
is($migrated->{did_doc}{service}[0]{serviceEndpoint}, $old_base, 'migration keeps the existing remote DID document until activation');
146
+
147
+
$new_t->post_ok('/xrpc/com.atproto.server.createSession' => json => {
148
+
identifier => 'alice.new.test',
149
+
password => 'password123',
150
+
})->status_is(200)
151
+
->json_is('/active' => JSON::PP::false)
152
+
->json_is('/status' => 'deactivated');
153
+
154
+
done_testing;
155
+
156
+
sub _start_daemon {
157
+
my ($app, $port) = @_;
158
+
my $pid = fork();
159
+
die 'fork failed' unless defined $pid;
160
+
161
+
if ($pid == 0) {
162
+
my $daemon = Mojo::Server::Daemon->new(
163
+
app => $app,
164
+
listen => ["http://127.0.0.1:$port"],
165
+
silent => 1,
166
+
);
167
+
$daemon->run;
168
+
exit 0;
169
+
}
170
+
171
+
push @pids, $pid;
172
+
_wait_for_health("http://127.0.0.1:$port");
173
+
return;
174
+
}
175
+
176
+
sub _wait_for_health {
177
+
my ($base_url) = @_;
178
+
my $ua = Mojo::UserAgent->new(max_redirects => 0);
179
+
for (1 .. 100) {
180
+
my $ok = eval {
181
+
my $tx = $ua->get("$base_url/_health");
182
+
my $res = $tx->result;
183
+
return ($res->code // 0) == 200;
184
+
};
185
+
return 1 if $ok;
186
+
sleep 0.05;
187
+
}
188
+
die "mock server did not become ready at $base_url";
189
+
}
190
+
191
+
sub _find_free_port {
192
+
my $sock = IO::Socket::INET->new(
193
+
LocalAddr => '127.0.0.1',
194
+
LocalPort => 0,
195
+
Proto => 'tcp',
196
+
Listen => 5,
197
+
ReuseAddr => 1,
198
+
) or die "unable to allocate a port: $!";
199
+
my $port = $sock->sockport;
200
+
close $sock;
201
+
return $port;
202
+
}