File Coverage

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

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