perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Align auth and surface semantics with reference PDS
+396
-58
+4
-2
lib/ATProto/PDS.pm
+4
-2
lib/ATProto/PDS.pm
···
128
128
});
129
129
});
130
130
131
-
$routes->get('/_health')->to(cb => sub ($c) {
131
+
my $health = sub ($c) {
132
132
$c->render(json => {
133
133
ok => Mojo::JSON->true,
134
134
service => 'perlsky',
135
135
endpoints => scalar @{ endpoint_catalog($root) },
136
136
});
137
-
});
137
+
};
138
+
$routes->get('/_health')->to(cb => $health);
139
+
$routes->get('/xrpc/_health')->to(cb => $health);
138
140
139
141
$routes->get('/metrics')->to(cb => sub ($c) {
140
142
my $token = $c->config_value('metrics_token');
+18
-3
lib/ATProto/PDS/API/Helpers.pm
+18
-3
lib/ATProto/PDS/API/Helpers.pm
···
20
20
require_admin
21
21
subject_key
22
22
verify_account_password
23
+
verify_login_password
23
24
);
24
25
25
26
sub require_admin ($c) {
···
53
54
54
55
sub verify_account_password ($c, $account, $password) {
55
56
return 0 unless $account && defined $password;
56
-
return 1 if verify_password($password, $account->{password_salt}, $account->{password_hash});
57
+
return verify_password($password, $account->{password_salt}, $account->{password_hash}) ? 1 : 0;
58
+
}
59
+
60
+
sub verify_login_password ($c, $account, $password) {
61
+
return undef unless $account && defined $password;
62
+
return {
63
+
kind => 'account',
64
+
scope => 'access',
65
+
} if verify_account_password($c, $account, $password);
57
66
58
67
for my $app_password (@{ $c->store->list_app_passwords_by_did($account->{did}) }) {
59
68
next if defined $app_password->{revoked_at};
60
69
my ($salt_hex, $hash) = split /:/, ($app_password->{password_hash} // q()), 2;
61
70
next unless defined $salt_hex && defined $hash;
62
71
my $salt = pack('H*', $salt_hex);
63
-
return 1 if verify_password($password, $salt, $hash);
72
+
if (verify_password($password, $salt, $hash)) {
73
+
return {
74
+
kind => 'app_password',
75
+
scope => $app_password->{privileged} ? 'app_password_privileged' : 'app_password',
76
+
app_password_name => $app_password->{name},
77
+
};
78
+
}
64
79
}
65
80
66
-
return 0;
81
+
return undef;
67
82
}
68
83
69
84
sub account_view ($account) {
+2
-2
lib/ATProto/PDS/API/Repo.pm
+2
-2
lib/ATProto/PDS/API/Repo.pm
···
153
153
});
154
154
155
155
$registry->register('com.atproto.repo.importRepo', sub ($c, $endpoint) {
156
-
my (undef, $account) = require_auth($c, audience => 'access');
156
+
my (undef, $account) = require_auth($c, audience => 'access', required_scope => 'full');
157
157
assert_repo_writable($c, $account);
158
158
xrpc_error(400, 'InvalidRequest', 'Service is not accepting repo imports')
159
159
unless $c->config_value('accepting_imports', 1);
···
166
166
}
167
167
168
168
sub _require_repo_owner ($c, $repo) {
169
+
my ($claims) = require_auth($c, audience => 'access');
169
170
my $account = resolve_repo($c, $repo);
170
171
xrpc_error(404, 'RepoNotFound', 'Repository was not found') unless $account;
171
-
my ($claims) = require_auth($c, audience => 'access');
172
172
xrpc_error(401, 'AuthRequired', 'Token is not authorized for that repo') unless ($claims->{sub} // '') eq $account->{did};
173
173
assert_repo_writable($c, $account);
174
174
return $account;
+110
-24
lib/ATProto/PDS/API/Server.pm
+110
-24
lib/ATProto/PDS/API/Server.pm
···
8
8
use Exporter 'import';
9
9
use JSON::PP ();
10
10
11
-
use ATProto::PDS::API::Helpers qw(find_account invite_code_view verify_account_password);
11
+
use ATProto::PDS::API::Helpers qw(find_account invite_code_view verify_account_password verify_login_password);
12
12
use ATProto::PDS::API::Util qw(iso8601 xrpc_error);
13
13
use ATProto::PDS::Auth::JWT qw(decode_jwt encode_jwt encode_service_jwt);
14
14
use ATProto::PDS::Auth::Password qw(hash_password random_hex);
15
15
use ATProto::PDS::Identity qw(account_did account_did_doc normalize_handle service_did);
16
-
use ATProto::PDS::Moderation qw(assert_login_allowed);
16
+
use ATProto::PDS::Moderation qw(assert_login_allowed is_repo_takedown);
17
17
use ATProto::PDS::PLC qw(account_did_method create_plc_account is_plc_did refresh_plc_did_doc);
18
18
use ATProto::PDS::Repo::CAR qw(read_car);
19
19
20
20
our @EXPORT_OK = qw(register_server_handlers require_auth session_view);
21
+
22
+
my %PROTECTED_SERVICE_AUTH_METHOD = map { lc($_) => 1 } qw(
23
+
com.atproto.identity.requestPlcOperationSignature
24
+
com.atproto.identity.signPlcOperation
25
+
com.atproto.identity.updateHandle
26
+
com.atproto.server.activateAccount
27
+
com.atproto.server.confirmEmail
28
+
com.atproto.server.createAppPassword
29
+
com.atproto.server.deactivateAccount
30
+
com.atproto.server.getAccountInviteCodes
31
+
com.atproto.server.getSession
32
+
com.atproto.server.listAppPasswords
33
+
com.atproto.server.requestAccountDelete
34
+
com.atproto.server.requestEmailConfirmation
35
+
com.atproto.server.requestEmailUpdate
36
+
com.atproto.server.revokeAppPassword
37
+
com.atproto.server.updateEmail
38
+
);
21
39
22
40
sub register_server_handlers ($registry, $app) {
23
41
$registry->register('com.atproto.server.createAccount', sub ($c, $endpoint) {
···
154
172
my $body = $c->req->json || {};
155
173
my $account = find_account($c, $body->{identifier} // q());
156
174
xrpc_error(401, 'AuthRequired', 'Invalid identifier or password') unless $account;
157
-
xrpc_error(401, 'AuthRequired', 'Invalid identifier or password')
158
-
unless verify_account_password($c, $account, $body->{password} // q());
175
+
my $authn = verify_login_password($c, $account, $body->{password} // q());
176
+
xrpc_error(401, 'AuthRequired', 'Invalid identifier or password') unless $authn;
177
+
if (($authn->{kind} // q()) eq 'app_password' && is_repo_takedown($c, $account->{did})) {
178
+
xrpc_error(401, 'AuthRequired', 'Invalid identifier or password');
179
+
}
159
180
assert_login_allowed($c, $account, allow_takedown => $body->{allowTakendown});
160
-
return _issue_session($c, $account);
181
+
return _issue_session($c, $account,
182
+
kind => $authn->{kind},
183
+
scope => $authn->{scope},
184
+
session_token => $authn->{app_password_name},
185
+
);
161
186
});
162
187
163
188
$registry->register('com.atproto.server.getSession', sub ($c, $endpoint) {
···
166
191
});
167
192
168
193
$registry->register('com.atproto.server.refreshSession', sub ($c, $endpoint) {
169
-
my ($claims, $account) = require_auth($c, audience => 'refresh');
170
-
my $session = $c->store->get_session($claims->{jti});
171
-
xrpc_error(401, 'InvalidToken', 'Refresh session was not found') unless $session;
172
-
xrpc_error(401, 'ExpiredToken', 'Refresh session has already been revoked') if defined $session->{revoked_at};
194
+
my (undef, $account, $session) = require_auth($c, audience => 'refresh');
173
195
assert_login_allowed($c, $account);
174
-
$c->store->revoke_session($session->{id});
175
-
return _issue_session($c, $account);
196
+
my $rotated = $c->store->rotate_session($session->{id});
197
+
xrpc_error(401, 'ExpiredToken', 'Refresh session has already been revoked') unless $rotated;
198
+
return _session_response($c, $account, $rotated);
176
199
});
177
200
178
201
$registry->register('com.atproto.server.deleteSession', sub ($c, $endpoint) {
···
203
226
});
204
227
205
228
$registry->register('com.atproto.server.createAppPassword', sub ($c, $endpoint) {
206
-
my (undef, $account) = require_auth($c, audience => 'access');
229
+
my (undef, $account) = require_auth($c, audience => 'access', required_scope => 'full');
207
230
my $body = $c->req->json || {};
208
231
my $name = $body->{name} // q();
209
232
xrpc_error(400, 'InvalidRequest', 'App password name is required') unless length $name;
···
214
237
did => $account->{did},
215
238
name => $name,
216
239
password_hash => unpack('H*', $password_record->{salt}) . ':' . $password_record->{hash},
240
+
privileged => $body->{privileged} ? 1 : 0,
217
241
);
218
242
219
243
return {
220
244
name => $row->{name},
221
245
password => $password,
222
246
createdAt => iso8601($row->{created_at}),
223
-
privileged => $body->{privileged} ? JSON::PP::true : JSON::PP::false,
247
+
privileged => $row->{privileged} ? JSON::PP::true : JSON::PP::false,
224
248
};
225
249
});
226
250
···
233
257
+{
234
258
name => $_->{name},
235
259
createdAt => iso8601($_->{created_at}),
236
-
privileged => JSON::PP::false,
260
+
privileged => $_->{privileged} ? JSON::PP::true : JSON::PP::false,
237
261
}
238
262
} grep { !defined $_->{revoked_at} } @$rows
239
263
],
···
248
272
my $row = $c->store->get_app_password_by_name($account->{did}, $name);
249
273
xrpc_error(404, 'AppPasswordNotFound', 'No app password exists with that name') unless $row;
250
274
$c->store->revoke_app_password($row->{id});
275
+
for my $session (@{ $c->store->list_sessions_by_did($account->{did}) }) {
276
+
next unless ($session->{kind} // q()) eq 'app_password';
277
+
next unless ($session->{token} // q()) eq $name;
278
+
next if defined $session->{revoked_at};
279
+
$c->store->revoke_session($session->{id});
280
+
}
251
281
return {};
252
282
});
253
283
254
284
$registry->register('com.atproto.server.deactivateAccount', sub ($c, $endpoint) {
255
-
my (undef, $account) = require_auth($c, audience => 'access');
285
+
my (undef, $account) = require_auth($c, audience => 'access', required_scope => 'full');
256
286
$c->store->update_account($account->{did}, deactivated_at => time);
257
287
$c->append_event(
258
288
did => $account->{did},
···
267
297
});
268
298
269
299
$registry->register('com.atproto.server.activateAccount', sub ($c, $endpoint) {
270
-
my (undef, $account) = require_auth($c, audience => 'access');
300
+
my (undef, $account) = require_auth($c, audience => 'access', required_scope => 'full');
271
301
$account = $c->store->update_account($account->{did}, deactivated_at => undef);
272
302
$c->append_event(
273
303
did => $account->{did},
···
416
446
});
417
447
418
448
$registry->register('com.atproto.server.updateEmail', sub ($c, $endpoint) {
419
-
my (undef, $account) = require_auth($c, audience => 'access');
449
+
my (undef, $account) = require_auth($c, audience => 'access', required_scope => 'full');
420
450
my $body = $c->req->json || {};
421
451
if (defined $account->{email_confirmed_at}) {
422
452
xrpc_error(400, 'TokenRequired', 'A confirmation token is required to update email')
···
438
468
});
439
469
440
470
$registry->register('com.atproto.server.requestAccountDelete', sub ($c, $endpoint) {
441
-
my (undef, $account) = require_auth($c, audience => 'access');
471
+
my (undef, $account) = require_auth($c, audience => 'access', required_scope => 'full');
442
472
my $token = $c->store->create_action_token(
443
473
did => $account->{did},
444
474
email => $account->{email},
···
455
485
});
456
486
457
487
$registry->register('com.atproto.server.deleteAccount', sub ($c, $endpoint) {
458
-
my ($claims, $account) = require_auth($c, audience => 'access');
488
+
my ($claims, $account) = require_auth($c, audience => 'access', required_scope => 'full');
459
489
my $body = $c->req->json || {};
460
490
xrpc_error(401, 'AuthRequired', 'Token is not authorized for that repo')
461
491
unless ($claims->{sub} // q()) eq ($body->{did} // q()) && ($account->{did} // q()) eq ($body->{did} // q());
···
490
520
});
491
521
492
522
$registry->register('com.atproto.server.getServiceAuth', sub ($c, $endpoint) {
493
-
my (undef, $account) = require_auth($c, audience => 'access');
523
+
my ($claims, $account, $session) = require_auth($c, audience => 'access');
494
524
my $aud = $c->param('aud') // q();
495
525
xrpc_error(400, 'InvalidRequest', 'aud is required') unless length $aud;
526
+
my $lxm = $c->param('lxm') // q();
527
+
my $normalized_lxm = _normalize_lxm($lxm);
528
+
xrpc_error(400, 'InvalidRequest', 'Protected methods cannot be service-authenticated')
529
+
if length($normalized_lxm) && $PROTECTED_SERVICE_AUTH_METHOD{$normalized_lxm};
530
+
my $scope = _canonical_access_scope($claims->{scope} // $session->{scope});
531
+
if (length($normalized_lxm) && _service_auth_method_requires_privileged_access($normalized_lxm) && !_scope_allows($scope, 'privileged')) {
532
+
xrpc_error(400, 'InvalidToken', 'Bad token scope');
533
+
}
496
534
my $requested_exp = $c->param('exp');
497
535
my $now = time;
498
536
my $exp = defined($requested_exp) ? int($requested_exp) : ($now + 60);
···
505
543
iat => $now,
506
544
aud => $aud,
507
545
exp => $exp,
508
-
($c->param('lxm') ? (lxm => $c->param('lxm')) : ()),
546
+
(length($lxm) ? (lxm => $lxm) : ()),
509
547
}, $account->{private_key});
510
548
return { token => $token };
511
549
});
···
567
605
});
568
606
569
607
$registry->register('com.atproto.server.getAccountInviteCodes', sub ($c, $endpoint) {
570
-
my (undef, $account) = require_auth($c, audience => 'access');
608
+
my (undef, $account) = require_auth($c, audience => 'access', required_scope => 'full');
571
609
my $rows = $c->store->list_invite_codes_for_account($account->{did});
572
610
return {
573
611
codes => [ map { invite_code_view($c->store, $_) } @$rows ],
···
620
658
if defined($session->{expires_at}) && $session->{expires_at} < time;
621
659
xrpc_error(401, 'InvalidToken', 'Token session did not match token subject')
622
660
unless ($session->{did} // q()) eq ($claims->{sub} // q());
661
+
if ($aud eq 'access') {
662
+
my $token_scope = _canonical_access_scope($claims->{scope});
663
+
my $session_scope = _canonical_access_scope($session->{scope});
664
+
xrpc_error(401, 'InvalidToken', 'Token session scope did not match token scope')
665
+
unless $token_scope eq $session_scope;
666
+
if ($opts{required_scope} && !_scope_allows($token_scope, $opts{required_scope})) {
667
+
xrpc_error(400, 'InvalidToken', 'Bad token scope');
668
+
}
669
+
}
623
670
624
671
my $account = $c->store->get_account_by_did($claims->{sub});
625
672
xrpc_error(401, 'InvalidToken', 'Token subject no longer exists') unless $account;
···
627
674
return ($claims, $account, $session);
628
675
}
629
676
630
-
sub _issue_session ($c, $account) {
677
+
sub _issue_session ($c, $account, %opts) {
631
678
my $session = $c->store->create_session(
632
679
did => $account->{did},
680
+
kind => ($opts{kind} // q()) eq 'app_password' ? 'app_password' : 'account',
681
+
scope => _canonical_access_scope($opts{scope}),
682
+
token => $opts{session_token},
633
683
expires_at => time + (30 * 24 * 60 * 60),
634
684
);
635
685
686
+
return _session_response($c, $account, $session);
687
+
}
688
+
689
+
sub _session_response ($c, $account, $session) {
636
690
my $issuer = service_did($c->app->settings);
637
691
my $secret = $c->config_value('jwt_secret', 'perlsky-dev-secret');
638
692
my $now = time;
693
+
my $scope = _canonical_access_scope($session->{scope});
694
+
my $refresh_exp = $session->{expires_at} // ($now + (30 * 24 * 60 * 60));
639
695
640
696
my $access = encode_jwt({
641
697
iss => $issuer,
642
698
sub => $account->{did},
643
699
aud => 'access',
700
+
scope => $scope,
644
701
typ => 'access',
645
702
jti => $session->{id},
646
703
exp => $now + 3600,
···
652
709
aud => 'refresh',
653
710
typ => 'refresh',
654
711
jti => $session->{id},
655
-
exp => $now + (30 * 24 * 60 * 60),
712
+
exp => $refresh_exp,
656
713
}, $secret);
657
714
658
715
return {
···
660
717
refreshJwt => $refresh,
661
718
%{ session_view($account) },
662
719
};
720
+
}
721
+
722
+
sub _canonical_access_scope ($scope = undef) {
723
+
return 'access' unless defined $scope && length $scope;
724
+
return 'access' if $scope eq 'atproto';
725
+
return $scope;
726
+
}
727
+
728
+
sub _normalize_lxm ($lxm = q()) {
729
+
return lc($lxm // q());
730
+
}
731
+
732
+
sub _scope_allows ($scope, $required_scope) {
733
+
$scope = _canonical_access_scope($scope);
734
+
return 1 if !defined($required_scope) || !length($required_scope);
735
+
return $scope eq 'access'
736
+
if $required_scope eq 'full';
737
+
return $scope eq 'access' || $scope eq 'app_password_privileged'
738
+
if $required_scope eq 'privileged';
739
+
return $scope eq 'access' || $scope eq 'app_password' || $scope eq 'app_password_privileged'
740
+
if $required_scope eq 'standard';
741
+
return 0;
742
+
}
743
+
744
+
sub _service_auth_method_requires_privileged_access ($lxm) {
745
+
return 0 unless defined $lxm && length $lxm;
746
+
return 1 if $lxm =~ /\Achat\.bsky\./;
747
+
return 1 if $lxm eq 'com.atproto.server.createaccount';
748
+
return 0;
663
749
}
664
750
665
751
sub _require_action_token ($c, %args) {
+6
-1
lib/ATProto/PDS/API/Util.pm
+6
-1
lib/ATProto/PDS/API/Util.pm
···
10
10
use Mojo::IOLoop;
11
11
12
12
use ATProto::PDS::EventStream qw(encode_error_frame encode_info_frame);
13
+
use ATProto::PDS::Identity qw(normalize_handle);
13
14
14
15
our @EXPORT_OK = qw(
15
16
blob_ref
···
66
67
67
68
sub resolve_repo ($c, $repo) {
68
69
return undef unless defined $repo && length $repo;
69
-
return $c->store->get_account_by_handle($repo) unless $repo =~ /\Adid:/;
70
+
if ($repo !~ /\Adid:/i) {
71
+
my $normalized = normalize_handle($repo, $c->config_value('service_handle_domain', 'localhost'));
72
+
return $c->store->get_account_by_handle($repo)
73
+
|| (defined($normalized) ? $c->store->get_account_by_handle($normalized) : undef);
74
+
}
70
75
return resolve_did_account($c, $repo);
71
76
}
72
77
+86
-5
lib/ATProto/PDS/Store/SQLite.pm
+86
-5
lib/ATProto/PDS/Store/SQLite.pm
···
236
236
q{
237
237
INSERT INTO sessions (
238
238
id, did, token, kind, scope, created_at, expires_at,
239
-
revoked_at, ip, user_agent
240
-
) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
239
+
revoked_at, ip, user_agent, next_id
240
+
) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
241
241
},
242
242
undef,
243
243
$id,
244
244
$did,
245
245
$args{token},
246
-
$args{kind} // 'refresh',
246
+
$args{kind} // 'account',
247
247
$args{scope} // 'atproto',
248
248
$now,
249
249
$args{expires_at},
250
250
$args{revoked_at},
251
251
$args{ip},
252
252
$args{user_agent},
253
+
$args{next_id},
253
254
);
254
255
255
256
return $self->get_session($id);
···
291
292
);
292
293
}
293
294
295
+
sub rotate_session ($self, $id, %args) {
296
+
return observe_store_operation($self->{metrics}, 'rotate_session', sub {
297
+
my $now = $args{now} // time;
298
+
my $session_ttl = $args{session_ttl} // (30 * 24 * 60 * 60);
299
+
my $grace_ttl = $args{grace_ttl} // (2 * 60 * 60);
300
+
301
+
return $self->txn(sub ($dbh) {
302
+
my $session = $dbh->selectrow_hashref(
303
+
q{SELECT * FROM sessions WHERE id = ?},
304
+
undef,
305
+
$id,
306
+
);
307
+
return undef unless $session;
308
+
return undef if defined $session->{revoked_at};
309
+
return undef if defined($session->{expires_at}) && $session->{expires_at} < $now;
310
+
311
+
if (defined($session->{next_id}) && length($session->{next_id})) {
312
+
my $next = $dbh->selectrow_hashref(
313
+
q{SELECT * FROM sessions WHERE id = ?},
314
+
undef,
315
+
$session->{next_id},
316
+
);
317
+
return undef unless $next;
318
+
return undef if defined $next->{revoked_at};
319
+
return undef if defined($next->{expires_at}) && $next->{expires_at} < $now;
320
+
return $next;
321
+
}
322
+
323
+
my $next_id = $args{next_id} // _random_id();
324
+
my $grace_expires_at = $now + $grace_ttl;
325
+
if (defined($session->{expires_at}) && $session->{expires_at} < $grace_expires_at) {
326
+
$grace_expires_at = $session->{expires_at};
327
+
}
328
+
329
+
$dbh->do(
330
+
q{UPDATE sessions SET expires_at = ?, next_id = ? WHERE id = ?},
331
+
undef,
332
+
$grace_expires_at,
333
+
$next_id,
334
+
$session->{id},
335
+
);
336
+
337
+
$dbh->do(
338
+
q{
339
+
INSERT INTO sessions (
340
+
id, did, token, kind, scope, created_at, expires_at,
341
+
revoked_at, ip, user_agent, next_id
342
+
) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
343
+
},
344
+
undef,
345
+
$next_id,
346
+
$session->{did},
347
+
$session->{token},
348
+
$session->{kind},
349
+
$session->{scope},
350
+
$now,
351
+
$now + $session_ttl,
352
+
undef,
353
+
$session->{ip},
354
+
$session->{user_agent},
355
+
undef,
356
+
);
357
+
358
+
return $dbh->selectrow_hashref(
359
+
q{SELECT * FROM sessions WHERE id = ?},
360
+
undef,
361
+
$next_id,
362
+
);
363
+
});
364
+
});
365
+
}
366
+
294
367
sub create_app_password ($self, %args) {
295
368
my $did = $args{did} // die 'did is required';
296
369
my $id = $args{id} // _random_id();
···
299
372
$self->dbh->do(
300
373
q{
301
374
INSERT INTO app_passwords (
302
-
id, did, name, password_hash, created_at, revoked_at
303
-
) VALUES (?, ?, ?, ?, ?, ?)
375
+
id, did, name, password_hash, privileged, created_at, revoked_at
376
+
) VALUES (?, ?, ?, ?, ?, ?, ?)
304
377
},
305
378
undef,
306
379
$id,
307
380
$did,
308
381
$args{name} // 'app-password',
309
382
$args{password_hash},
383
+
$args{privileged} ? 1 : 0,
310
384
$now,
311
385
$args{revoked_at},
312
386
);
···
1931
2005
FROM blobs
1932
2006
WHERE did IS NOT NULL
1933
2007
},
2008
+
],
2009
+
},
2010
+
{
2011
+
version => 8,
2012
+
statements => [
2013
+
q{ALTER TABLE sessions ADD COLUMN next_id TEXT},
2014
+
q{ALTER TABLE app_passwords ADD COLUMN privileged INTEGER NOT NULL DEFAULT 0},
1934
2015
],
1935
2016
},
1936
2017
);
+31
-8
script/differential-validate
+31
-8
script/differential-validate
···
11
11
use File::Temp qw(tempdir);
12
12
use IO::Socket::INET;
13
13
use JSON::PP ();
14
-
use MIME::Base64 qw(encode_base64);
14
+
use MIME::Base64 qw(decode_base64 encode_base64);
15
15
use POSIX qw(WNOHANG);
16
16
use Time::HiRes qw(sleep time);
17
17
···
117
117
open my $fh, '<', $path or return q();
118
118
local $/;
119
119
return <$fh> // q();
120
+
}
121
+
122
+
sub b64url_decode ($text) {
123
+
my $copy = $text // q();
124
+
$copy =~ tr/-_/+\//;
125
+
my $pad = length($copy) % 4;
126
+
$copy .= '=' x (4 - $pad) if $pad;
127
+
return decode_base64($copy);
128
+
}
129
+
130
+
sub jwt_claims ($jwt) {
131
+
my (undef, $claims_b64, undef) = split /\./, ($jwt // q()), 3;
132
+
return {} unless defined $claims_b64 && length $claims_b64;
133
+
return decode_json(b64url_decode($claims_b64));
120
134
}
121
135
122
136
sub wait_for_ready_file ($name, $path, $timeout = 30) {
···
685
699
$perl_log,
686
700
);
687
701
688
-
wait_for_http_ok('perlsky', "http://127.0.0.1:$perl_port/_health");
702
+
wait_for_http_ok('perlsky', "http://127.0.0.1:$perl_port/xrpc/_health");
689
703
pass("started perlsky at http://127.0.0.1:$perl_port");
690
704
691
705
my %server = (
···
814
828
my $json = $res->json || {};
815
829
my $old_access = $server{$name}{access};
816
830
my $old_refresh = $server{$name}{refresh};
831
+
my $old_refresh_claims = jwt_claims($old_refresh);
817
832
$server{$name}{access} = $json->{accessJwt};
818
833
$server{$name}{refresh} = $json->{refreshJwt};
834
+
my $new_refresh_claims = jwt_claims($server{$name}{refresh});
819
835
820
836
my $old_access_res = get_json(
821
837
$server{$name}{origin},
···
834
850
undef,
835
851
auth_header($server{$name}{access}),
836
852
);
853
+
my $old_refresh_json = $old_refresh_res->json || {};
854
+
my $reused_refresh_claims = jwt_claims($old_refresh_json->{refreshJwt});
837
855
838
856
$server{$name}{refresh_rotation} = {
839
-
has_access_jwt => length($json->{accessJwt} // q()) ? 1 : 0,
840
-
has_refresh_jwt => length($json->{refreshJwt} // q()) ? 1 : 0,
841
-
access_rotated => (($json->{accessJwt} // q()) ne $old_access) ? 1 : 0,
842
-
refresh_rotated => (($json->{refreshJwt} // q()) ne $old_refresh) ? 1 : 0,
843
-
new_access_works => $new_access_res->is_success ? 1 : 0,
857
+
has_access_jwt => length($json->{accessJwt} // q()) ? 1 : 0,
858
+
has_refresh_jwt => length($json->{refreshJwt} // q()) ? 1 : 0,
859
+
refresh_rotated => (($new_refresh_claims->{jti} // q()) ne ($old_refresh_claims->{jti} // q())) ? 1 : 0,
860
+
old_access_works => $old_access_res->is_success ? 1 : 0,
861
+
old_refresh_works => $old_refresh_res->is_success ? 1 : 0,
862
+
reused_refresh_matches => $old_refresh_res->is_success
863
+
&& (($reused_refresh_claims->{jti} // q()) eq ($new_refresh_claims->{jti} // q()))
864
+
? 1
865
+
: 0,
866
+
new_access_works => $new_access_res->is_success ? 1 : 0,
844
867
};
845
868
}
846
869
847
870
check(
848
871
same_hash($server{reference}{refresh_rotation}, $server{perlsky}{refresh_rotation}),
849
-
'refreshSession token rotation matches the official reference PDS semantics',
872
+
'refreshSession grace and successor semantics match the official reference PDS',
850
873
);
851
874
852
875
if ($diff_account_did_method eq 'did:plc') {
+11
-3
t/api-util.t
+11
-3
t/api-util.t
···
46
46
package ApiUtilTestContext;
47
47
48
48
sub new {
49
-
my ($class, $store) = @_;
50
-
return bless { store => $store }, $class;
49
+
my ($class, $store, %args) = @_;
50
+
return bless { store => $store, %args }, $class;
51
51
}
52
52
53
53
sub store {
54
54
my ($self) = @_;
55
55
return $self->{store};
56
+
}
57
+
58
+
sub config_value {
59
+
my ($self, $key, $default) = @_;
60
+
return exists $self->{config}{$key} ? $self->{config}{$key} : $default;
56
61
}
57
62
}
58
63
···
74
79
],
75
80
);
76
81
77
-
my $c = ApiUtilTestContext->new($store);
82
+
my $c = ApiUtilTestContext->new($store, config => {
83
+
service_handle_domain => 'test',
84
+
});
78
85
79
86
is(resolve_repo($c, 'alice.test')->{did}, 'did:plc:alice', 'resolve_repo finds handles directly');
87
+
is(resolve_repo($c, 'Alice.Test')->{did}, 'did:plc:alice', 'resolve_repo normalizes mixed-case handles');
80
88
is(resolve_repo($c, 'did:plc:alice')->{handle}, 'alice.test', 'resolve_repo finds plain DIDs directly');
81
89
is(resolve_did_account($c, 'did%3Aplc%3Aalice')->{handle}, 'alice.test', 'resolve_did_account accepts percent-encoded DIDs');
82
90
is(resolve_repo($c, undef), undef, 'resolve_repo returns undef for empty input');
+15
-3
t/app-routes.t
+15
-3
t/app-routes.t
···
34
34
->json_is('/service' => 'perlsky')
35
35
->json_has('/ok');
36
36
37
+
$t->get_ok('/xrpc/_health')
38
+
->status_is(200)
39
+
->json_is('/service' => 'perlsky')
40
+
->json_has('/ok');
41
+
37
42
$t->get_ok('/xrpc/com.atproto.server.describeServer')
38
43
->status_is(200)
39
44
->json_is('/availableUserDomains/0' => 'localhost')
···
69
74
$t->get_ok('/_allow-cert?domain=example.com')
70
75
->status_is(403);
71
76
72
-
$t->post_ok('/xrpc/com.atproto.repo.createRecord' => json => {})
73
-
->status_is(404)
74
-
->json_is('/error' => 'RepoNotFound');
77
+
$t->post_ok('/xrpc/com.atproto.repo.createRecord' => json => {
78
+
repo => $routeprobe_did,
79
+
collection => 'app.bsky.feed.post',
80
+
record => {
81
+
'$type' => 'app.bsky.feed.post',
82
+
text => 'auth required',
83
+
createdAt => '2026-03-10T00:00:00Z',
84
+
},
85
+
})->status_is(401)
86
+
->json_is('/error' => 'AuthRequired');
75
87
76
88
$t->websocket_ok('/xrpc/com.atproto.sync.subscribeRepos')
77
89
->finish_ok;
+4
t/app.t
+4
t/app.t
+3
-2
t/pds_smoke.t
+3
-2
t/pds_smoke.t
···
63
63
repo => $did,
64
64
collection => 'app.bsky.feed.post',
65
65
record => {
66
-
'$type' => 'app.bsky.feed.post',
67
-
text => 'hello from perl',
66
+
'$type' => 'app.bsky.feed.post',
67
+
text => 'hello from perl',
68
+
createdAt => '2026-03-10T00:00:00Z',
68
69
},
69
70
})->status_is(200)
70
71
->json_has('/uri')
+4
t/repo-api.t
+4
t/repo-api.t
···
94
94
->status_is(200)
95
95
->json_is('/records/0/value/text' => 'hello from updated perl');
96
96
97
+
$t->get_ok('/xrpc/com.atproto.repo.listRecords?repo=Repo-Owner.Localhost&collection=app.bsky.feed.post')
98
+
->status_is(200)
99
+
->json_is('/records/0/value/text' => 'hello from updated perl');
100
+
97
101
$t->get_ok("/xrpc/com.atproto.sync.getLatestCommit?did=$did")
98
102
->status_is(200)
99
103
->json_like('/cid' => qr/\Ab/)
+95
-5
t/server-auth.t
+95
-5
t/server-auth.t
···
79
79
80
80
my $app_password = $t->tx->res->json->{password};
81
81
82
+
$t->post_ok('/xrpc/com.atproto.server.createAppPassword' => { Authorization => "Bearer $access" } => json => {
83
+
name => 'desktop',
84
+
privileged => JSON::PP::true,
85
+
})->status_is(200)
86
+
->json_is('/name' => 'desktop')
87
+
->json_is('/privileged' => JSON::PP::true)
88
+
->json_has('/password');
89
+
90
+
my $privileged_app_password = $t->tx->res->json->{password};
91
+
82
92
$t->get_ok('/xrpc/com.atproto.server.listAppPasswords' => { Authorization => "Bearer $access" })
93
+
->status_is(200);
94
+
95
+
my %listed_password = map { $_->{name} => $_ } @{ $t->tx->res->json->{passwords} || [] };
96
+
is($listed_password{phone}{privileged}, 0, 'standard app password is listed as non-privileged');
97
+
is($listed_password{desktop}{privileged}, 1, 'privileged app password is listed as privileged');
98
+
99
+
$t->post_ok('/xrpc/com.atproto.server.createSession' => json => {
100
+
identifier => 'alice.localhost',
101
+
password => $app_password,
102
+
})->status_is(200)
103
+
->json_is('/did' => $did);
104
+
105
+
my $app_session = $t->tx->res->json;
106
+
my (undef, $app_claims_b64, undef) = split /\./, $app_session->{accessJwt}, 3;
107
+
my $app_claims = decode_json(_b64url_decode($app_claims_b64));
108
+
is($app_claims->{scope}, 'app_password', 'app password login issues an app password-scoped access token');
109
+
110
+
$t->post_ok('/xrpc/com.atproto.server.createSession' => json => {
111
+
identifier => 'alice.localhost',
112
+
password => $privileged_app_password,
113
+
})->status_is(200)
114
+
->json_is('/did' => $did);
115
+
116
+
my $privileged_app_session = $t->tx->res->json;
117
+
is(
118
+
_jwt_claims($privileged_app_session->{accessJwt})->{scope},
119
+
'app_password_privileged',
120
+
'privileged app password login preserves privileged scope',
121
+
);
122
+
123
+
$t->get_ok('/xrpc/com.atproto.server.getSession' => { Authorization => "Bearer $app_session->{accessJwt}" })
83
124
->status_is(200)
84
-
->json_is('/passwords/0/name' => 'phone');
125
+
->json_is('/did' => $did);
126
+
127
+
$t->get_ok('/xrpc/com.atproto.server.getServiceAuth?aud=did:web:api.bsky.app&lxm=com.atproto.server.createaccount' => {
128
+
Authorization => "Bearer $app_session->{accessJwt}",
129
+
})->status_is(400)
130
+
->json_is('/error' => 'InvalidToken');
131
+
132
+
$t->get_ok('/xrpc/com.atproto.server.getServiceAuth?aud=did:web:api.bsky.app&lxm=com.atproto.server.createaccount' => {
133
+
Authorization => "Bearer $privileged_app_session->{accessJwt}",
134
+
})->status_is(200)
135
+
->json_has('/token');
136
+
137
+
$t->post_ok('/xrpc/com.atproto.server.createAppPassword' => { Authorization => "Bearer $app_session->{accessJwt}" } => json => {
138
+
name => 'nested',
139
+
})->status_is(400)
140
+
->json_is('/error' => 'InvalidToken');
141
+
142
+
$t->get_ok('/xrpc/com.atproto.server.getAccountInviteCodes' => { Authorization => "Bearer $app_session->{accessJwt}" })
143
+
->status_is(400)
144
+
->json_is('/error' => 'InvalidToken');
85
145
86
146
$t->post_ok('/xrpc/com.atproto.server.revokeAppPassword' => { Authorization => "Bearer $access" } => json => {
87
147
name => 'phone',
88
148
})->status_is(200);
89
149
150
+
$t->post_ok('/xrpc/com.atproto.server.refreshSession' => { Authorization => "Bearer $app_session->{refreshJwt}" } => json => {})
151
+
->status_is(401)
152
+
->json_is('/error' => 'ExpiredToken');
153
+
90
154
$t->get_ok('/xrpc/com.atproto.server.listAppPasswords' => { Authorization => "Bearer $access" })
91
-
->status_is(200)
92
-
->json_is('/passwords' => []);
155
+
->status_is(200);
156
+
157
+
my %remaining_password = map { $_->{name} => $_ } @{ $t->tx->res->json->{passwords} || [] };
158
+
ok(!exists $remaining_password{phone}, 'revoked app password is removed from listing');
159
+
is($remaining_password{desktop}{privileged}, 1, 'remaining privileged app password stays privileged');
93
160
94
161
$t->post_ok('/xrpc/com.atproto.server.refreshSession' => { Authorization => "Bearer $refresh" } => json => {})
95
162
->status_is(200)
···
99
166
my $refreshed = $t->tx->res->json;
100
167
101
168
$t->get_ok('/xrpc/com.atproto.server.getSession' => { Authorization => "Bearer $access" })
102
-
->status_is(401)
103
-
->json_is('/error' => 'ExpiredToken');
169
+
->status_is(200)
170
+
->json_is('/did' => $did);
171
+
172
+
$t->post_ok('/xrpc/com.atproto.server.refreshSession' => { Authorization => "Bearer $refresh" } => json => {})
173
+
->status_is(200)
174
+
->json_has('/refreshJwt');
175
+
176
+
my $reused_refresh = $t->tx->res->json;
177
+
is(
178
+
_jwt_claims($reused_refresh->{refreshJwt})->{jti},
179
+
_jwt_claims($refreshed->{refreshJwt})->{jti},
180
+
'refresh reuse during grace period returns the same successor refresh session',
181
+
);
104
182
105
183
$t->get_ok('/xrpc/com.atproto.server.getSession' => { Authorization => "Bearer $refresh" })
106
184
->status_is(401)
···
129
207
130
208
my $replacement_access = $t->tx->res->json->{accessJwt};
131
209
210
+
$t->get_ok('/xrpc/com.atproto.server.getServiceAuth?aud=did:web:api.bsky.app&lxm=com.atproto.server.createAppPassword' => {
211
+
Authorization => "Bearer $replacement_access",
212
+
})->status_is(400)
213
+
->json_is('/error' => 'InvalidRequest');
214
+
132
215
$t->get_ok('/xrpc/com.atproto.server.getServiceAuth?aud=did:web:api.bsky.app&lxm=app.bsky.actor.getPreferences' => {
133
216
Authorization => "Bearer $replacement_access",
134
217
})->status_is(200)
···
160
243
$copy .= '=' x (4 - $pad) if $pad;
161
244
return decode_base64($copy);
162
245
}
246
+
247
+
sub _jwt_claims {
248
+
my ($jwt) = @_;
249
+
my (undef, $claims_b64, undef) = split /\./, ($jwt // q()), 3;
250
+
return {} unless defined $claims_b64 && length $claims_b64;
251
+
return decode_json(_b64url_decode($claims_b64));
252
+
}
+7
t/store-sqlite.t
+7
t/store-sqlite.t
···
59
59
is($store->get_session('sess-1')->{did}, $account->{did}, 'session is stored');
60
60
ok(@{ $store->list_sessions_by_did($account->{did}) } == 1, 'sessions list by did');
61
61
62
+
my $rotated = $store->rotate_session('sess-1', now => 1_700_000_000);
63
+
is($rotated->{did}, $account->{did}, 'session rotation keeps the owner did');
64
+
is($store->get_session('sess-1')->{next_id}, $rotated->{id}, 'session rotation stores the successor id');
65
+
is($store->rotate_session('sess-1', now => 1_700_000_001)->{id}, $rotated->{id}, 'session rotation reuses the successor during grace');
66
+
62
67
$store->create_app_password(
63
68
id => 'app-1',
64
69
did => $account->{did},
65
70
name => 'phone',
66
71
password_hash => 'sha256:def',
72
+
privileged => 1,
67
73
);
68
74
is($store->list_app_passwords_by_did($account->{did})->[0]{name}, 'phone', 'app password is stored');
75
+
is($store->list_app_passwords_by_did($account->{did})->[0]{privileged}, 1, 'app password privilege flag is stored');
69
76
70
77
$store->put_blob(
71
78
cid => 'bafkreigh2akiscaildc',