perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Add browser CORS support for XRPC endpoints
+117
+1
README.md
+1
README.md
···
35
35
- If `invite_code_required` is enabled, public signup is disabled until a valid invite code is supplied.
36
36
- `script/perlsky-admin create-invite` can mint invite codes locally on the server without needing an existing user session.
37
37
- The invite-only bootstrap flow is documented with copy-pasteable commands in `docs/DEPLOYMENT.md`.
38
+
- Browser clients such as `bsky.app` can talk to `perlsky` directly because XRPC and DID-document responses include CORS headers and answer OPTIONS preflight requests.
38
39
39
40
Relay / crawler discovery:
40
41
+8
docs/DEPLOYMENT.md
+8
docs/DEPLOYMENT.md
···
190
190
curl https://pds.example.com/xrpc/com.atproto.server.describeServer
191
191
```
192
192
193
+
For browser-hosted clients such as `https://bsky.app`, `perlsky` also answers CORS preflight requests on XRPC routes. A quick manual probe looks like:
194
+
195
+
```sh
196
+
curl -i -X OPTIONS https://pds.example.com/xrpc/com.atproto.server.describeServer \
197
+
-H 'Origin: https://bsky.app' \
198
+
-H 'Access-Control-Request-Method: GET'
199
+
```
200
+
193
201
You should see:
194
202
195
203
- a healthy `_health` response
+35
lib/ATProto/PDS.pm
+35
lib/ATProto/PDS.pm
···
5
5
6
6
use Mojo::Base 'Mojolicious', -signatures;
7
7
use Mojo::JSON ();
8
+
use Mojo::Path;
8
9
use Mojo::URL;
9
10
use ATProto::PDS::API::Admin qw(register_admin_handlers);
10
11
use ATProto::PDS::API::Builtins qw(register_builtin_handlers);
···
41
42
);
42
43
43
44
$self->secrets([$config->{jwt_secret} // 'perlsky-dev-secret']);
45
+
$self->hook(before_dispatch => sub ($c) {
46
+
return unless _cors_path($c->req->url->path);
47
+
48
+
_apply_cors_headers($c);
49
+
return unless $c->req->method eq 'OPTIONS';
50
+
51
+
$c->res->code(204);
52
+
$c->rendered(204);
53
+
});
44
54
$self->helper(metrics => sub { $metrics });
45
55
$self->helper(api_registry => sub { state $registry = ATProto::PDS::API::Registry->new });
46
56
$self->helper(endpoint_catalog => sub ($c) { endpoint_catalog($root) });
···
163
173
routes => $routes,
164
174
catalog => endpoint_catalog($root),
165
175
)->register_routes;
176
+
}
177
+
178
+
sub _cors_path ($path) {
179
+
my $text = ref($path) ? $path->to_string : ($path // q());
180
+
return 1 if $text =~ m{\A/xrpc(?:/|\z)};
181
+
return 1 if $text eq '/.well-known/did.json';
182
+
return 0;
183
+
}
184
+
185
+
sub _apply_cors_headers ($c) {
186
+
my $headers = $c->res->headers;
187
+
my $allow_headers = _allowed_cors_headers($c);
188
+
$headers->header('Access-Control-Allow-Origin' => '*');
189
+
$headers->header('Access-Control-Allow-Methods' => 'GET, POST, OPTIONS');
190
+
$headers->header('Access-Control-Allow-Headers' => $allow_headers);
191
+
$headers->header('Access-Control-Expose-Headers' => 'WWW-Authenticate, DPoP-Nonce');
192
+
$headers->header('Access-Control-Max-Age' => 86400);
193
+
$headers->header('Vary' => 'Origin, Access-Control-Request-Headers');
194
+
}
195
+
196
+
sub _allowed_cors_headers ($c) {
197
+
my @defaults = qw(Authorization Content-Type DPoP Atproto-Accept-Labelers Atproto-Proxy);
198
+
my @requested = split /\s*,\s*/, ($c->req->headers->header('Access-Control-Request-Headers') // q());
199
+
my %seen;
200
+
return join(', ', grep { length && !$seen{lc $_}++ } (@requested, @defaults));
166
201
}
167
202
168
203
1;
+73
t/cors.t
+73
t/cors.t
···
1
+
use v5.34;
2
+
use warnings;
3
+
4
+
use Config ();
5
+
use File::Spec;
6
+
use File::Temp qw(tempdir);
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 = tempdir(CLEANUP => 1);
25
+
26
+
my $app = ATProto::PDS->new(
27
+
project_root => $root,
28
+
settings => {
29
+
base_url => 'http://127.0.0.1:7755',
30
+
service_did_method => 'did:web',
31
+
service_handle_domain => 'pds.example.test',
32
+
jwt_secret => 'cors-secret',
33
+
db_path => File::Spec->catfile($tmp, 'cors.sqlite'),
34
+
data_dir => File::Spec->catdir($tmp, 'data'),
35
+
},
36
+
);
37
+
38
+
my $t = Test::Mojo->new($app);
39
+
40
+
$t->get_ok('/xrpc/com.atproto.server.describeServer' => {
41
+
Origin => 'https://bsky.app',
42
+
})->status_is(200)
43
+
->header_is('Access-Control-Allow-Origin' => '*')
44
+
->header_like('Vary' => qr/\bOrigin\b/, 'origin is included in Vary');
45
+
46
+
my $tx = $t->ua->build_tx(
47
+
OPTIONS => '/xrpc/com.atproto.server.createSession' => {
48
+
Origin => 'https://bsky.app',
49
+
'Access-Control-Request-Method' => 'POST',
50
+
'Access-Control-Request-Headers' => 'authorization, content-type',
51
+
},
52
+
);
53
+
$t->ua->start($tx);
54
+
55
+
is($tx->res->code, 204, 'XRPC preflight succeeds');
56
+
is($tx->res->headers->header('Access-Control-Allow-Origin'), '*', 'preflight allows all origins');
57
+
like(
58
+
$tx->res->headers->header('Access-Control-Allow-Methods') // q(),
59
+
qr/\bPOST\b/,
60
+
'preflight allows POST',
61
+
);
62
+
like(
63
+
lc($tx->res->headers->header('Access-Control-Allow-Headers') // q()),
64
+
qr/\bauthorization\b/,
65
+
'preflight echoes requested authorization header',
66
+
);
67
+
like(
68
+
lc($tx->res->headers->header('Access-Control-Allow-Headers') // q()),
69
+
qr/\bcontent-type\b/,
70
+
'preflight echoes requested content-type header',
71
+
);
72
+
73
+
done_testing;