tbb-testsuite 8.49 KB
Newer Older
1
2
3
4
5
6
#!/usr/bin/perl -w
use strict;
use Getopt::Long;
use Cwd qw(getcwd);
use File::Spec;
use File::Temp;
boklm's avatar
boklm committed
7
use File::Slurp;
8
use File::Path qw(make_path);
9
10
use Data::Dump qw/dd/;
use FindBin;
boklm's avatar
boklm committed
11
use LWP::UserAgent;
boklm's avatar
boklm committed
12
use Digest::SHA qw(sha256_hex);
boklm's avatar
boklm committed
13
14
use IO::CaptureOutput qw(capture_exec);
use IO::Socket::INET;
15
16
use JSON;
use File::Copy;
17
18

my %default_options = (
boklm's avatar
boklm committed
19
20
    os       => 'Linux',
    arch     => 'x86_64',
21
22
    mozmill  => 1,
    selenium => 1,
boklm's avatar
boklm committed
23
24
25
    starttor => 1,
    'tor-control-port' => '9551',
    'tor-socks-port'   => '9550',
26
27
28
29
);
my $options = get_options(@ARGV);
sub exit_error {
    print STDERR "Error: ", $_[0], "\n";
boklm's avatar
boklm committed
30
    chdir '/';
31
32
33
34
    exit (exists $_[1] ? $_[1] : 1);
}

sub get_options {
boklm's avatar
boklm committed
35
    my @options = qw(mozmill! selenium! starttor! tor-control-port=i
36
                     tor-socks-port=i reports-dir=s);
37
38
    my %res = %default_options;
    Getopt::Long::GetOptionsFromArray(\@_, \%res, @options) || exit 1;
39
    $res{files} = \@_;
40
41
42
    return \%res;
}

43
44
45
46
47
48
49
50
51
52
53
54
55
sub set_reports_dir {
    if ($options->{'reports-dir'}) {
        make_path($options->{'reports-dir'});
        return;
    }
    my $r = $FindBin::Bin . '/reports';
    mkdir $r;
    return $options->{'reports-dir'} = File::Temp::newdir(
        'XXXXXX',
        DIR => $r,
        CLEANUP => 0)->dirname;
}

boklm's avatar
boklm committed
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
sub get_tbbfile {
    my ($tbbfile) = @_;
    if ($tbbfile =~ m/^https?:\/\//) {
        print "Downloading $tbbfile\n";
        my (undef, undef, $file) = File::Spec->splitpath($tbbfile);
        my $output = "$options->{tbbinfos}{tmpdir}/$file";
        my $ua = LWP::UserAgent->new;
        my $resp = $ua->get($tbbfile, ':content_file' => $output);
        exit_error "Error downloading $tbbfile:\n" . $resp->status_line
                unless $resp->is_success;
        return $output;
    }
    exit_error "File $tbbfile does not exist" unless -f $tbbfile;
    return $tbbfile;
}

72
73
74
sub tbb_filename_infos {
    my ($tbbfile) = @_;
    my (undef, undef, $file) = File::Spec->splitpath($tbbfile);
75
    my %res = (filename => $file);
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
    if ($file =~ m/^tor-browser-linux(..)-([^_]+)_(.+)\.tar\.xz$/) {
        @res{qw(type os version language)} = ('tbbfile', 'Linux', $2, $3);
        $res{arch} = $1 eq '64' ? 'x86_64' : 'x86';
    } elsif ($file =~ m/^torbrowser-install-([^_]+)_(.+)\.exe$/) {
        @res{qw(type os arch version language)} =
                ('tbbfile', 'Windows', 'x86', $1, $2);
    } elsif ($file =~ m/^TorBrowserBundle-(.+)-osx32_(.+)\.zip$/) {
        @res{qw(type os arch version language)} =
                ('tbbfile', 'MacOSX', 'x86', $1, $2);
    } elsif ($file eq 'sha256sums.txt') {
        $res{type} = 'sha256sum';
    } else {
        $res{type} = 'Unknown';
    }
    return \%res;
}
92
93
94
95
96

sub extract_tbb {
    my ($tbbfile) = @_;
    exit_error "Can't open file $tbbfile" unless -f $tbbfile;
    $tbbfile = File::Spec->rel2abs($tbbfile);
boklm's avatar
boklm committed
97
    my $tmpdir = $options->{tbbinfos}{tmpdir};
98
99
    chdir $tmpdir;
    system('tar', 'xf', $tbbfile);
100
    return "$tmpdir/tor-browser_$options->{tbbinfos}{language}";
101
102
103
}

sub setup_tbb {
104
    $ENV{TOR_SKIP_LAUNCH} = 1;
105
106
}

boklm's avatar
boklm committed
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
sub monitor_bootstrap {
    my ($control_passwd) = @_;
    sleep 10;
    my $sock = new IO::Socket::INET(
        PeerAddr => 'localhost',
        PeerPort => $options->{'tor-control-port'},
        Proto => 'tcp',
    );
    exit_error "Error connecting to control port: $!\n" unless $sock;
    print $sock 'AUTHENTICATE "', $control_passwd, "\"\n";
    my $r = <$sock>;
    exit_error "Authentication error: $r" unless $r =~ m/^250 OK/;
    my $i = 0;
    while (1) {
        print $sock "GETINFO status/bootstrap-phase\n";
        $r = <$sock>;
        print $r;
        last if $r =~ m/^250-status\/bootstrap-phase.* TAG=done/;
        sleep 1;
        $i++;
        exit_error "Could not bootstrap after $i seconds" if $i > 300;
    }
    print "Bootstraping done\n";
    return 3;
}

# TODO: In the future, we should start tor using tor-launcher
sub start_tor {
    return unless $options->{starttor};
    my $control_passwd = map { ('a'..'z', 'A'..'Z', 0..9)[rand 62] } 0..8;
    my $cwd = getcwd;
    $ENV{LD_LIBRARY_PATH} = "$cwd/Tor/";
    $ENV{TOR_SOCKS_PORT} = $options->{'tor-socks-port'};
    $ENV{TOR_CONTROL_PORT} = $options->{'tor-control-port'};
    $ENV{TOR_CONTROL_HOST} = '127.0.0.1';
    $ENV{TOR_CONTROL_COOKIE_AUTH_FILE} = "$cwd/Data/Tor/control_auth_cookie";
    my ($hashed_password, undef, $success) =
        capture_exec("$cwd/Tor/tor", '--quiet', '--hash-password', $control_passwd);
    exit_error "Error running tor --hash-password" unless $success;
    chomp $hashed_password;
    my @torrc = read_file('Data/Tor/torrc-defaults');
    foreach (@torrc) {
        s/^ControlPort .*/ControlPort $options->{'tor-control-port'}/;
        s/^SocksPort .*/SocksPort $options->{'tor-socks-port'}/;
    }
    write_file('Data/Tor/torrc-defaults', @torrc);
    my @cmd = ("$cwd/Tor/tor", '--defaults-torrc', "$cwd/Data/Tor/torrc-defaults",
        '-f', "$cwd/Data/Tor/torrc", 'DataDirectory', "$cwd/Data/Tor",
        'GeoIPFile', "$cwd/Data/Tor/geoip", '__OwningControllerProcess', $$,
        'HashedControlPassword', $hashed_password);
    $options->{tbbinfos}{torpid} = fork;
    if ($options->{tbbinfos}{torpid} == 0) {
        open(STDOUT, '>', '/dev/null');
        open(STDERR, '>', '/dev/null');
        exec @cmd;
    }
    return monitor_bootstrap($control_passwd);
}

sub stop_tor {
    return unless $options->{starttor};
    kill 9, $options->{tbbinfos}{torpid};
}

171
sub mozmill_run {
172
173
174
175
176
177
    my ($test) = @_;
    $test->{screenshots} = [];
    my %res = ( screenshots => [], );
    my $screenshots_tmp = File::Temp::newdir;
    $ENV{'MOZMILL_SCREENSHOTS'} = $screenshots_tmp;
    my $results_file = "$options->{tbbinfos}{'results-dir'}/$test->{name}.json";
178
179
    system('mozmill', '-b', "$options->{tbbdir}/Browser/firefox", '-p',
        "$options->{tbbdir}/Data/Browser/profile.default", '-t',
180
181
182
183
184
185
186
187
188
        "$FindBin::Bin/mozmill-tests/tbb-tests/$test->{name}.js",
        '--report', "file://$results_file");
    my $i = 0;
    for my $screenshot_file (glob "$screenshots_tmp/*.png") {
        move($screenshot_file, "$options->{tbbinfos}{'results-dir'}/$test->{name}-$i.png");
        push @{$test->{screenshots}}, "$test-$i.png";
        $i++;
    }
    $test->{results} = decode_json(read_file($results_file));
189
190
191
}

sub mozmill_tests {
192
    return unless $options->{mozmill};
193
    my @tests = ({ name => 'tbbScreenshot', });
194
195
196
197
198
    foreach my $test (@tests) {
        mozmill_run($test);
    }
}

boklm's avatar
boklm committed
199
sub selenium_tests {
200
    return unless $options->{selenium};
boklm's avatar
boklm committed
201
202
203
204
205
206
207
208
209
210
    my @tests = (
        'test_check.tpo.py',
    );
    $ENV{TBB_BIN} = "$options->{tbbdir}/Browser/firefox";
    $ENV{TBB_PROFILE} = "$options->{tbbdir}/Data/Browser/profile.default";
    foreach my $test (@tests) {
        system("$FindBin::Bin/selenium-tests/$test");
    }
}

boklm's avatar
boklm committed
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
sub matching_tbbfile {
    my $o = tbb_filename_infos($_[0]);
    return $o->{type} eq 'tbbfile' && $o->{os} eq $options->{os}
        && $o->{arch} eq $options->{arch};
}

sub test_sha {
    my ($shafile) = @_;
    my $content;
    if ($shafile =~ m/^https?:\/\//) {
        my $ua = LWP::UserAgent->new;
        my $resp = $ua->get($shafile);
        exit_error "Error downloading $shafile:\n" . $resp->status_line
                unless $resp->is_success;
        $content = $resp->decoded_content;
    } else {
        $content = read_file($shafile);
    }
    my (undef, $dir) = File::Spec->splitpath($shafile);
    my @files = map { [ reverse split /  /, $_ ] } split /\n/, $content;
    @files = grep { matching_tbbfile($_->[0]) } @files;
    foreach my $file (@files) {
        test_tbb("$dir/$file->[0]", $file->[1]);
    }
}

237
sub test_tbb {
boklm's avatar
boklm committed
238
    my ($tbbfile, $sha256sum) = @_;
239
    my $oldcwd = getcwd;
240
    $options->{tbbinfos} = tbb_filename_infos($tbbfile);
boklm's avatar
boklm committed
241
    return test_sha($tbbfile) if $options->{tbbinfos}{type} eq 'sha256sum';
boklm's avatar
boklm committed
242
243
    $options->{tbbinfos}{tmpdir} = File::Temp::newdir;
    $tbbfile = get_tbbfile($tbbfile);
boklm's avatar
boklm committed
244
245
246
    if ($sha256sum && $sha256sum ne sha256_hex(read_file($tbbfile))) {
        exit_error "Wrong sha256sum for $tbbfile";
    }
247
248
249
    $options->{tbbinfos}{'results-dir'} =
        "$options->{'reports-dir'}/results-$options->{tbbinfos}{filename}";
    mkdir $options->{tbbinfos}{'results-dir'};
250
251
    $options->{tbbdir} = extract_tbb($tbbfile);
    chdir $options->{tbbdir} || exit_error "Can't enter directory $options->{tbbdir}";
boklm's avatar
boklm committed
252
    start_tor;
253
254
255
256
257
    setup_tbb;
    print "tbbdir: $options->{tbbdir}\n";
    mozmill_tests;
    selenium_tests;
    chdir $oldcwd;
boklm's avatar
boklm committed
258
    stop_tor;
259
}
260

261
set_reports_dir;
262
263
264
foreach my $tbbfile (@{$options->{files}}) {
    test_tbb($tbbfile);
}
265
print "Reports directory: $options->{'reports-dir'}\n";