perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Align email account-management semantics with reference
+291
-5
+1
-1
docs/DEPLOYMENT.md
+1
-1
docs/DEPLOYMENT.md
···
291
291
292
292
If you are running without outbound email during smoke/dev work, the safer testing knobs are:
293
293
294
-
- `testing_auto_confirm_email`: mark new-account emails as confirmed immediately.
294
+
- `testing_auto_confirm_email`: explicitly opt into marking new-account emails as confirmed immediately.
295
295
- `testing_allow_unauthenticated_email_confirm`: allow `com.atproto.server.confirmEmail` without a bearer token for local testing only.
296
296
297
297
Both are intended for testing environments. Leave them off in normal deployments.
+2
docs/TEST_AUDIT.md
+2
docs/TEST_AUDIT.md
···
49
49
- Deactivated accounts should still be able to establish and refresh sessions, but those responses must stay marked `active=false` with `status=deactivated`.
50
50
- Local `app.bsky.*` emulation must be conservative: only synthesize owner-local feed/thread data when the PDS can answer authoritatively, and proxy upstream instead of inventing partial global state.
51
51
- Account email handling needs consistent normalization on write, lookup, session creation, and confirmation checks; treating email case inconsistently leaves both tests and user-facing auth behavior brittle.
52
+
- Email confirmation, email update, and account-delete action-token flows now match the official runtime on the client-visible surface, including default non-auto-confirm account creation, case-insensitive confirmation matching, `confirmation token required`, and `Token is expired` error text.
52
53
- `com.atproto.server.requestEmailConfirmation`, `requestEmailUpdate`, and `requestAccountDelete` should reject accounts with no stored email using the official `400 InvalidRequest` / `account does not have an email address` shape, and `updateEmail` should reject unsupported syntax with the official `This email address is not supported, please use a different email.` message.
53
54
- perlsky intentionally still allows test-friendly no-email local accounts, but once an email is supplied `com.atproto.server.createAccount` now follows the same unsupported-syntax rejection shape as `updateEmail` and the official runtime.
54
55
- `com.atproto.server.createAccount` must not turn duplicate-email requests into a `500`; it now follows the official client-visible `400 InvalidRequest` / `Email already taken: ...` shape instead.
56
+
- The executable differential harness now covers the full email/account-delete lifecycle against the official runtime. No-email local account creation remains a documented local extension and is intentionally excluded from that executable comparison.
55
57
- Local handle-conflict flows now use the reference runtime’s client-visible `400 InvalidRequest` / `Handle already taken: ...` shape on `createAccount`, `com.atproto.identity.updateHandle`, and `com.atproto.admin.updateAccountHandle`, instead of the older local `HandleNotAvailable` variant.
56
58
- The executable differential harness now proves that handle-conflict shape directly for both user and admin handle-update flows, not just local regression tests.
57
59
- `com.atproto.server.createSession` invalid-credential failures now use the reference runtime’s `401 AuthenticationRequired` shape instead of the older local `AuthRequired` variant.
+4
-4
lib/ATProto/PDS/API/Server.pm
+4
-4
lib/ATProto/PDS/API/Server.pm
···
531
531
my $account = $c->store->get_account_by_did($token->{did});
532
532
xrpc_error(404, 'AccountNotFound', 'Account was not found') unless $account;
533
533
my $email = _normalize_email($body->{email}) // q();
534
-
xrpc_error(400, 'InvalidEmail', 'Token was not issued for that email')
534
+
xrpc_error(400, 'InvalidEmail', 'invalid email')
535
535
unless length($email)
536
536
&& ($token->{email} // q()) eq $email
537
537
&& ($account->{email} // q()) eq $email;
···
582
582
xrpc_error(400, 'InvalidRequest', 'This email address is not supported, please use a different email.')
583
583
unless defined $email;
584
584
if (defined $account->{email_confirmed_at}) {
585
-
xrpc_error(400, 'TokenRequired', 'A confirmation token is required to update email')
585
+
xrpc_error(400, 'TokenRequired', 'confirmation token required')
586
586
unless defined($body->{token}) && length($body->{token});
587
587
my $token = _require_action_token($c,
588
588
token => $body->{token},
···
1177
1177
1178
1178
sub _initial_email_confirmed_at ($c, $email) {
1179
1179
return undef unless defined $email && length $email;
1180
-
return undef unless $c->config_value('testing_auto_confirm_email', 1);
1180
+
return undef unless $c->config_value('testing_auto_confirm_email', 0);
1181
1181
return time;
1182
1182
}
1183
1183
···
1194
1194
xrpc_error(400, 'InvalidToken', 'Token purpose did not match')
1195
1195
unless ($token->{purpose} // q()) eq ($args{purpose} // q());
1196
1196
xrpc_error(400, 'InvalidToken', 'Token has already been used') if defined $token->{consumed_at};
1197
-
xrpc_error(400, 'ExpiredToken', 'Token has expired')
1197
+
xrpc_error(400, 'ExpiredToken', 'Token is expired')
1198
1198
if defined($token->{expires_at}) && $token->{expires_at} < time;
1199
1199
return $token;
1200
1200
}
+283
script/differential-validate
+283
script/differential-validate
···
5
5
no warnings 'experimental::signatures';
6
6
7
7
use Config ();
8
+
use DBI ();
8
9
use File::Basename qw(dirname);
9
10
use File::Path qw(make_path);
10
11
use File::Spec;
···
367
368
die "timed out waiting for $name crawler requests at $origin\n";
368
369
}
369
370
371
+
sub sqlite_dbh ($path) {
372
+
return DBI->connect(
373
+
"dbi:SQLite:dbname=$path",
374
+
q(),
375
+
q(),
376
+
{
377
+
RaiseError => 1,
378
+
PrintError => 0,
379
+
AutoCommit => 1,
380
+
},
381
+
);
382
+
}
383
+
384
+
sub latest_email_token_record ($server, $purpose_key, $did) {
385
+
my $purpose = $server->{token_purpose}{$purpose_key} // die "unknown token purpose $purpose_key\n";
386
+
my $dbh = sqlite_dbh($server->{db_path});
387
+
my ($sql, @bind);
388
+
if (($server->{token_backend} // q()) eq 'reference') {
389
+
$sql = q{
390
+
SELECT did, purpose, token, requestedAt
391
+
FROM email_token
392
+
WHERE did = ? AND purpose = ?
393
+
ORDER BY requestedAt DESC
394
+
LIMIT 1
395
+
};
396
+
@bind = ($did, $purpose);
397
+
} else {
398
+
$sql = q{
399
+
SELECT did, purpose, token, email, created_at, expires_at, consumed_at
400
+
FROM action_tokens
401
+
WHERE did = ? AND purpose = ?
402
+
ORDER BY rowid DESC
403
+
LIMIT 1
404
+
};
405
+
@bind = ($did, $purpose);
406
+
}
407
+
my $row = $dbh->selectrow_hashref($sql, undef, @bind);
408
+
$dbh->disconnect;
409
+
return $row;
410
+
}
411
+
412
+
sub expire_email_token_record ($server, $purpose_key, $did) {
413
+
my $purpose = $server->{token_purpose}{$purpose_key} // die "unknown token purpose $purpose_key\n";
414
+
my $dbh = sqlite_dbh($server->{db_path});
415
+
if (($server->{token_backend} // q()) eq 'reference') {
416
+
$dbh->do(
417
+
q{UPDATE email_token SET requestedAt = ? WHERE did = ? AND purpose = ?},
418
+
undef,
419
+
'2000-01-01T00:00:00.000Z',
420
+
$did,
421
+
$purpose,
422
+
);
423
+
} else {
424
+
$dbh->do(
425
+
q{UPDATE action_tokens SET expires_at = ? WHERE did = ? AND purpose = ? AND consumed_at IS NULL},
426
+
undef,
427
+
1,
428
+
$did,
429
+
$purpose,
430
+
);
431
+
}
432
+
$dbh->disconnect;
433
+
return;
434
+
}
435
+
370
436
note('Preparing official reference runtime');
371
437
setup_reference_runtime();
372
438
···
505
571
email => 'alice-ref@test.com',
506
572
admin_password => 'reference-admin-secret',
507
573
crawler_origin => $reference_crawler_info->{origin},
574
+
db_path => File::Spec->catfile($reference_data, 'data', 'account.sqlite'),
575
+
token_backend => 'reference',
576
+
token_purpose => {
577
+
confirm => 'confirm_email',
578
+
update => 'update_email',
579
+
delete => 'delete_account',
580
+
},
508
581
},
509
582
perlsky => {
510
583
origin => "http://127.0.0.1:$perl_port",
···
512
585
email => 'alice-perl@test.com',
513
586
admin_password => 'perlsky-admin-secret',
514
587
crawler_origin => $perlsky_crawler_info->{origin},
588
+
db_path => File::Spec->catfile($tmp, 'perlsky.sqlite'),
589
+
token_backend => 'perlsky',
590
+
token_purpose => {
591
+
confirm => 'email_confirm',
592
+
update => 'email_update',
593
+
delete => 'account_delete',
594
+
},
515
595
},
516
596
);
517
597
···
2335
2415
fail_check('admin account-management semantics match the official reference PDS');
2336
2416
} else {
2337
2417
pass('admin account-management semantics match the official reference PDS');
2418
+
}
2419
+
2420
+
note('Comparing email and account-delete semantics');
2421
+
for my $name (sort keys %server) {
2422
+
my $flow_handle = $name eq 'reference' ? 'ef-ref.test' : 'ef-perl.test';
2423
+
my $flow_email = "emailflow-$name\@test.com";
2424
+
my $updated_email = "updated-$name\@test.com";
2425
+
2426
+
my $flow_create = post_json($server{$name}{origin}, 'com.atproto.server.createAccount', {
2427
+
handle => $flow_handle,
2428
+
email => $flow_email,
2429
+
password => 'hunter22',
2430
+
});
2431
+
check($flow_create->is_success, "$name createAccount succeeds for email lifecycle audit");
2432
+
next unless $flow_create->is_success;
2433
+
2434
+
my $flow_json = $flow_create->json || {};
2435
+
my $flow_did = $flow_json->{did};
2436
+
my $flow_access = $flow_json->{accessJwt};
2437
+
2438
+
my $initial_update = post_empty(
2439
+
$server{$name}{origin},
2440
+
'com.atproto.server.requestEmailUpdate',
2441
+
auth_header($flow_access),
2442
+
);
2443
+
my $request_confirm = post_empty(
2444
+
$server{$name}{origin},
2445
+
'com.atproto.server.requestEmailConfirmation',
2446
+
auth_header($flow_access),
2447
+
);
2448
+
my $confirm_token = latest_email_token_record($server{$name}, 'confirm', $flow_did);
2449
+
2450
+
my $wrong_confirm = post_json(
2451
+
$server{$name}{origin},
2452
+
'com.atproto.server.confirmEmail',
2453
+
{
2454
+
email => "wrong-$name\@test.com",
2455
+
token => $confirm_token->{token},
2456
+
},
2457
+
auth_header($flow_access),
2458
+
);
2459
+
my $confirm_ok = post_json(
2460
+
$server{$name}{origin},
2461
+
'com.atproto.server.confirmEmail',
2462
+
{
2463
+
email => uc $flow_email,
2464
+
token => $confirm_token->{token},
2465
+
},
2466
+
auth_header($flow_access),
2467
+
);
2468
+
my $session_after_confirm = get_json(
2469
+
$server{$name}{origin},
2470
+
'com.atproto.server.getSession',
2471
+
undef,
2472
+
auth_header($flow_access),
2473
+
);
2474
+
2475
+
my $confirmed_update = post_empty(
2476
+
$server{$name}{origin},
2477
+
'com.atproto.server.requestEmailUpdate',
2478
+
auth_header($flow_access),
2479
+
);
2480
+
my $update_token = latest_email_token_record($server{$name}, 'update', $flow_did);
2481
+
my $missing_update_token = post_json(
2482
+
$server{$name}{origin},
2483
+
'com.atproto.server.updateEmail',
2484
+
{ email => $updated_email },
2485
+
auth_header($flow_access),
2486
+
);
2487
+
2488
+
expire_email_token_record($server{$name}, 'update', $flow_did);
2489
+
my $expired_update = post_json(
2490
+
$server{$name}{origin},
2491
+
'com.atproto.server.updateEmail',
2492
+
{
2493
+
email => $updated_email,
2494
+
token => $update_token->{token},
2495
+
},
2496
+
auth_header($flow_access),
2497
+
);
2498
+
2499
+
my $renew_update = post_empty(
2500
+
$server{$name}{origin},
2501
+
'com.atproto.server.requestEmailUpdate',
2502
+
auth_header($flow_access),
2503
+
);
2504
+
my $fresh_update_token = latest_email_token_record($server{$name}, 'update', $flow_did);
2505
+
my $update_ok = post_json(
2506
+
$server{$name}{origin},
2507
+
'com.atproto.server.updateEmail',
2508
+
{
2509
+
email => $updated_email,
2510
+
token => $fresh_update_token->{token},
2511
+
},
2512
+
auth_header($flow_access),
2513
+
);
2514
+
my $session_after_update = get_json(
2515
+
$server{$name}{origin},
2516
+
'com.atproto.server.getSession',
2517
+
undef,
2518
+
auth_header($flow_access),
2519
+
);
2520
+
2521
+
my $request_delete = post_empty(
2522
+
$server{$name}{origin},
2523
+
'com.atproto.server.requestAccountDelete',
2524
+
auth_header($flow_access),
2525
+
);
2526
+
my $delete_token = latest_email_token_record($server{$name}, 'delete', $flow_did);
2527
+
2528
+
expire_email_token_record($server{$name}, 'delete', $flow_did);
2529
+
my $expired_delete = post_json(
2530
+
$server{$name}{origin},
2531
+
'com.atproto.server.deleteAccount',
2532
+
{
2533
+
did => $flow_did,
2534
+
password => 'hunter22',
2535
+
token => $delete_token->{token},
2536
+
},
2537
+
);
2538
+
2539
+
my $renew_delete = post_empty(
2540
+
$server{$name}{origin},
2541
+
'com.atproto.server.requestAccountDelete',
2542
+
auth_header($flow_access),
2543
+
);
2544
+
my $fresh_delete_token = latest_email_token_record($server{$name}, 'delete', $flow_did);
2545
+
my $delete_ok = post_json(
2546
+
$server{$name}{origin},
2547
+
'com.atproto.server.deleteAccount',
2548
+
{
2549
+
did => $flow_did,
2550
+
password => 'hunter22',
2551
+
token => $fresh_delete_token->{token},
2552
+
},
2553
+
);
2554
+
my $post_delete_login = post_json($server{$name}{origin}, 'com.atproto.server.createSession', {
2555
+
identifier => $flow_handle,
2556
+
password => 'hunter22',
2557
+
});
2558
+
2559
+
$server{$name}{email_account_management} = {
2560
+
confirm => {
2561
+
initial_update => {
2562
+
status => $initial_update->code // 0,
2563
+
token_required => (($initial_update->json || {})->{tokenRequired} ? 1 : 0),
2564
+
},
2565
+
request_status => $request_confirm->code // 0,
2566
+
token_present => $confirm_token && length($confirm_token->{token} // q()) ? 1 : 0,
2567
+
wrong_email_error => {
2568
+
status => $wrong_confirm->code // 0,
2569
+
error => ($wrong_confirm->json || {})->{error},
2570
+
message => ($wrong_confirm->json || {})->{message},
2571
+
},
2572
+
confirm_status => $confirm_ok->code // 0,
2573
+
session_confirmed => ($session_after_confirm->json || {})->{emailConfirmed} ? 1 : 0,
2574
+
},
2575
+
update => {
2576
+
request_status => $confirmed_update->code // 0,
2577
+
token_required => (($confirmed_update->json || {})->{tokenRequired} ? 1 : 0),
2578
+
token_present => $update_token && length($update_token->{token} // q()) ? 1 : 0,
2579
+
missing_token_error => {
2580
+
status => $missing_update_token->code // 0,
2581
+
error => ($missing_update_token->json || {})->{error},
2582
+
message => ($missing_update_token->json || {})->{message},
2583
+
},
2584
+
expired_token_error => {
2585
+
status => $expired_update->code // 0,
2586
+
error => ($expired_update->json || {})->{error},
2587
+
message => ($expired_update->json || {})->{message},
2588
+
},
2589
+
renew_status => $renew_update->code // 0,
2590
+
fresh_token_present => $fresh_update_token && length($fresh_update_token->{token} // q()) ? 1 : 0,
2591
+
update_status => $update_ok->code // 0,
2592
+
session_email_matches => (($session_after_update->json || {})->{email} // q()) eq $updated_email ? 1 : 0,
2593
+
session_confirmed => ($session_after_update->json || {})->{emailConfirmed} ? 1 : 0,
2594
+
},
2595
+
delete => {
2596
+
request_status => $request_delete->code // 0,
2597
+
token_present => $delete_token && length($delete_token->{token} // q()) ? 1 : 0,
2598
+
expired_token_error => {
2599
+
status => $expired_delete->code // 0,
2600
+
error => ($expired_delete->json || {})->{error},
2601
+
message => ($expired_delete->json || {})->{message},
2602
+
},
2603
+
renew_status => $renew_delete->code // 0,
2604
+
fresh_token_present => $fresh_delete_token && length($fresh_delete_token->{token} // q()) ? 1 : 0,
2605
+
delete_result => {
2606
+
status => $delete_ok->code // 0,
2607
+
error => ($delete_ok->json || {})->{error},
2608
+
message => ($delete_ok->json || {})->{message},
2609
+
},
2610
+
post_delete_login => normalize_xrpc_error($post_delete_login),
2611
+
},
2612
+
};
2613
+
}
2614
+
2615
+
if (!same_hash($server{reference}{email_account_management}, $server{perlsky}{email_account_management})) {
2616
+
note('reference email account management: ' . encode_json($server{reference}{email_account_management}));
2617
+
note('perlsky email account management: ' . encode_json($server{perlsky}{email_account_management}));
2618
+
fail_check('email and account-delete semantics match the official reference PDS');
2619
+
} else {
2620
+
pass('email and account-delete semantics match the official reference PDS');
2338
2621
}
2339
2622
2340
2623
if ($failed) {