File Coverage

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

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