perlsky is a Perl 5 implementation of an AT Protocol Personal Data Server.
Reuse a saved browser smoke account pair by default
+108
+108
script/perlsky-browser-smoke
+108
script/perlsky-browser-smoke
···
14
14
my $root = abs_path(File::Spec->catdir($Bin, '..'));
15
15
my $tools_dir = File::Spec->catdir($root, 'tools', 'browser-automation');
16
16
my $cache_dir = File::Spec->catdir($root, '.cache', 'ms-playwright');
17
+
my $default_pair_file = File::Spec->catfile($root, '.cache', 'browser-smoke', 'reusable-pair.json');
17
18
my $default_artifacts = File::Spec->catdir($root, 'data', 'browser-smoke', 'latest');
18
19
19
20
my @default_browser_paths = (
···
52
53
secondary_quote_text => $ENV{PERLSKY_BROWSER_SECONDARY_QUOTE_TEXT},
53
54
secondary_reply_text => $ENV{PERLSKY_BROWSER_SECONDARY_REPLY_TEXT},
54
55
secondary_profile_note => $ENV{PERLSKY_BROWSER_SECONDARY_PROFILE_NOTE},
56
+
pair_file => $ENV{PERLSKY_BROWSER_PAIR_FILE} || $default_pair_file,
55
57
headful => $ENV{PERLSKY_BROWSER_HEADFUL} ? 1 : 0,
56
58
edit_profile => $ENV{PERLSKY_BROWSER_EDIT_PROFILE} ? 1 : 0,
57
59
public_checks => $ENV{PERLSKY_BROWSER_SKIP_PUBLIC_CHECKS} ? 0 : 1,
58
60
strict_errors => $ENV{PERLSKY_BROWSER_STRICT_ERRORS} ? 1 : 0,
61
+
load_pair => exists $ENV{PERLSKY_BROWSER_LOAD_PAIR} ? _env_bool($ENV{PERLSKY_BROWSER_LOAD_PAIR}) : 1,
62
+
save_pair => exists $ENV{PERLSKY_BROWSER_SAVE_PAIR} ? _env_bool($ENV{PERLSKY_BROWSER_SAVE_PAIR}) : 1,
59
63
browser_executable_path => $ENV{PERLSKY_BROWSER_EXECUTABLE_PATH} || $default_browser_executable,
60
64
);
61
65
···
67
71
script/perlsky-browser-smoke install
68
72
script/perlsky-browser-smoke bootstrap-secondary [options]
69
73
script/perlsky-browser-smoke bootstrap-pair [options]
74
+
script/perlsky-browser-smoke show-pair [options]
75
+
script/perlsky-browser-smoke clear-pair [options]
70
76
script/perlsky-browser-smoke run [options]
71
77
script/perlsky-browser-smoke run-dual [options]
72
78
script/perlsky-browser-smoke run-dual-bootstrap [options]
···
95
101
--secondary-quote-text TEXT
96
102
--secondary-reply-text TEXT
97
103
--secondary-profile-note TEXT
104
+
--pair-file PATH
105
+
--load-pair
106
+
--save-pair
98
107
--headful
99
108
--edit-profile
100
109
--public-checks
···
123
132
PERLSKY_BROWSER_SECONDARY_QUOTE_TEXT
124
133
PERLSKY_BROWSER_SECONDARY_REPLY_TEXT
125
134
PERLSKY_BROWSER_SECONDARY_PROFILE_NOTE
135
+
PERLSKY_BROWSER_PAIR_FILE
136
+
PERLSKY_BROWSER_LOAD_PAIR=1
137
+
PERLSKY_BROWSER_SAVE_PAIR=1
126
138
PERLSKY_BROWSER_HEADFUL=1
127
139
PERLSKY_BROWSER_EDIT_PROFILE=1
128
140
PERLSKY_BROWSER_SKIP_PUBLIC_CHECKS=1
···
155
167
'secondary-quote-text=s' => \$opt{secondary_quote_text},
156
168
'secondary-reply-text=s' => \$opt{secondary_reply_text},
157
169
'secondary-profile-note=s' => \$opt{secondary_profile_note},
170
+
'pair-file=s' => \$opt{pair_file},
171
+
'load-pair!' => \$opt{load_pair},
172
+
'save-pair!' => \$opt{save_pair},
158
173
'headful!' => \$opt{headful},
159
174
'edit-profile!' => \$opt{edit_profile},
160
175
'public-checks!' => \$opt{public_checks},
161
176
'strict-errors!' => \$opt{strict_errors},
162
177
) or die "invalid options\n";
163
178
179
+
if ($cmd eq 'show-pair') {
180
+
my $pair = _load_pair_file($opt{pair_file})
181
+
or die "no reusable pair saved at $opt{pair_file}\n";
182
+
print encode_json($pair), "\n";
183
+
exit 0;
184
+
}
185
+
186
+
if ($cmd eq 'clear-pair') {
187
+
if (-f $opt{pair_file}) {
188
+
unlink $opt{pair_file} or die "unable to remove $opt{pair_file}: $!";
189
+
}
190
+
exit 0;
191
+
}
192
+
193
+
_load_saved_pair(\%opt, $cmd);
194
+
164
195
if ($cmd eq 'install') {
165
196
install_runtime();
166
197
exit 0;
···
199
230
200
231
if ($cmd eq 'bootstrap-pair') {
201
232
my ($primary_account, $secondary_account) = bootstrap_pair(\%opt, $run_id);
233
+
_save_pair_file($opt{pair_file}, {
234
+
primary => $primary_account,
235
+
secondary => $secondary_account,
236
+
}) if $opt{save_pair};
202
237
print encode_json({
203
238
primary => $primary_account,
204
239
secondary => $secondary_account,
···
279
314
replyText => $opt{secondary_reply_text},
280
315
profileNote => $opt{secondary_profile_note},
281
316
};
317
+
$config->{accountSource} = $opt{_pair_loaded} ? 'pair-file' : 'cli';
318
+
_save_pair_file($opt{pair_file}, {
319
+
primary => {
320
+
handle => $opt{handle},
321
+
password => $opt{password},
322
+
},
323
+
secondary => {
324
+
handle => $opt{secondary_handle},
325
+
password => $opt{secondary_password},
326
+
(defined $opt{secondary_email} ? (email => $opt{secondary_email}) : ()),
327
+
},
328
+
}) if $opt{save_pair};
282
329
} else {
283
330
$config->{handle} = $opt{handle};
284
331
$config->{password} = $opt{password};
···
342
389
password => $password,
343
390
);
344
391
return ($primary_account, $secondary_account);
392
+
}
393
+
394
+
sub _load_saved_pair {
395
+
my ($opt, $cmd) = @_;
396
+
return unless $opt->{load_pair};
397
+
return if $cmd eq 'bootstrap-secondary' || $cmd eq 'bootstrap-pair' || $cmd eq 'run-dual-bootstrap' || $cmd eq 'run-pair-bootstrap';
398
+
399
+
my $pair = _load_pair_file($opt->{pair_file}) or return;
400
+
if ($cmd eq 'run-dual') {
401
+
$opt->{handle} //= $pair->{primary}{handle};
402
+
$opt->{password} //= $pair->{primary}{password};
403
+
$opt->{secondary_handle} //= $pair->{secondary}{handle};
404
+
$opt->{secondary_password} //= $pair->{secondary}{password};
405
+
$opt->{secondary_email} //= $pair->{secondary}{email};
406
+
$opt->{_pair_loaded} = 1;
407
+
return;
408
+
}
409
+
410
+
if ($cmd eq 'run') {
411
+
$opt->{handle} //= $pair->{primary}{handle};
412
+
$opt->{password} //= $pair->{primary}{password};
413
+
$opt->{_pair_loaded} = 1;
414
+
}
415
+
}
416
+
417
+
sub _load_pair_file {
418
+
my ($path) = @_;
419
+
return unless defined $path && length $path && -f $path;
420
+
open(my $fh, '<:raw', $path) or die "unable to read $path: $!";
421
+
local $/ = undef;
422
+
my $json = <$fh>;
423
+
close $fh;
424
+
my $pair = decode_json($json);
425
+
return unless ref($pair) eq 'HASH'
426
+
&& ref($pair->{primary}) eq 'HASH'
427
+
&& ref($pair->{secondary}) eq 'HASH';
428
+
return $pair;
429
+
}
430
+
431
+
sub _save_pair_file {
432
+
my ($path, $pair) = @_;
433
+
return unless defined $path && length $path;
434
+
my ($volume, $directories) = File::Spec->splitpath($path);
435
+
my $dir = File::Spec->catpath($volume, $directories, q());
436
+
make_path($dir) if length $dir && !-d $dir;
437
+
my $payload = {
438
+
version => 1,
439
+
saved_at => time,
440
+
primary => $pair->{primary},
441
+
secondary => $pair->{secondary},
442
+
};
443
+
open(my $fh, '>:raw', $path) or die "unable to write $path: $!";
444
+
print {$fh} encode_json($payload);
445
+
close $fh;
446
+
}
447
+
448
+
sub _env_bool {
449
+
my ($value) = @_;
450
+
return 0 unless defined $value;
451
+
return 0 if $value =~ /\A(?:0|false|no|off)\z/i;
452
+
return 1;
345
453
}
346
454
347
455
sub _bootstrap_account {