File Coverage

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

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::LoadEnv;
4
5
2
2
2
2
111714
1
125
use feature 'unicode_strings';
6
2
2
2
2
230
4501
78
use Encode qw/decode_utf8 encode_utf8 FB_DEFAULT/;
7
2
2
2
2
382
54331
74
use YAML::PP;
8
2
2
2
2
326
5669
2206
use JSON::PP;
9
10my $json_canonical = JSON::PP->new->canonical([1])->utf8;
11
12sub print_var_val {
13
36
36
4248
    my ($var, $val) = @_;
14
36
100
33
    if ($var =~ /[-a-z]/) {
15
1
15
        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
68
    print qq<export INPUT_$var='$val';\n>;
20}
21
22sub expect_array {
23
7
7
3998
    my ($ref, $label) = @_;
24
7
5
    my $ref_kind = ref $ref;
25
7
100
100
17
    if ($ref eq '') {
26
1
1
        $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
8
    return $ref;
32}
33
34sub expect_map {
35
5
5
3902
    my ($ref, $label) = @_;
36
5
6
    my $ref_kind = ref $ref;
37
5
100
100
9
    if ($ref_kind eq '') {
38
1
1
        $ref = {};
39    } elsif ($ref_kind ne 'HASH') {
40
1
13
        print STDERR "'$label' was '$ref_kind' but should be a map (unsupported-configuration)\n";
41
1
1
        $ref = {};
42    }
43
5
5
    return $ref;
44}
45
46sub decode_key_val {
47
16
16
14
    my ($key, $val) = @_;
48
16
11
    my $ref_kind = ref $val;
49
16
50
50
27
    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
19
    return escape_var_val($key, $val);
55}
56
57sub array_to_map {
58
7
7
925
    my ($array_ref) = @_;
59
7
48
7
67
    return map { $_ => 1 } @$array_ref;
60}
61
62sub escape_var_val {
63
88
88
964
    my ($var, $val) = @_;
64
88
82
    $val =~ s/([\$])/\\$1/g;
65
88
45
    $val =~ s/'/'"'"'/g;
66
88
71
    $var = uc $var;
67
88
36
    $var =~ s/-/_/g;
68
88
83
    return ($var, $val);
69}
70
71sub parse_config_file {
72
9
9
1389
    my ($config_data) = @_;
73
9
24
    local $/ = undef;
74
9
2814
    my $base_config_data = <$config_data>;
75
9
746
    close $config_data;
76
9
100
39
    return decode_json($base_config_data || '{}');
77}
78
79sub read_config_from_sha {
80
2
2
4
    my ($github_head_sha, $parsed_inputs) = @_;
81
2
1
    my $file = get_json_config_path($parsed_inputs);
82
2
2867
    open (my $config_data, '-|:encoding(UTF-8)', qq<git show '$github_head_sha':'$file' || echo '{"broken":1}'>);
83
2
147
    return parse_config_file($config_data);
84}
85
86sub read_config_from_file {
87
5
5
5
    my ($parsed_inputs) = @_;
88
5
18
    open my $config_data, '<:encoding(UTF-8)', get_json_config_path($parsed_inputs);
89
5
145
    return parse_config_file($config_data);
90}
91
92sub parse_inputs {
93
2
2
509
    my ($load_config_from_key) = @_;
94
2
2
    my $input = $ENV{INPUTS};
95
2
1
    my %raw_inputs;
96
2
50
3
    if ($input) {
97
2
2
1
9
        %raw_inputs = %{decode_json(Encode::encode_utf8($input))};
98    }
99
2
1233
    my $maybe_load_inputs_from = $raw_inputs{$load_config_from_key};
100
2
0
    delete $raw_inputs{$load_config_from_key};
101
102
2
2
    my %inputs;
103
2
4
    for my $key (keys %raw_inputs) {
104
8
50
7
        next unless $key;
105
8
9
        my $val = $raw_inputs{$key};
106
8
5
        my $var = $key;
107
8
50
7
        if ($val =~ /^github_pat_/) {
108
0
0
            print STDERR "Censoring `$var` (unexpected-input-value)\n";
109
0
0
            next;
110        }
111
8
50
5
        next if $var =~ /\s/;
112
8
50
11
        next if $var =~ /[-_](?:key|token)$/;
113
8
100
100
19
        if ($var =~ /-/ && $raw_inputs{$var} ne '') {
114
1
1
            my $var_pattern = $var;
115
1
1
            $var_pattern =~ s/-/[-_]/g;
116
1
6
50
50
1
29
            my @vars = grep { /^${var_pattern}$/ && ($var ne $_) && $raw_inputs{$_} ne '' && $raw_inputs{$var} ne $raw_inputs{$_} } keys %raw_inputs;
117
1
50
1
            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
4
        ($var, $val) = escape_var_val($var, $val);
123
8
11
        $inputs{$var} = $val;
124    }
125
126
2
4
    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
8
    parse_action_config($parsed_inputs);
132
2
7
    return $parsed_inputs;
133}
134
135sub parse_action_config {
136
2
2
2
    my ($parsed_inputs) = @_;
137
2
4
    my $action_yml_path = $ENV{action_yml};
138
2
50
2
    return unless defined $action_yml_path;
139
140
2
3
    my $action = YAML::PP::LoadFile($action_yml_path);
141
2
50
315404
    return unless defined $action->{inputs};
142
2
2
2
8
    my %inputs = %{$parsed_inputs->{'inputs'}};
143
2
2
2
281
    my %action_inputs = %{$action->{inputs}};
144
2
37
    for my $key (sort keys %action_inputs) {
145
136
136
56
200
        my %ref = %{$action_inputs{$key}};
146
136
100
92
        next unless defined $ref{default};
147
120
50
96
        next if defined $inputs{$key};
148
120
62
        my $var = $key;
149
120
100
96
        next if $var =~ /[-_](?:key|token)$/i;
150
114
100
103
        if ($var =~ s/-/_/g) {
151
28
50
16
            next if defined $inputs{$var};
152        }
153
114
61
        my $val = $ref{default};
154
114
100
74
        next if $val eq '';
155
62
35
        ($var, $val) = escape_var_val($var, $val);
156
62
100
48
        next if defined $inputs{$var};
157
57
62
        $inputs{$var} = $val;
158    }
159
2
99
    $parsed_inputs->{'inputs'} = \%inputs;
160}
161
162sub get_supported_key_list {
163
2
2
14
    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
4
    return \@supported_key_list;
185}
186
187sub get_json_config_path {
188
8
8
1318
    my ($parsed_inputs) = @_;
189
8
50
26
    my $config = $ENV{INPUT_CONFIG} || $parsed_inputs->{'inputs'}{'CONFIG'} || '.github/actions/spelling';
190
8
94
    return "$config/config.json";
191}
192
193sub read_project_config {
194
5
5
5
    my ($parsed_inputs) = @_;
195
5
19
    return read_config_from_file($parsed_inputs);
196}
197
198sub load_untrusted_config {
199
2
2
32412
    my ($parsed_inputs, $event_name) = @_;
200
2
2
    my $maybe_load_inputs_from = $parsed_inputs->{'maybe_load_inputs_from'};
201
2
3
    my $load_config_from_key = $parsed_inputs->{'load_config_from_key'};
202
203
2
5
    my %supported_keys = array_to_map(get_supported_key_list);
204
205
2
50
29
    return unless defined $maybe_load_inputs_from;
206
2
50
4
    $maybe_load_inputs_from = decode_json $maybe_load_inputs_from unless ref $maybe_load_inputs_from eq 'HASH';
207
208
2
5
    $maybe_load_inputs_from = expect_map($maybe_load_inputs_from, $load_config_from_key);
209
2
6
    my %load_config_from = %$maybe_load_inputs_from;
210
2
3
    my $use_pr_base_keys = 'pr-base-keys';
211
2
3
    my $trust_pr_keys = 'pr-trusted-keys';
212
2
5
    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
3
    my @use_pr_base_key_list = @$use_pr_base_key;
215
2
3
    my @trust_pr_key_list = @$trust_pr_key;
216
2
50
6
    my %use_pr_base_key_map = array_to_map $use_pr_base_key if (defined $use_pr_base_key);
217
2
50
7
    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
4
    delete $trust_pr_key_map{''};
220
2
5
    for my $key (keys %trust_pr_key_map) {
221
4
50
5
        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
7
        unless (defined $supported_keys{$key}) {
226
2
3
            delete $trust_pr_key_map{$key};
227
2
25
            print STDERR "'$key' cannot be set in $trust_pr_keys of $load_config_from_key (unsupported-configuration)\n";
228        }
229    }
230
2
50
33
7
    return unless %use_pr_base_key_map or %trust_pr_key_map;
231
2
50
6
    if (%use_pr_base_key_map) {
232
2
6
        print STDERR "need to read base file\n";
233    }
234
235
2
50
5
    if (%trust_pr_key_map) {
236
2
3
        my ($maybe_dangerous, $local_config);
237
2
100
67
18
        if (defined $event_name && $event_name eq 'pull_request_target') {
238
1
1
            ($maybe_dangerous, $local_config) = (' (dangerous)', 'attacker');
239        } else {
240
1
1
            ($maybe_dangerous, $local_config) = ('', 'local');
241        }
242
243
2
10
        print STDERR "will read live file$maybe_dangerous\n";
244
2
2
0
7
        my %dangerous_config = %{read_project_config($parsed_inputs)};
245
2
900
        for my $key (sort keys %dangerous_config) {
246
10
100
9
            if (defined $trust_pr_key_map{$key}) {
247
2
2
                my $val = $dangerous_config{$key};
248
2
6
                ($key, $val) = decode_key_val($key, $val);
249
2
5
                print STDERR "Trusting '$key': '$val'\n";
250
2
7
                $parsed_inputs->{'inputs'}{$key} = $val;
251            } else {
252
8
28
                print STDERR "Ignoring '$key' from $local_config config\n";
253            }
254        }
255    }
256
257
2
50
5
    return unless %use_pr_base_key_map;
258
2
22
    open my $github_event_file, '<:encoding(UTF-8)', $ENV{GITHUB_EVENT_PATH};
259
2
45
    local $/ = undef;
260
2
24
    my $github_event_data = <$github_event_file>;
261
2
16
    close $github_event_file;
262
2
50
5
    my $github_event = decode_json ($github_event_data || '{}');
263
2
1159
    my $github_head_sha;
264
2
50
33
12
    $github_head_sha = $github_event->{'pull_request'}->{'base'}->{'sha'} if ($github_event->{'pull_request'} && $github_event->{'pull_request'}->{'base'});
265
266
2
2
3
3
    my %base_config = %{read_config_from_sha($github_head_sha, $parsed_inputs)};
267
2
791
    for my $key (sort keys %base_config) {
268
10
100
9
        if (defined $use_pr_base_key_map{$key}) {
269
4
8
            my ($var, $val);
270
4
5
            $val = $base_config{$key};
271
4
7
            ($var, $val) = decode_key_val($key, $val);
272
4
24
            print STDERR "Using '$key': '$val'\n";
273
4
9
            $parsed_inputs->{'inputs'}{$var} = $val;
274        } else {
275
6
120
            print STDERR "Ignoring '$key' from base config\n";
276        }
277    }
278}
279
280sub load_trusted_config {
281
3
3
2480
    my ($parsed_inputs) = @_;
282
3
3
5
3
    my %project_config = %{read_project_config($parsed_inputs)};
283
3
822
    for my $key (keys %project_config) {
284
10
9
        my ($var, $val) = decode_key_val($key, $project_config{$key});
285
10
14
        $parsed_inputs->{'inputs'}{$var} = $val;
286    }
287}
288
2891;