File Coverage

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

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