File Coverage

File:lib/CheckSpelling/LoadEnv.pm
Coverage:86.8%

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::LoadEnv;
4
5
2
2
2
2
117094
3
123
use feature 'unicode_strings';
6
2
2
2
2
205
4719
87
use Encode qw/decode_utf8 encode_utf8 FB_DEFAULT/;
7
2
2
2
2
388
56155
42
use YAML::PP;
8
2
2
2
2
335
5994
2257
use JSON::PP;
9
10my $json_canonical = JSON::PP->new->canonical([1])->utf8;
11
12sub print_var_val {
13
36
36
4054
    my ($var, $val) = @_;
14
36
100
34
    if ($var =~ /[-a-z]/) {
15
1
18
        print STDERR "Found improperly folded key in inputs '$var'\n";
16
1
2
        return;
17    }
18
35
100
26
    return if $val eq '';
19
34
51
    print qq<export INPUT_$var='$val';\n>;
20}
21
22sub expect_array {
23
7
7
3880
    my ($ref, $label) = @_;
24
7
7
    my $ref_kind = ref $ref;
25
7
100
100
13
    if ($ref eq '') {
26
1
2
        $ref = [];
27    } elsif (ref $ref ne 'ARRAY') {
28
1
15
        print STDERR "'$label' should be an array (unsupported-configuration)\n";
29
1
1
        $ref = [];
30    }
31
7
10
    return $ref;
32}
33
34sub expect_map {
35
5
5
3888
    my ($ref, $label) = @_;
36
5
8
    my $ref_kind = ref $ref;
37
5
100
100
13
    if ($ref_kind eq '') {
38
1
1
        $ref = {};
39    } elsif ($ref_kind ne 'HASH') {
40
1
16
        print STDERR "'$label' was '$ref_kind' but should be a map (unsupported-configuration)\n";
41
1
1
        $ref = {};
42    }
43
5
6
    return $ref;
44}
45
46sub decode_key_val {
47
16
16
16
    my ($key, $val) = @_;
48
16
16
    my $ref_kind = ref $val;
49
16
50
50
29
    if ($ref_kind eq 'HASH') {
50
0
0
        $val = $json_canonical->encode($val);
51    } elsif ($ref_kind eq 'ARRAY') {
52
0
0
        $val = join ' ', @$val;
53    }
54
16
22
    return escape_var_val($key, $val);
55}
56
57sub array_to_map {
58
7
7
904
    my ($array_ref) = @_;
59
7
48
8
71
    return map { $_ => 1 } @$array_ref;
60}
61
62sub escape_var_val {
63
88
88
878
    my ($var, $val) = @_;
64
88
71
    $val =~ s/([\$])/\\$1/g;
65
88
52
    $val =~ s/'/'"'"'/g;
66
88
73
    $var = uc $var;
67
88
37
    $var =~ s/-/_/g;
68
88
89
    return ($var, $val);
69}
70
71sub parse_config_file {
72
9
9
1401
    my ($config_data) = @_;
73
9
32
    local $/ = undef;
74
9
3472
    my $base_config_data = <$config_data>;
75
9
721
    close $config_data;
76
9
100
56
    return decode_json($base_config_data || '{}');
77}
78
79sub read_config_from_sha {
80
2
2
5
    my ($github_head_sha, $parsed_inputs) = @_;
81
2
4
    my $file = get_json_config_path($parsed_inputs);
82
2
3944
    open (my $config_data, '-|:encoding(UTF-8)', qq<git show '$github_head_sha':'$file' || echo '{"broken":1}'>);
83
2
169
    return parse_config_file($config_data);
84}
85
86sub read_config_from_file {
87
5
5
10
    my ($parsed_inputs) = @_;
88
5
17
    open my $config_data, '<:encoding(UTF-8)', get_json_config_path($parsed_inputs);
89
5
172
    return parse_config_file($config_data);
90}
91
92sub parse_inputs {
93
2
2
508
    my ($load_config_from_key) = @_;
94
2
3
    my $input = $ENV{INPUTS};
95
2
1
    my %raw_inputs;
96
2
50
3
    if ($input) {
97
2
2
2
10
        %raw_inputs = %{decode_json(Encode::encode_utf8($input))};
98    }
99
2
1216
    my $maybe_load_inputs_from = $raw_inputs{$load_config_from_key};
100
2
3
    delete $raw_inputs{$load_config_from_key};
101
102
2
2
    my %inputs;
103
2
3
    for my $key (keys %raw_inputs) {
104
8
50
11
        next unless $key;
105
8
8
        my $val = $raw_inputs{$key};
106
8
4
        my $var = $key;
107
8
50
8
        if ($val =~ /^github_pat_/) {
108
0
0
            print STDERR "Censoring `$var` (unexpected-input-value)\n";
109
0
0
            next;
110        }
111
8
50
9
        next if $var =~ /\s/;
112
8
50
8
        next if $var =~ /[-_](?:key|token)$/;
113
8
100
100
23
        if ($var =~ /-/ && $raw_inputs{$var} ne '') {
114
1
1
            my $var_pattern = $var;
115
1
5
            $var_pattern =~ s/-/[-_]/g;
116
1
6
50
50
2
28
            my @vars = grep { /^${var_pattern}$/ && ($var ne $_) && $raw_inputs{$_} ne '' && $raw_inputs{$var} ne $raw_inputs{$_} } keys %raw_inputs;
117
1
50
2
            if (@vars) {
118
0
0
0
0
                print STDERR 'Found conflicting inputs for '.$var." ($raw_inputs{$var}): ".join(', ', map { "$_ ($raw_inputs{$_})" } @vars)." (migrate-underscores-to-dashes)\n";
119            }
120
1
2
            $var =~ s/-/_/g;
121        }
122
8
9
        ($var, $val) = escape_var_val($var, $val);
123
8
14
        $inputs{$var} = $val;
124    }
125
126
2
5
    my $parsed_inputs = {
127        maybe_load_inputs_from => $maybe_load_inputs_from,
128        load_config_from_key => $load_config_from_key,
129        inputs => \%inputs,
130    };
131
2
7
    parse_action_config($parsed_inputs);
132
2
10
    return $parsed_inputs;
133}
134
135sub parse_action_config {
136
2
2
3
    my ($parsed_inputs) = @_;
137
2
2
    my $action_yml_path = $ENV{action_yml};
138
2
50
2
    return unless defined $action_yml_path;
139
140
2
6
    my $action = YAML::PP::LoadFile($action_yml_path);
141
2
50
317456
    return unless defined $action->{inputs};
142
2
2
3
11
    my %inputs = %{$parsed_inputs->{'inputs'}};
143
2
2
3
427
    my %action_inputs = %{$action->{inputs}};
144
2
40
    for my $key (sort keys %action_inputs) {
145
136
136
58
211
        my %ref = %{$action_inputs{$key}};
146
136
100
97
        next unless defined $ref{default};
147
120
50
81
        next if defined $inputs{$key};
148
120
62
        my $var = $key;
149
120
100
104
        next if $var =~ /[-_](?:key|token)$/i;
150
114
100
91
        if ($var =~ s/-/_/g) {
151
28
50
25
            next if defined $inputs{$var};
152        }
153
114
60
        my $val = $ref{default};
154
114
100
89
        next if $val eq '';
155
62
39
        ($var, $val) = escape_var_val($var, $val);
156
62
100
53
        next if defined $inputs{$var};
157
57
60
        $inputs{$var} = $val;
158    }
159
2
98
    $parsed_inputs->{'inputs'} = \%inputs;
160}
161
162sub get_supported_key_list {
163
2
2
16
    my @supported_key_list = qw(
164        check_file_names
165        dictionary_source_prefixes
166        dictionary_url
167        dictionary_version
168        extra_dictionaries
169        extra_dictionary_limit
170        errors
171        notices
172        longest_word
173        lower-pattern
174        punctuation-pattern
175        upper-pattern
176        ignore-pattern
177        lower-pattern
178        not-lower-pattern
179        not-upper-or-lower-pattern
180        punctuation-pattern
181        upper-pattern
182        warnings
183    );
184
2
40
    return \@supported_key_list;
185}
186
187sub get_json_config_path {
188
8
8
1289
    my ($parsed_inputs) = @_;
189
8
50
27
    my $config = $ENV{INPUT_CONFIG} || $parsed_inputs->{'inputs'}{'CONFIG'} || '.github/actions/spelling';
190
8
122
    return "$config/config.json";
191}
192
193sub read_project_config {
194
5
5
7
    my ($parsed_inputs) = @_;
195
5
16
    return read_config_from_file($parsed_inputs);
196}
197
198sub load_untrusted_config {
199
2
2
35272
    my ($parsed_inputs, $event_name) = @_;
200
2
5
    my $maybe_load_inputs_from = $parsed_inputs->{'maybe_load_inputs_from'};
201
2
4
    my $load_config_from_key = $parsed_inputs->{'load_config_from_key'};
202
203
2
6
    my %supported_keys = array_to_map(get_supported_key_list);
204
205
2
50
6
    return unless defined $maybe_load_inputs_from;
206
2
50
5
    $maybe_load_inputs_from = decode_json $maybe_load_inputs_from unless ref $maybe_load_inputs_from eq 'HASH';
207
208
2
7
    $maybe_load_inputs_from = expect_map($maybe_load_inputs_from, $load_config_from_key);
209
2
10
    my %load_config_from = %$maybe_load_inputs_from;
210
2
2
    my $use_pr_base_keys = 'pr-base-keys';
211
2
3
    my $trust_pr_keys = 'pr-trusted-keys';
212
2
8
    my $use_pr_base_key = expect_array($load_config_from{$use_pr_base_keys}, "$load_config_from_key->$use_pr_base_keys");
213
2
4
    my $trust_pr_key = expect_array($load_config_from{$trust_pr_keys}, "$load_config_from_key->$use_pr_base_keys");
214
2
5
    my @use_pr_base_key_list = @$use_pr_base_key;
215
2
3
    my @trust_pr_key_list = @$trust_pr_key;
216
2
50
7
    my %use_pr_base_key_map = array_to_map $use_pr_base_key if (defined $use_pr_base_key);
217
2
50
9
    my %trust_pr_key_map = array_to_map $trust_pr_key if (defined $trust_pr_key);
218
2
2
    delete $use_pr_base_key_map{''};
219
2
3
    delete $trust_pr_key_map{''};
220
2
5
    for my $key (keys %trust_pr_key_map) {
221
4
50
8
        if (defined $use_pr_base_key_map{$key}) {
222
0
0
            delete $trust_pr_key_map{$key};
223
0
0
            print STDERR "'$key' found in both $use_pr_base_keys and $trust_pr_keys of $load_config_from_key (unsupported-configuration)\n";
224        }
225
4
100
9
        unless (defined $supported_keys{$key}) {
226
2
3
            delete $trust_pr_key_map{$key};
227
2
31
            print STDERR "'$key' cannot be set in $trust_pr_keys of $load_config_from_key (unsupported-configuration)\n";
228        }
229    }
230
2
50
33
9
    return unless %use_pr_base_key_map or %trust_pr_key_map;
231
2
50
9
    if (%use_pr_base_key_map) {
232
2
10
        print STDERR "need to read base file\n";
233    }
234
235
2
50
5
    if (%trust_pr_key_map) {
236
2
7
        my ($maybe_dangerous, $local_config);
237
2
100
67
18
        if (defined $event_name && $event_name eq 'pull_request_target') {
238
1
2
            ($maybe_dangerous, $local_config) = (' (dangerous)', 'attacker');
239        } else {
240
1
2
            ($maybe_dangerous, $local_config) = ('', 'local');
241        }
242
243
2
6
        print STDERR "will read live file$maybe_dangerous\n";
244
2
2
4
9
        my %dangerous_config = %{read_project_config($parsed_inputs)};
245
2
892
        for my $key (sort keys %dangerous_config) {
246
10
100
11
            if (defined $trust_pr_key_map{$key}) {
247
2
2
                my $val = $dangerous_config{$key};
248
2
4
                ($key, $val) = decode_key_val($key, $val);
249
2
8
                print STDERR "Trusting '$key': '$val'\n";
250
2
8
                $parsed_inputs->{'inputs'}{$key} = $val;
251            } else {
252
8
22
                print STDERR "Ignoring '$key' from $local_config config\n";
253            }
254        }
255    }
256
257
2
50
3
    return unless %use_pr_base_key_map;
258
2
26
    open my $github_event_file, '<:encoding(UTF-8)', $ENV{GITHUB_EVENT_PATH};
259
2
46
    local $/ = undef;
260
2
41
    my $github_event_data = <$github_event_file>;
261
2
17
    close $github_event_file;
262
2
50
20
    my $github_event = decode_json ($github_event_data || '{}');
263
2
1199
    my $github_head_sha;
264
2
50
33
19
    $github_head_sha = $github_event->{'pull_request'}->{'base'}->{'sha'} if ($github_event->{'pull_request'} && $github_event->{'pull_request'}->{'base'});
265
266
2
2
2
5
    my %base_config = %{read_config_from_sha($github_head_sha, $parsed_inputs)};
267
2
873
    for my $key (sort keys %base_config) {
268
10
100
12
        if (defined $use_pr_base_key_map{$key}) {
269
4
8
            my ($var, $val);
270
4
6
            $val = $base_config{$key};
271
4
9
            ($var, $val) = decode_key_val($key, $val);
272
4
35
            print STDERR "Using '$key': '$val'\n";
273
4
11
            $parsed_inputs->{'inputs'}{$var} = $val;
274        } else {
275
6
142
            print STDERR "Ignoring '$key' from base config\n";
276        }
277    }
278}
279
280sub load_trusted_config {
281
3
3
2623
    my ($parsed_inputs) = @_;
282
3
3
4
26
    my %project_config = %{read_project_config($parsed_inputs)};
283
3
862
    for my $key (keys %project_config) {
284
10
10
        my ($var, $val) = decode_key_val($key, $project_config{$key});
285
10
15
        $parsed_inputs->{'inputs'}{$var} = $val;
286    }
287}
288
2891;