File Coverage

File:lib/CheckSpelling/Apply.pm
Coverage:42.4%

linestmtbrancondsubtimecode
1
1
1
1
1
292925
1
20
package CheckSpelling::Apply; use CheckSpelling::Util; #!/usr/bin/env perl
2":" || q@<<"=END_OF_PERL"@;
3
4
1
1
1
1
2
0
23
use Symbol 'gensym';
5
1
1
1
1
157
1157
24
use IPC::Open3;
6
1
1
1
1
2
0
20
use File::Basename qw(dirname);
7
1
1
1
1
1
0
14
use File::Path qw(make_path);
8
1
1
1
1
160
279
33
use File::Spec::Functions qw(catfile path);
9
1
1
1
1
2
1
17
use File::Temp qw/ tempfile tempdir /;
10
1
1
1
1
2
0
16
use JSON::PP;
11
1
1
1
1
6
0
2456
use warnings;
12
13my @safe_path = qw(
14    /opt/homebrew/bin
15    /opt/homebrew/sbin
16    /usr/local/bin
17    /usr/bin
18    /bin
19    /usr/sbin
20    /sbin
21);
22
23my $bin = glob("~/bin");
24push @safe_path, $bin if -d $bin;
25
26my $ua = 'check-spelling-agent/0.0.4';
27
28$ENV{'PATH'} = join ':', @safe_path unless defined $ENV{SYSTEMROOT};
29
30sub check_exists_command {
31
0
0
0
    my ($command) = @_;
32
33
0
0
    my @path = path;
34
0
0
    my @pathext = ('');
35
36
0
0
0
    if ($^O eq 'MSWin32') {
37
0
0
0
0
        push @pathext, map { lc } split /;/, $ENV{PATHEXT};
38    }
39
40
0
0
    for my $dir (@path) {
41
0
0
        for my $suffix (@pathext) {
42
0
0
            my $f = catfile $dir, "$command$suffix";
43
0
0
0
            return $f if -x $f;
44        }
45    }
46}
47
48sub needs_command_because {
49
0
0
0
    my ($command, $reason) = @_;
50
0
0
0
    return if check_exists_command($command);
51
0
0
    CheckSpelling::Util::die_custom $program, 51, 'Please install `'.$command.'` - it is needed to '.$reason;
52}
53
54sub check_basic_tools {
55
0
0
0
    needs_command_because('git', 'interact with git repositories');
56
0
0
    needs_command_because('curl', 'download other tools');
57
0
0
    needs_command_because('gh', 'interact with github');
58    #needs_command_because('magic-magic', 'debugging');
59}
60
61sub get_token {
62
4
4
4
    our $token;
63
4
100
67
19
    return $token if defined $token && $token ne '';
64
1
33
2
    $token = $ENV{'GH_TOKEN'} || $ENV{'GITHUB_TOKEN'};
65
1
50
33
5
    return $token if defined $token && $token ne '';
66
0
0
    my ($err, $exit);
67
0
0
    ($token, $err, $exit) = capture_system('gh', 'auth', 'token');
68
0
0
    chomp $token;
69
0
0
    chomp $err;
70
0
0
    return ($token, $err, $exit);
71};
72
73sub download_with_curl {
74
1
1
1
    my ($url, $dest, $flags) = @_;
75
1
50
3
    $flags = '-fsL' unless defined $flags;
76
1
67582
    system('curl',
77        '--connect-timeout', 3,
78        '-A', $ua,
79        $flags,
80        '-o', $dest,
81        $url
82    );
83}
84
85sub tempfile_name {
86
6
6
22
    my ($fh, $filename) = tempfile();
87
6
983
    close $fh;
88
6
10
    return $filename;
89}
90
91sub strip_comments {
92
4
4
3
    my ($file) = @_;
93
4
13
    my ($fh, $filename) = tempfile();
94
4
694
    open INPUT, '<', $file;
95
4
54
    while (<INPUT>) {
96
1848
100
1026
        next if /^\s*(?:#.*)/;
97
1821
1207
        print $fh $_;
98    }
99
4
12
    close INPUT;
100
4
47
    close $fh;
101
4
9
    return $filename;
102}
103
104sub capture_system {
105
17
17
42
    my @args = @_;
106
17
72
    my $pid = open3(my $child_in, my $child_out, my $child_err = gensym, @args);
107
17
30402
    my (@err, @out);
108
17
1936262
    while (my $output = <$child_out>) {
109
3
1533
        push @out, $output;
110    }
111
17
399
    while (my $error = <$child_err>) {
112
16
57
        push @err, $error;
113    }
114
17
259
    waitpid( $pid, 0 );
115
17
97
    my $child_exit_status = $?;
116
17
37
    my $output_joined = join '', @out;
117
17
29
    my $error_joined = join '', @err;
118
17
465
    return ($output_joined, $error_joined, $child_exit_status);
119}
120
121sub capture_merged_system {
122
10
10
28
    my ($output_joined, $error_joined, $child_exit_status) = capture_system(@_);
123
10
50
42
    my $joiner = ($output_joined ne '') ? "\n" : '';
124
10
35
    return ($output_joined.$joiner.$error_joined, $child_exit_status);
125}
126
127sub compare_files {
128
2
2
1404
    my ($one, $two) = @_;
129
2
5
    my $one_stripped = strip_comments($one);
130
2
5
    my $two_stripped = strip_comments($two);
131
2
1
    my $exit_code;
132
2
5
    (undef, undef, $exit_code) = capture_system(
133            'diff',
134            '-qwB',
135            $one_stripped, $two_stripped
136        );
137
2
50
5
    if ($? == -1) {
138
0
0
        print "could not compare '$one' and '$two': $!\n";
139
0
0
        return 0;
140    }
141
2
50
6
    if ($? & 127) {
142
0
0
0
        printf "child died with signal %d, %s core dump\n",
143        ($? & 127),  ($? & 128) ? 'with' : 'without';
144
0
0
        return 0;
145    }
146
2
50
4
    return 0 if $? == 0;
147
2
8
    return 1;
148}
149
150my $bash_script=q{
151=END_OF_PERL@
152# bash
153set -e
154if [ "$OUTPUT" = "$ERROR" ]; then
155    ("$@" 2>&1) > "$OUTPUT"
156else
157    "$@" > "$OUTPUT" 2> "$ERROR"
158fi
159exit
160};
161
162sub check_current_script {
163
1
50
1
115120
    if ("$0" eq '-') {
164
0
0
        my ($bash_script) = @_;
165
0
0
        my $fh;
166
0
0
        ($fh, $0) = tempfile();
167
0
0
        $bash_script =~ s/^=.*\@$//m;
168
0
0
        print $fh $bash_script;
169
0
0
        close $fh;
170
0
0
        return;
171    }
172
1
3
    my $filename = tempfile_name();
173
1
3
    my $source = 'https://raw.githubusercontent.com/check-spelling/check-spelling/prerelease/apply.pl';
174
1
2
    download_with_curl($source, $filename);
175
1
50
17
    if ($? == 0) {
176
1
50
5
        if (compare_files($filename, $0)) {
177
1
16
            print "Current apply script differs from '$source' (locally downloaded to `$filename`). You may wish to upgrade.\n";
178        }
179    }
180}
181
182sub die_with_message {
183
5
5
8
    our $program;
184
5
5
    my ($gh_err_text) = @_;
185
5
50
33
21
    if ($gh_err_text =~ /error connecting to / && $gh_err_text =~ /check your internet connection/) {
186
0
0
        print "$program: Internet access may be limited. Check your connection (this often happens with lousy cable internet service providers where their CG-NAT or whatever strands the modem).\n\n$gh_err_text";
187
0
0
0
0
0
0
        { CheckSpelling::Util::tear_here(5); die "exiting"; }
188    }
189
5
100
18
    if ($gh_err_text =~ /proxyconnect tcp:.*connect: connection refused/) {
190
1
27
        print "$program: Proxy is not accepting connections.\n";
191
1
2
        for my $proxy (qw(http_proxy HTTP_PROXY https_proxy HTTPS_PROXY)) {
192
4
100
9
            if (defined $ENV{$proxy}) {
193
1
4
                print "  $proxy: '$ENV{$proxy}'\n";
194            }
195        }
196
1
3
        print "\n$gh_err_text";
197
1
1
1
0
6
12
        { CheckSpelling::Util::tear_here(6); die "exiting"; }
198    }
199
4
100
13
    if ($gh_err_text =~ /dial unix .*: connect: .*/) {
200
1
22
        print "$program: Unix http socket is not working.\n";
201
1
170467
        my $gh_http_unix_socket = `gh config get http_unix_socket`;
202
1
26
        print "  http_unix_socket: $gh_http_unix_socket\n";
203
1
4
        print "\n$gh_err_text";
204
1
1
1
8
13
19
        { CheckSpelling::Util::tear_here(7); die "exiting"; }
205    }
206}
207
208sub gh_is_happy_internal {
209
5
5
15
    my ($output, $exit_code) = capture_merged_system(qw(gh api /installation/repositories));
210
5
50
16
    return ($exit_code, $output) if $exit_code == 0;
211
5
11
    ($output, $exit_code) = capture_merged_system(qw(gh api /user));
212
5
12
    return ($exit_code, $output);
213}
214
215sub gh_is_happy {
216
3
3
5
    my ($program) = @_;
217
3
6
    my ($gh_auth_status, $gh_status_lines) = gh_is_happy_internal();
218
3
50
11
    return 1 if $gh_auth_status == 0;
219
3
14
    die_with_message($gh_status_lines);
220
221
1
1
    my @problematic_env_variables;
222
1
4
    for my $variable (qw(GH_TOKEN GITHUB_TOKEN GITHUB_ACTIONS CI)) {
223
4
100
10
        if (defined $ENV{$variable}) {
224
2
22
            delete $ENV{$variable};
225
2
6
            push @problematic_env_variables, $variable;
226
2
3
            ($gh_auth_status, $gh_status_lines) = gh_is_happy_internal();
227
2
50
28
            if ($gh_auth_status == 0) {
228
0
0
                print STDERR "$0: gh program did not like these environment variables: ".join(', ', @problematic_env_variables)." -- consider unsetting them.\n";
229
0
0
                return 1;
230            }
231        }
232    }
233
234
1
27
    print $gh_status_lines;
235
1
13
    return 0;
236}
237
238sub tools_are_ready {
239
3
3
99423
    my ($program) = @_;
240
3
50
5
    unless (gh_is_happy($program)) {
241
1
4
        $! = 1;
242
1
50
33
7
        my $or_gh_token = (defined $ENV{CI} && $ENV{CI}) ? ' or set the GH_TOKEN environment variable' : '';
243
1
8
        CheckSpelling::Util::die_custom $program, 243, "$program requires a happy gh, please try 'gh auth login'$or_gh_token\n";
244    }
245}
246
247sub run_pipe {
248
1
1
3
    my @args = @_;
249
1
3
    my ($out, undef, $exit_code) = capture_system(@args);
250
1
7
    return $out;
251}
252
253sub unzip_pipe {
254
0
0
0
    my ($artifact, $file) = @_;
255
0
0
    return run_pipe(
256        'unzip',
257        '-p', $artifact,
258        $file
259    );
260}
261
262sub retrieve_spell_check_this {
263
0
0
0
    my ($artifact, $config_ref) = @_;
264
0
0
    my $spell_check_this_config = unzip_pipe($artifact, 'spell_check_this.json');
265
0
0
0
    return unless $spell_check_this_config =~ /\{.*\}/s;
266
0
0
    my %config;
267
0
0
0
0
0
0
0
    eval { %config = %{decode_json $spell_check_this_config}; } || CheckSpelling::Util::die_custom $program, 267, "decode_json failed in retrieve_spell_check_this with '$spell_check_this_config'";
268
0
0
    my ($repo, $branch, $destination, $path) = ($config{url}, $config{branch}, $config{config}, $config{path});
269
0
0
    my $spell_check_this_dir = tempdir();
270
0
0
    my $exit_code;
271
0
0
    (undef, undef, $exit_code) = capture_system(
272            'git', 'clone',
273            '--depth', '1',
274            '--no-tags',
275            $repo,
276            '--branch', $branch,
277            $spell_check_this_dir
278        );
279
0
0
0
    if ($?) {
280
0
0
        CheckSpelling::Util::die_custom $program, 280, "git clone $repo#$branch failed";
281    }
282
283
0
0
    make_path($destination);
284
0
0
    system('cp', '-i', '-R', glob("$spell_check_this_dir/$path/*"), $destination);
285
0
0
    system('git', 'add', '-f', $destination);
286}
287
288sub case_biased {
289
0
0
0
    lc($a)."-".$a cmp lc($b)."-".$b;
290}
291
292sub add_to_excludes {
293
0
0
0
    my ($artifact, $config_ref) = @_;
294
0
0
0
0
    my %config = %{$config_ref};
295
0
0
    my $excludes = $config{"excludes_file"};
296
0
0
    my $should_exclude_patterns = unzip_pipe($artifact, 'should_exclude.patterns');
297
0
0
0
    unless ($should_exclude_patterns =~ /\w/) {
298
0
0
        $should_exclude_patterns = unzip_pipe($artifact, 'should_exclude.txt');
299
0
0
0
        return unless $should_exclude_patterns =~ /\w/;
300
0
0
        $should_exclude_patterns =~ s{^(.*)}{^\\Q$1\\E\$}gm;
301    }
302
0
0
    my $need_to_add_excludes;
303    my %excludes;
304
0
0
0
    if (-f $excludes) {
305
0
0
        open EXCLUDES, '<', $excludes;
306
0
0
        while (<EXCLUDES>) {
307
0
0
            chomp;
308
0
0
0
            next unless /./;
309
0
0
            $excludes{$_."\n"} = 1;
310        }
311
0
0
        close EXCLUDES;
312    } else {
313
0
0
        $need_to_add_excludes = 1;
314    }
315
0
0
    for $pattern (split /\n/, $should_exclude_patterns) {
316
0
0
0
        next unless $pattern =~ /./;
317
0
0
        $excludes{$pattern."\n"} = 1;
318    }
319
0
0
    open EXCLUDES, '>', $excludes;
320
0
0
    print EXCLUDES join "", sort case_biased keys %excludes;
321
0
0
    close EXCLUDES;
322
0
0
0
    system('git', 'add', '--', $excludes) if $need_to_add_excludes;
323}
324
325sub remove_stale {
326
0
0
0
    my ($artifact, $config_ref) = @_;
327
0
0
    my @stale = split /\s+/s, unzip_pipe($artifact, 'remove_words.txt');
328
0
0
0
    return unless @stale;
329
0
0
0
0
    my %config = %{$config_ref};
330
0
0
0
0
    my @expect_files = @{$config{"expect_files"}};
331    @expect_files = grep {
332
0
0
0
0
0
        print STDERR "Could not find $_\n" unless -f $_;
333
0
0
        -f $_;
334    } @expect_files;
335
0
0
0
    unless (@expect_files) {
336
0
0
        CheckSpelling::Util::die_custom $program, 336, "Could not find any of the processed expect files, are you on the wrong branch?";
337    }
338
339
0
0
    my $re = join "|", @stale;
340
0
0
    for my $file (@expect_files) {
341
0
0
        open INPUT, '<', $file;
342
0
0
        my @keep;
343
0
0
        while (<INPUT>) {
344
0
0
0
            next if /^(?:$re)(?:(?:\r|\n)*$|[# ].*)/;
345
0
0
            push @keep, $_;
346        }
347
0
0
        close INPUT;
348
349
0
0
        open OUTPUT, '>', $file;
350
0
0
        print OUTPUT join '', @keep;
351
0
0
        close OUTPUT;
352    };
353}
354
355sub add_expect {
356
0
0
0
    my ($artifact, $config_ref) = @_;
357
0
0
    my @add = split /\s+/s, (unzip_pipe($artifact, 'tokens.txt'));
358
0
0
0
    return unless @add;
359
0
0
0
0
    my %config = %{$config_ref};
360
0
0
    my $new_expect_file = $config{"new_expect_file"};
361
0
0
    my @words;
362
0
0
    make_path (dirname($new_expect_file));
363
0
0
0
    if (-s $new_expect_file) {
364
0
0
        open FILE, q{<}, $new_expect_file;
365
0
0
        local $/ = undef;
366
0
0
        @words = split /\s+/, <FILE>;
367
0
0
        close FILE;
368    }
369
0
0
    my %items;
370
0
0
    @items{@words} = @words x (1);
371
0
0
    @items{@add} = @add x (1);
372
0
0
    @words = sort case_biased keys %items;
373
0
0
    open FILE, q{>}, $new_expect_file;
374
0
0
    for my $word (@words) {
375
0
0
0
        print FILE "$word\n" if $word =~ /\S/;
376    };
377
0
0
    close FILE;
378
0
0
    system("git", "add", $new_expect_file);
379}
380
381sub get_artifact_metadata {
382
3
3
3
    my ($url) = @_;
383
3
9
    my $json_file = tempfile_name();
384
3
3
    my ($curl_stdout, $curl_stderr, $curl_result);
385
3
10
    my @curl_args = (
386        'curl',
387        $url,
388        '-A',
389        $ua,
390        '-s',
391        '--fail-with-body',
392    );
393
3
6
    my ($gh_token) = get_token();
394
3
50
10
    push @curl_args, '-u', "token:$gh_token" if defined $gh_token;
395
3
3
    push @curl_args, (
396        '-o',
397        $json_file
398    );
399
3
6
    ($curl_stdout, $curl_stderr, $curl_result) = capture_system(
400        @curl_args
401    );
402
3
100
10
    unless ($curl_result == 0) {
403
1
50
6
        if ($curl_stdout eq '') {
404
1
8
            local $/;
405
1
24
            open my $error_fh, '<', $json_file;
406
1
9
            $curl_stdout = <$error_fh>;
407
1
4
            close $error_fh;
408        }
409        return (
410
1
11
            out    => $curl_stdout,
411            err    => $curl_stderr,
412            result => $curl_result,
413        );
414    }
415
2
21
    my $link;
416
2
35
    open my $json_file_fh, '<', $json_file;
417
2
1
    my ($id, $download_url, $count);
418    {
419
2
2
2
9
        local $/;
420
2
22
        my $content = <$json_file_fh>;
421
2
14
        my $json = decode_json $content;
422
2
5119
        my $artifact = $json->{'artifacts'}->[0];
423
2
2
        $id = $artifact->{'id'};
424
2
0
        $download_url = $artifact->{'archive_download_url'};
425
2
8
        $count = $json->{'total_count'};
426    }
427
2
8
    close $json_file_fh;
428
2
50
2
    if ($count == 0) {
429        return (
430
0
0
            out => '',
431            err => 'no artifact matches any of the names or patterns provided',
432            result => (3 << 8),
433        );
434    }
435    return (
436
2
18
        id       => $id,
437        download => $download_url,
438        count    => $count,
439    );
440}
441
442sub get_latest_artifact_metadata {
443
2
2
3
    my ($artifact_dir, $repo, $run, $artifact_name) = @_;
444
2
1
    my $page = 1;
445
2
4
    my $url = "$ENV{GITHUB_API_URL}/repos/$repo/actions/runs/$run/artifacts?name=$artifact_name&per_page=1&page=";
446
2
7
    my %first = get_artifact_metadata($url.$page);
447
2
5
    $page = $first{'count'};
448
2
100
3
    if (defined $page) {
449
1
2
        my %second = get_artifact_metadata($url.$page);
450
1
4
        my ($id_1, $id_2) = ($first{'id'}, $second{'id'});
451
1
50
33
6
        if (defined $id_1 && defined $id_2) {
452
1
50
3
            if ($id_2 > $id_1) {
453                return (
454
0
0
                    download => $second{'download'},
455                );
456            }
457        }
458    }
459
2
3
    my $download = $first{'download'};
460
2
100
3
    if (defined $download) {
461        return (
462
1
4
            download => $download,
463        );
464    }
465
1
8
    return %first;
466}
467
468sub download_latest_artifact {
469
2
2
6
    my %maybe_download = get_latest_artifact_metadata(@_);
470
2
4
    my $download = $maybe_download{'download'};
471
2
3
    my $zip_file = tempfile_name();
472
2
100
3
    if (defined $download) {
473
1
5
        my @curl_args = (
474            'curl',
475            $download,
476            '-L',
477            '-A',
478            $ua,
479            '-s',
480            '--fail-with-body',
481        );
482
1
2
        my ($gh_token) = get_token();
483
1
50
2
        push @curl_args, '-u', "token:$gh_token" if defined $gh_token;
484
1
3
        push @curl_args, (
485            '-o',
486            $zip_file
487        );
488
1
1
        ($curl_stdout, $curl_stderr, $curl_result) = capture_system(
489            @curl_args
490        );
491
1
50
9
        if ($curl_result != 0) {
492
1
50
2
            if ($curl_stdout eq '') {
493
1
4
                local $/;
494
1
28
                open my $error_fh, '<', $zip_file;
495
1
9
                $curl_stdout = <$error_fh>;
496
1
3
                close $error_fh;
497            }
498
1
11
            return ("$curl_stdout\n$curl_stderr", $curl_result);
499        }
500
0
0
        my ($artifact_dir, $repo, $run, $artifact_name) = @_;
501
0
0
        ($out, $err, $result) = capture_system(
502            'unzip',
503            '-q',
504            $zip_file,
505            '-d',
506            $artifact_dir,
507            );
508
0
0
        return ("$out\n$err", $result);
509    }
510
1
2
    my ($out, $err, $result) = ($maybe_download{'out'}, $maybe_download{'err'}, $maybe_download{'result'});
511
1
3
    return ("$out\n$err", $result);
512}
513
514sub get_artifacts {
515
2
2
2663
    my ($repo, $run, $suffix) = @_;
516
2
1
    our $program;
517
2
5
    my $artifact_dir = tempdir(CLEANUP => 1);
518
2
355
    my $gh_err_text;
519
2
3
    my $artifact_name = 'check-spelling-comment';
520
2
50
3
    if ($suffix) {
521
0
0
        $artifact_name .= "-$suffix";
522    }
523
2
1
    my $retries_remaining = 3;
524
2
7
    while ($retries_remaining-- > 0) {
525
2
7
        ($gh_err_text, $ret) = download_latest_artifact(
526            $artifact_dir,
527            $repo,
528            $run,
529            $artifact_name
530        );
531
2
50
4
        return glob("$artifact_dir/artifact*.zip") unless ($ret >> 8);
532
533
2
7
        die_with_message($gh_err_text);
534
2
100
15
        if ($gh_err_text =~ /no valid artifacts found to download|"Artifact has expired"/) {
535
1
3
            my $expired_json = run_pipe(
536                'gh', 'api',
537                "/repos/$repo/actions/runs/$run/artifacts",
538                '-q',
539                '[.artifacts.[]|select(.name=="'.$artifact_name.'")][-1]|.expired'
540            );
541
1
50
4
            if ($expired_json ne '') {
542
1
3
                chomp $expired_json;
543
1
2
                my $expired;
544
1
1
50
4
8
                eval { $expired = decode_json $expired_json } || CheckSpelling::Util::die_custom $program, 544, "decode_json failed in update_repository with '$expired_json'";
545
1
50
127
                if ($expired) {
546
1
30
                    print "$program: GitHub Run Artifact expired. You will need to trigger a new run.\n";
547
1
1
1
2
10
17
                    { CheckSpelling::Util::tear_here(1); die "exiting"; }
548                }
549            }
550
0
0
            print "$program: GitHub Run may not have completed. If so, please wait for it to finish and try again.\n";
551
0
0
0
0
0
0
            { CheckSpelling::Util::tear_here(2); die "exiting"; }
552        }
553
1
50
3
        if ($gh_err_text =~ /no artifact matches any of the names or patterns provided/) {
554
0
0
0
            $github_server_url = $ENV{GITHUB_SERVER_URL} || '';
555
0
0
            my $run_link;
556
0
0
0
            if ($github_server_url) {
557
0
0
                $run_link = "[$run]($github_server_url/$repo/actions/runs/$run)";
558            } else {
559
0
0
                $run_link = "$run";
560            }
561
0
0
            print "$program: The referenced repository ($repo) run ($run_link) does not have a corresponding artifact ($artifact_name). If it was deleted, that's unfortunate. Consider pushing a change to the branch to trigger a new run?\n";
562
0
0
            print "If you don't think anyone deleted the artifact, please file a bug to https://github.com/check-spelling/check-spelling/issues/new including as much information about how you triggered this error as possible.\n";
563
0
0
0
0
0
0
            { CheckSpelling::Util::tear_here(3); die "exiting"; }
564        }
565
1
50
6
        if ($gh_err_text =~ /HTTP 404: Not Found|"status":"404"/) {
566
1
19
            print "$program: The referenced repository ($repo) may not exist, perhaps you do not have permission to see it. If the repository is hosted by GitHub Enterprise, check-spelling does not know how to integrate with it.\n";
567
1
1
1
2
4
10
            { CheckSpelling::Util::tear_here(8); die "exiting"; }
568        }
569
0
0
0
        if ($gh_err_text =~ /HTTP 403: API rate limit exceeded for .*?./) {
570        } elsif ($gh_err_text =~ m{dial tcp \S+:\d+: i/o timeout$}) {
571
0
0
            if ($retries_remaining <= 0) {
572
0
                print "$program: Timeout connecting to GitHub. This is probably caused by an outage of sorts.\nCheck https://www.githubstatus.com/history\nTry again later.";
573
0
0
0
                { CheckSpelling::Util::tear_here(9); die "exiting"; }
574            }
575        } else {
576
0
            print "$program: Unknown error, please check the list of known issues https://github.com/check-spelling/check-spelling/issues?q=is%3Aissue%20apply.pl and file a bug to https://github.com/check-spelling/check-spelling/issues/new?title=%60apply.pl%60%20scenario&body=Please%20provide%20details+preferably%20including%20a%20link%20to%20a%20workflow%20run,%20the%20configuration%20of%20the%20repository,%20and%20anything%20else%20you%20may%20know%20about%20the%20problem%2e\n";
577
0
            print $gh_err_text;
578
0
0
0
            { CheckSpelling::Util::tear_here(4); die "exiting"; }
579        }
580
0
0
        my $request_id = $1 if ($gh_err_text =~ /\brequest ID\s+(\S+)/);
581
0
0
        my $timestamp = $1 if ($gh_err_text =~ /\btimestamp\s+(.*? UTC)/);
582
0
0
        my $has_gh_token = defined $ENV{GH_TOKEN} || defined $ENV{GITHUB_TOKEN};
583
0
        my $meta_url = 'https://api.github.com/meta';
584
0
        while (1) {
585
0
            my @curl_args = qw(curl);
586
0
0
            unless ($has_gh_token) {
587
0
                my ($gh_token) = get_token();
588
0
0
                push @curl_args, '-u', "token:$gh_token" if defined $gh_token;
589            }
590
0
            push @curl_args, '-I', $meta_url;
591
0
            my ($curl_stdout, $curl_stderr, $curl_result);
592
0
            ($curl_stdout, $curl_stderr, $curl_result) = capture_system(@curl_args);
593
0
            my $delay = 1;
594
0
0
0
            if ($curl_stdout =~ m{^HTTP/\S+\s+200}) {
595
0
0
                if ($curl_stdout =~ m{^x-ratelimit-remaining:\s+(\d+)$}m) {
596
0
                    my $ratelimit_remaining = $1;
597
0
0
                    last if ($ratelimit_remaining > 10);
598
599
0
                    $delay = 5;
600
0
                    print STDERR "Sleeping for $delay seconds because $ratelimit_remaining is close to 0\n";
601                } else {
602
0
                    print STDERR "Couldn't find x-ratelimit-remaining, will sleep for $delay\n";
603                }
604            } elsif ($curl_stdout =~ m{^HTTP/\S+\s+403}) {
605
0
0
                if ($curl_stdout =~ /^retry-after:\s+(\d+)/m) {
606
0
                    $delay = $1;
607
0
                    print STDERR "Sleeping for $delay seconds (presumably due to API rate limit)\n";
608                } else {
609
0
                    print STDERR "Couldn't find retry-after, will sleep for $delay\n";
610                }
611            } else {
612
0
0
                my $response = $1 if $curl_stdout =~ m{^(HTTP/\S+)};
613
0
                print STDERR "Unexpected response ($response) from $meta_url; sleeping for $delay\n";
614            }
615
0
            sleep $delay;
616        }
617    }
618}
619
620sub update_repository {
621
0
0
    my ($artifact) = @_;
622
0
    our $program;
623
0
0
    CheckSpelling::Util::die_custom $program, 623, "$program: artifact argument contains quote characters" if $artifact =~ /'/;
624
0
    my $apply = unzip_pipe($artifact, 'apply.json');
625
0
0
    unless ($apply =~ /\{.*\}/s) {
626
0
        print STDERR "$program: Could not retrieve valid apply.json from artifact\n";
627
0
        $apply = '{
628            "expect_files": [".github/actions/spelling/expect.txt"],
629            "new_expect_file": ".github/actions/spelling/expect.txt",
630            "excludes_file": ".github/actions/spelling/excludes.txt",
631            "spelling_config": ".github/actions/spelling"
632        }';
633    }
634
0
    my $config_ref;
635
0
0
0
    eval { $config_ref = decode_json($apply); } ||
636        CheckSpelling::Util::die_custom $program, 636, "$program: decode_json failed in update_repository with '$apply'";
637
638
0
    my $git_repo_root = run_pipe('git', 'rev-parse', '--show-toplevel');
639
0
    chomp $git_repo_root;
640
0
0
    CheckSpelling::Util::die_custom $program, 640, "$program: Could not find git repo root..." unless $git_repo_root =~ /\w/;
641
0
    chdir $git_repo_root;
642
643
0
    retrieve_spell_check_this($artifact, $config_ref);
644
0
    remove_stale($artifact, $config_ref);
645
0
    add_expect($artifact, $config_ref);
646
0
    add_to_excludes($artifact, $config_ref);
647
0
    system('git', 'add', '-u', '--', $config_ref->{'spelling_config'});
648}
649
650sub extract_artifacts_from_file {
651
0
0
    my ($artifact) = @_;
652
0
    open my $artifact_reader, '-|', 'unzip', '-l', $artifact;
653
0
    my ($has_artifact, $only_file) = (0, 0);
654
0
    while (my $line = <$artifact_reader>) {
655
0
        chomp $line;
656
0
0
        if ($line =~ /\s+artifact\.zip$/) {
657
0
            $has_artifact = 1;
658
0
            next;
659        }
660
0
0
        if ($line =~ /\s+1 file$/) {
661
0
            $only_file = 1;
662
0
            next;
663        }
664
0
0
        $only_file = 0 if $only_file;
665    }
666
0
    close $artifact_reader;
667
0
    my @artifacts;
668
0
0
0
    if ($has_artifact && $only_file) {
669
0
        my $artifact_dir = tempdir(CLEANUP => 1);
670
0
        my ($fh, $gh_err) = tempfile();
671
0
        close $fh;
672
0
        system('unzip', '-q', '-d', $artifact_dir, $artifact, 'artifact.zip');
673
0
        @artifacts = ("$artifact_dir/artifact.zip");
674    } else {
675
0
        @artifacts = ($artifact);
676    }
677
0
    return @artifacts;
678}
679
680sub main {
681
0
0
    our $program;
682
0
    my ($bash_script, $first, $run);
683
0
    ($program, $bash_script, $first, $run) = @_;
684
0
    my $syntax = "$program <RUN_URL | OWNER/REPO RUN | ARTIFACT.zip>";
685    # Stages
686    # - 1 check for tools basic
687
0
    check_basic_tools();
688    # - 2 check for current
689    # -> 1. download the latest version to a temp file
690    # -> 2. parse current and latest (stripping comments) and compare (whitespace insensitively)
691    # -> 3. offer to update if the latest version is different
692
0
    check_current_script($bash_script);
693    # - 4 parse arguments
694
0
0
    CheckSpelling::Util::die_custom $program, 694, $syntax unless defined $first;
695
0
0
    $ENV{'GITHUB_API_URL'} ||= 'https://api.github.com';
696
0
    my $repo;
697    my @artifacts;
698
0
0
    if (-s $first) {
699
0
        @artifacts = extract_artifacts_from_file($first);
700    } else {
701
0
        my $suffix;
702
0
0
        if ($first =~ m{^\s*https://.*/([^/]+/[^/]+)/actions/runs/(\d+)(?:/attempts/\d+|)(?:#(\S+)|)\s*$}) {
703
0
            ($repo, $run, $suffix) = ($1, $2, $3);
704        } else {
705
0
            $repo = $first;
706        }
707
0
0
0
        CheckSpelling::Util::die_custom $program, 707, $syntax unless defined $repo && defined $run;
708        # - 3 check for tool readiness (is `gh` working)
709
0
        tools_are_ready($program);
710
0
        @artifacts = get_artifacts($repo, $run, $suffix);
711    }
712
713    # - 5 do work
714
0
    for my $artifact (@artifacts) {
715
0
        update_repository($artifact);
716    }
717}
718
719# main($0 ne '-' ? $0 : 'apply.pl', $bash_script, @ARGV);