1#***************************************************************************
2#                                  _   _ ____  _
3#  Project                     ___| | | |  _ \| |
4#                             / __| | | | |_) | |
5#                            | (__| |_| |  _ <| |___
6#                             \___|\___/|_| \_\_____|
7#
8# Copyright (C) 1998 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al.
9#
10# This software is licensed as described in the file COPYING, which
11# you should have received as part of this distribution. The terms
12# are also available at https://curl.haxx.se/docs/copyright.html.
13#
14# You may opt to use, copy, modify, merge, publish, distribute and/or sell
15# copies of the Software, and permit persons to whom the Software is
16# furnished to do so, under the terms of the COPYING file.
17#
18# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
19# KIND, either express or implied.
20#
21###########################################################################
22
23#use strict;
24
25my @xml;
26my $xmlfile;
27
28my $warning=0;
29my $trace=0;
30
31use MIME::Base64;
32
33sub decode_hex {
34    my $s = $_;
35    # remove everything not hex
36    $s =~ s/[^A-Fa-f0-9]//g;
37    # encode everything
38    $s =~ s/([a-fA-F0-9][a-fA-F0-9])/chr(hex($1))/eg;
39    return $s;
40}
41
42sub getpartattr {
43    # if $part is undefined (ie only one argument) then
44    # return the attributes of the section
45
46    my ($section, $part)=@_;
47
48    my %hash;
49    my $inside=0;
50
51 #   print "Section: $section, part: $part\n";
52
53    for(@xml) {
54 #       print "$inside: $_";
55        if(!$inside && ($_ =~ /^ *\<$section/)) {
56            $inside++;
57        }
58        if((1 ==$inside) && ( ($_ =~ /^ *\<$part([^>]*)/) ||
59                              !(defined($part)) )
60             ) {
61            $inside++;
62            my $attr=$1;
63
64            while($attr =~ s/ *([^=]*)= *(\"([^\"]*)\"|([^\> ]*))//) {
65                my ($var, $cont)=($1, $2);
66                $cont =~ s/^\"(.*)\"$/$1/;
67                $hash{$var}=$cont;
68            }
69            last;
70        }
71        # detect end of section when part wasn't found
72        elsif((1 ==$inside) && ($_ =~ /^ *\<\/$section\>/)) {
73            last;
74        }
75        elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
76            $inside--;
77        }
78    }
79    return %hash;
80}
81
82sub getpart {
83    my ($section, $part)=@_;
84
85    my @this;
86    my $inside=0;
87    my $base64=0;
88    my $hex=0;
89    my $line;
90
91    for(@xml) {
92        $line++;
93        if(!$inside && ($_ =~ /^ *\<$section/)) {
94            $inside++;
95        }
96        elsif(($inside >= 1) && ($_ =~ /^ *\<$part[ \>]/)) {
97            if($inside > 1) {
98                push @this, $_;
99            }
100            elsif($_ =~ /$part [^>]*base64=/) {
101                # attempt to detect our base64 encoded part
102                $base64=1;
103            }
104            elsif($_ =~ /$part [^>]*hex=/) {
105                # attempt to detect a hex-encoded part
106                $hex=1;
107            }
108            $inside++;
109        }
110        elsif(($inside >= 2) && ($_ =~ /^ *\<\/$part[ \>]/)) {
111            if($inside > 2) {
112                push @this, $_;
113            }
114            $inside--;
115        }
116        elsif(($inside >= 1) && ($_ =~ /^ *\<\/$section/)) {
117            if($inside > 1) {
118                print STDERR "$xmlfile:$line:1: error: missing </$part> tag before </$section>\n";
119                @this = ("format error in $xmlfile");
120            }
121            if($trace && @this) {
122                print STDERR "*** getpart.pm: $section/$part returned data!\n";
123            }
124            if($warning && !@this) {
125                print STDERR "*** getpart.pm: $section/$part returned empty!\n";
126            }
127            if($base64) {
128                # decode the whole array before returning it!
129                for(@this) {
130                    my $decoded = decode_base64($_);
131                    $_ = $decoded;
132                }
133            }
134            elsif($hex) {
135                # decode the whole array before returning it!
136                for(@this) {
137                    my $decoded = decode_hex($_);
138                    $_ = $decoded;
139                }
140            }
141            return @this;
142        }
143        elsif($inside >= 2) {
144            push @this, $_;
145        }
146    }
147    if($trace && @this) {
148        # section/part has data but end of section not detected,
149        # end of file implies end of section.
150        print STDERR "*** getpart.pm: $section/$part returned data!\n";
151    }
152    if($warning && !@this) {
153        # section/part does not exist or has no data without an end of
154        # section; end of file implies end of section.
155        print STDERR "*** getpart.pm: $section/$part returned empty!\n";
156    }
157    return @this;
158}
159
160sub partexists {
161    my ($section, $part)=@_;
162
163    my $inside = 0;
164
165    for(@xml) {
166        if(!$inside && ($_ =~ /^ *\<$section/)) {
167            $inside++;
168        }
169        elsif((1 == $inside) && ($_ =~ /^ *\<$part[ \>]/)) {
170            return 1; # exists
171        }
172        elsif((1 == $inside) && ($_ =~ /^ *\<\/$section/)) {
173            return 0; # does not exist
174        }
175    }
176    return 0; # does not exist
177}
178
179# Return entire document as list of lines
180sub getall {
181    return @xml;
182}
183
184sub loadtest {
185    my ($file)=@_;
186
187    undef @xml;
188    $xmlfile = $file;
189
190    if(open(XML, "<$file")) {
191        binmode XML; # for crapage systems, use binary
192        while(<XML>) {
193            push @xml, $_;
194        }
195        close(XML);
196    }
197    else {
198        # failure
199        if($warning) {
200            print STDERR "file $file wouldn't open!\n";
201        }
202        return 1;
203    }
204    return 0;
205}
206
207sub fulltest {
208    return @xml;
209}
210
211# write the test to the given file
212sub savetest {
213    my ($file)=@_;
214
215    if(open(XML, ">$file")) {
216        binmode XML; # for crapage systems, use binary
217        for(@xml) {
218            print XML $_;
219        }
220        close(XML);
221    }
222    else {
223        # failure
224        if($warning) {
225            print STDERR "file $file wouldn't open!\n";
226        }
227        return 1;
228    }
229    return 0;
230}
231
232#
233# Strip off all lines that match the specified pattern and return
234# the new array.
235#
236
237sub striparray {
238    my ($pattern, $arrayref) = @_;
239
240    my @array;
241
242    for(@$arrayref) {
243        if($_ !~ /$pattern/) {
244            push @array, $_;
245        }
246    }
247    return @array;
248}
249
250#
251# pass array *REFERENCES* !
252#
253sub compareparts {
254 my ($firstref, $secondref)=@_;
255
256 my $first = join("", @$firstref);
257 my $second = join("", @$secondref);
258
259 # we cannot compare arrays index per index since with the base64 chunks,
260 # they may not be "evenly" distributed
261
262 # NOTE: this no longer strips off carriage returns from the arrays. Is that
263 # really necessary? It ruins the testing of newlines. I believe it was once
264 # added to enable tests on win32.
265
266 if($first ne $second) {
267     return 1;
268 }
269
270 return 0;
271}
272
273#
274# Write a given array to the specified file
275#
276sub writearray {
277    my ($filename, $arrayref)=@_;
278
279    open(TEMP, ">$filename");
280    binmode(TEMP,":raw"); # cygwin fix by Kevin Roth
281    for(@$arrayref) {
282        print TEMP $_;
283    }
284    close(TEMP);
285}
286
287#
288# Load a specified file and return it as an array
289#
290sub loadarray {
291    my ($filename)=@_;
292    my @array;
293
294    open(TEMP, "<$filename");
295    while(<TEMP>) {
296        push @array, $_;
297    }
298    close(TEMP);
299    return @array;
300}
301
302# Given two array references, this function will store them in two temporary
303# files, run 'diff' on them, store the result and return the diff output!
304
305sub showdiff {
306    my ($logdir, $firstref, $secondref)=@_;
307
308    my $file1="$logdir/check-generated";
309    my $file2="$logdir/check-expected";
310
311    open(TEMP, ">$file1");
312    for(@$firstref) {
313        my $l = $_;
314        $l =~ s/\r/[CR]/g;
315        $l =~ s/\n/[LF]/g;
316        print TEMP $l;
317        print TEMP "\n";
318    }
319    close(TEMP);
320
321    open(TEMP, ">$file2");
322    for(@$secondref) {
323        my $l = $_;
324        $l =~ s/\r/[CR]/g;
325        $l =~ s/\n/[LF]/g;
326        print TEMP $l;
327        print TEMP "\n";
328    }
329    close(TEMP);
330    my @out = `diff -u $file2 $file1 2>/dev/null`;
331
332    if(!$out[0]) {
333        @out = `diff -c $file2 $file1 2>/dev/null`;
334    }
335
336    return @out;
337}
338
339
3401;
341