perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
1#!/usr/bin/env perl
2use v5.34;
3use warnings;
4
5use Config ();
6use FindBin ();
7use File::Spec;
8use Getopt::Long qw(GetOptionsFromArray);
9
10BEGIN {
11 require Cwd;
12 require File::Spec;
13 require lib;
14
15 my @roots = grep { defined && -d $_ }
16 map { Cwd::abs_path($_) }
17 (
18 File::Spec->catdir($FindBin::RealBin, '..'),
19 File::Spec->catdir($FindBin::RealBin, '..', '..'),
20 );
21
22 my @inc;
23 for my $root (@roots) {
24 push @inc,
25 File::Spec->catdir($root, 'lib'),
26 File::Spec->catdir($root, 'local', 'lib', 'perl5'),
27 File::Spec->catdir($root, 'local', 'lib', 'perl5', $Config::Config{archname});
28 }
29
30 lib->import(@inc);
31}
32
33use ATProto::PDS::Config qw(load_config);
34use ATProto::PDS::Store::SQLite;
35use ATProto::PDS::Auth::Password qw(random_hex);
36use ATProto::PDS::Identity qw(service_did);
37use ATProto::PDS::Repo::Manager;
38
39my $root = File::Spec->rel2abs(File::Spec->catdir($FindBin::RealBin, '..'));
40my $config_path = $ENV{PERLSKY_CONFIG} || File::Spec->catfile($root, 'etc', 'perlsky.example.json');
41my $config = load_config($config_path);
42my $command = shift(@ARGV) // q();
43
44if ($command eq 'create-invite') {
45 my $use_count = 1;
46 my $for_account = service_did($config);
47 my $created_by = service_did($config);
48 GetOptionsFromArray(
49 \@ARGV,
50 'use-count=i' => \$use_count,
51 'for-account=s' => \$for_account,
52 'created-by=s' => \$created_by,
53 ) or die usage();
54
55 my $store = _store($config, $root);
56 my $code = _new_invite_code();
57 $store->create_invite_code(
58 code => $code,
59 for_account => $for_account,
60 created_by => $created_by,
61 use_count => $use_count,
62 );
63 print "$code\n";
64 exit 0;
65}
66
67if ($command eq 'repair-binary-columns') {
68 my $store = _store($config, $root);
69 my $result = $store->repair_binary_columns;
70 for my $key (sort keys %$result) {
71 print "$key=$result->{$key}\n";
72 }
73 exit 0;
74}
75
76if ($command eq 'repair-invalid-tids') {
77 my $did;
78 my $force = 0;
79 GetOptionsFromArray(
80 \@ARGV,
81 'did=s' => \$did,
82 'force!' => \$force,
83 ) or die usage();
84
85 my $store = _store($config, $root);
86 my $manager = ATProto::PDS::Repo::Manager->new(store => $store);
87
88 my @accounts = $did
89 ? do {
90 my $account = $store->get_account_by_did($did)
91 or die "account not found for did=$did\n";
92 ($account);
93 }
94 : @{ $store->list_accounts };
95
96 for my $account (@accounts) {
97 my $result = $manager->repair_invalid_tids($account, force => $force);
98 my $label = $account->{handle} // $account->{did};
99 print join(
100 q{ },
101 $label,
102 'changed=' . ($result->{changed} // 0),
103 'repaired_paths=' . ($result->{repaired_paths} // 0),
104 'rewritten_refs=' . ($result->{rewritten_refs} // 0),
105 'rev_repaired=' . ($result->{rev_repaired} // 0),
106 (defined($result->{imported}{rev}) ? ('new_rev=' . $result->{imported}{rev}) : ()),
107 ), "\n";
108 }
109 exit 0;
110}
111
112die usage();
113
114sub _store {
115 my ($config, $root) = @_;
116 return ATProto::PDS::Store::SQLite->new(
117 path => $config->{db_path} || File::Spec->catfile($root, 'data', 'runtime', 'perlsky.sqlite'),
118 )->bootstrap;
119}
120
121sub _new_invite_code {
122 return 'perlsky-' . substr(random_hex(8), 0, 12);
123}
124
125sub usage {
126 return <<'EOF';
127usage:
128 perlsky-admin create-invite [--use-count N] [--for-account DID] [--created-by DID]
129 perlsky-admin repair-binary-columns
130 perlsky-admin repair-invalid-tids [--did DID] [--force]
131EOF
132}