File Coverage

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

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