File Coverage

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

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