/automation/test_harness.pl

  1#!/usr/bin/env perl
  2
  3###########################################################################
  4##
  5##  Copyright (c) 2010, Aaron Kulick, CBS Interactive 
  6##  All rights reserved.
  7##
  8##  THANK YOU:
  9##  The author would specifically like to thank the people on the IRC
 10##  server irc.perl.org in channel #poe for there extreme patience and
 11##  incalculable assistance without which this script would not work.
 12##
 13##  LICENSE:
 14##  Redistribution and use in source and binary forms, with or without 
 15##  modification, are permitted provided that the following conditions 
 16##  are met:
 17##
 18##     * Redistributions of source code must retain the above copyright 
 19##          notice, this list of conditions and the following disclaimer.
 20##     * Redistributions in binary form must reproduce the above 
 21##          copyright notice, this list of conditions and the following 
 22##          disclaimer in the documentation and/or other materials 
 23##          provided with the distribution.
 24##     * Neither the name of the CBS Interactive nor the names of its 
 25##          contributors may be used to endorse or promote products 
 26##          derived from this software without specific prior written 
 27##          permission.
 28##
 29##  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 
 30##  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 
 31##  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 
 32##  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
 33##  HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
 34##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 
 35##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
 36##  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 
 37##  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 
 38##  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 
 39##  OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 40##
 41##  CONTACT -=> Aaron Kulick <aaron.kulick@cbs.com>
 42##
 43###########################################################################
 44
 45
 46###########################################################################
 47##
 48##  POE code blocks sourced from the POE Cookbook where indicated:
 49##      URL: http://poe.perl.org/?POE_Cookbook/Child_Processes_3
 50##
 51##  All rights and copyright rest with the original author(s).
 52##
 53##  The recipes are distributed under the same terms as POE itself. 
 54##  POE, in turn, is distributed under the same terms as Perl.
 55##
 56##  Please see http://dev.perl.org/licenses/ for the full body of the 
 57##  Perl license.
 58##
 59###########################################################################
 60
 61
 62use warnings;
 63use strict;
 64
 65
 66###########################################################################
 67##
 68## Global Variable Initialization
 69##
 70###########################################################################
 71my $SCRIPT_VERSION = "1.0.0";
 72my $SCRIPT_INFO = "Copyright 2010 - Aaron Kulick <aaron.kulick\@cbs.com>";
 73my $SCRIPT_URL = "http://code.google.com/p/showslow/source/browse/trunk/automation/test_harness.pl";
 74my $debug;
 75my $firefox = "/usr/bin/firefox";
 76my $help;
 77my @mozprofile;
 78my $number_ff_profiles;
 79my $quiet;
 80my @sessions;
 81my @source;
 82my @tasks;
 83my @testurls;
 84my @threads;
 85my $timeout = 60;
 86my $version;
 87my $x11_display;
 88
 89
 90# Avoid zombies...  argghh... want Brains!
 91$SIG{CHLD} = 'IGNORE';
 92
 93
 94use LWP::UserAgent;
 95use Getopt::Long;
 96use Time::HiRes qw(time);
 97
 98
 99# Perl Object Environment - http://poe.perl.org/
100use POE qw(Wheel::Run Filter::Reference);
101
102
103# POE::Component::TSTP - handle control-z (if installed)
104eval { require POE::Component::TSTP }
105  and do { POE::Component::TSTP->create() if !$@; };
106
107
108# subroutine - provides usage/help
109sub usage {
110    my $message = $_[0];
111    if ( defined $message && length $message ) {
112        $message .= "\n"
113          unless $message =~ /\n$/;
114    }
115
116    my $command = $0;
117    $command =~ s#^.*/##;
118
119    print STDERR (
120        $message,
121        "\n"
122          . "usage:  $command --display <DISPLAY> --firefox <PATH> --source <URL> \\\n"
123          . "            --profile <PATH> [--timeout <SECONDS>] [--quiet] [--verbose]\n\n"
124          . "    --display  x11 display ( e.g. ':99' )\n"
125          . "    --firefox  path to Firefox binary ( default = /usr/bin/firefox )\n"
126          . "    --profile  path to Firefox profile ( e.g. /home/foo/profile )\n"
127          . "    --source   uniform resource locator ( e.g. http://www.example.com/list )\n"
128	  . "    --quiet    supress debug messages ( default TRUE )\n"
129          . "    --timeout  thread execution timeout in seconds ( default = 60 )\n"
130          . "    --verbose  enable verbose ouput to STDOUT ( default FALSE )\n" 
131          . "    --version  report the current version of $command\n"
132          . "\n"
133    );
134
135    die("\n");
136}
137
138
139sub version {
140    my $command = $0;
141    my $PERL_VERSION = $];
142    my $LWP_VERSION = $LWP::UserAgent::VERSION;
143    my $TIME_VERSION = $Time::HiRes::VERSION;
144    my $POE_VERSION = $POE::VERSION;
145
146    $command =~ s#^.*/##;
147
148    print STDOUT (
149        "\n"
150          . "    Script :           $command\n"
151          . "    Author :           $SCRIPT_INFO\n"
152          . "    Version :          $SCRIPT_VERSION\n"
153          . "    URL :              $SCRIPT_URL\n\n"
154	  . "    Perl :             v$PERL_VERSION\n"
155	  . "    LWP::UserAgent :   v$LWP_VERSION\n"
156	  . "    Time::HiRes :      v$TIME_VERSION\n"
157	  . "    POE :              v$POE_VERSION\n"
158          . "\n"
159    );
160
161    die("\n");
162}
163
164
165# subroutine - set number of concurrent threads (# threads == # profiles)
166sub MAX_CONCURRENT_TASKS () { $number_ff_profiles }
167
168
169# subroute - delete any running FF threads close up and quit.
170sub end_script {
171    print STDOUT "\nCAUGHT SIG{INT}... cleaning up!\n";
172
173    foreach my $pid (@tasks) {
174        print STDERR ">> Terminating PID => $pid\n";
175        kill -9, getpgrp($pid);
176    }
177    sleep (2);
178    close VERBOSE;
179    close QUIET;
180    print STDOUT "Done.\n";
181    exit(1);
182}
183
184
185# subroutine - queries each source URL for test URLs or die
186sub source_urls {
187    my @lists = @_;
188    my @array;
189    print VERBOSE "Fetching URL source list(s):\n";
190    foreach my $list (@lists) {
191        print VERBOSE "    LWP::get $list => ";
192        my $browser = LWP::UserAgent->new();
193        my $res     = $browser->get($list)
194          or usage("LWP ERROR:  Error retrieving URL $list: $!");
195        if ( !$res->is_success ) {
196            print VERBOSE "FAIL.\n";
197            my $error = $res->status_line;
198            usage("Source ERROR:  URL $list: $error\n");
199	    die("\n");
200        }
201        else {
202            print VERBOSE "SUCCESS.\n";
203            @array = split( '\n', $res->content );
204        }
205    }
206    print VERBOSE "DONE.\n\n";
207    return @array;
208}
209
210
211# subroutine - verify profile dir exists and a prefs.js - (NOT BULLETPROOF!)
212sub ff_profiles {
213    my @paths = @_;
214    my $count = 0;
215    print VERBOSE "Testing Mozilla Firefox profile(s):\n";
216    foreach my $path (@paths) {
217        print VERBOSE "    Profile $path => ";
218        my $pref_file = $path . "/prefs.js";
219        if ( !-d $path || !-e $pref_file ) {
220            print VERBOSE "INVALID\n";
221            usage("Profile ERROR: Mozilla Firefox profile $path does not exist or is empty.");
222            die("\n");
223        }
224        push @threads, $count++;
225        print VERBOSE "VALID\n";
226    }
227    my $num_profiles = @paths;
228    print VERBOSE "DONE.\n\n";
229    return $num_profiles;
230}
231
232
233###########################################################################
234##
235##  All code below this line was sourced from the POE Cookbook.
236##      URL: http://poe.perl.org/?POE_Cookbook/Child_Processes_3
237##
238##  All rights and copyright rest with the original author(s).
239##
240##  The recipes are distributed under the same terms as POE itself. 
241##  POE, in turn, is distributed under the same terms as Perl.
242##
243##  Please see http://dev.perl.org/licenses/ for the full body of the
244##  Perl license.
245##
246###########################################################################
247
248
249###########################################################################
250##
251## BEGIN POE CODEBLOCK
252
253
254# Start as many tasks as needed so that the number of tasks is no more
255# than MAX_CONCURRENT_TASKS.  Every wheel event is accompanied by the
256# wheel's ID.  This function saves each wheel by its ID so it can be
257# referred to when its events are handled.
258sub start_task {
259    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
260    while ( keys( %{ $heap->{task} } ) < MAX_CONCURRENT_TASKS ) {
261        my $url = shift @testurls;
262	my $thread = shift @threads;
263        my $profile = shift @mozprofile;
264        last unless defined $url;
265        my $clock = time();
266        my $task = POE::Wheel::Run->new(
267            Program		=> [ "DISPLAY=$x11_display $firefox -no-remote -profile $profile $url" ],
268            StdoutEvent         => "task_result",
269            StderrEvent         => "task_debug",
270            CloseEvent          => "task_done",
271        ) or die "CRITICAL FAULT>> cannot spawn POE::Wheel::Run object: $!\n";
272	$heap->{task}->{$task->ID} = $task;
273        $kernel->sig_child( $task->PID, "sig_child" );
274        push @tasks, $task->PID;
275        $heap->{wheel_alarm}->{$task->ID} = $kernel->delay_set( task_timeout => $timeout, $task->ID )
276          or die "CRITICAL FAULT>> cannot set alarm: $!\n"; 
277        $heap->{wheel_pid}->{$task->ID} = $task->PID;
278        $heap->{wheel_thread}->{$task->ID} = $thread;
279        $heap->{wheel_url}->{$task->ID} = $url;
280        $heap->{wheel_profile}->{$task->ID} = $profile;
281        print VERBOSE "    THREAD ID" . $thread
282          . "=> $clock :: Testing URL $url with profile $profile\n";
283    }
284}
285
286
287# Handle information returned from the task.  Since we're using
288# POE::Filter::Reference, the $result is as it was created in the
289# child process.  In this sample, it's a hash reference.
290sub handle_task_result {
291    my ( $heap, $result, $task_id ) = @_[ HEAP, ARG0, ARG1 ];
292    my $thread = $heap->{wheel_thread}->{$task_id};
293    print VERBOSE "    THREAD ID" . $thread . "=> $result\n";
294}
295
296
297# Catch and display information from the child's STDERR.  This was
298# useful for debugging since the child's warnings and errors were not
299# being displayed otherwise.
300sub handle_task_debug {
301    my ( $heap, $result, $task_id ) = @_[ HEAP, ARG0, ARG1 ];
302    my $thread = $heap->{wheel_thread}->{$task_id};
303    print QUIET "    THREAD ID" . $thread . "=> DEBUG (FIREFOX)>> $result\n";
304}
305
306
307# The task is done.  Delete the child wheel, and try to start a new
308# task to take its place.
309sub handle_task_done {
310    my ( $kernel, $heap, $task_id ) = @_[ KERNEL, HEAP, ARG0 ];
311    $kernel->alarm_remove( delete $heap->{wheel_alarm}->{$task_id} )
312      or print STDERR "WARNING>> cannot delete alarm $heap->{wheel_alarm}->{$task_id}: $!\n";
313    my $thread = $heap->{wheel_thread}->{$task_id};
314    my $url = $heap->{wheel_url}->{$task_id};
315    my $profile = $heap->{wheel_profile}->{$task_id};
316    my $pid = $heap->{wheel_pid}->{$task_id};
317    delete $heap->{task}->{$task_id};
318    @tasks = grep { $_ ne $pid } @tasks;
319    my $clock = time();
320    push @mozprofile, $profile;
321    push @threads, $thread;
322    print VERBOSE "    THREAD ID" . $thread . "=> $clock :: DONE :: $url\n";
323    $kernel->yield("next_task");
324}
325
326
327# Handle firefox not terminating normal before timeout
328sub handle_task_timeout { 
329    my $task_id = $_[ARG0];
330    my $thread = $_[HEAP]->{wheel_thread}->{$task_id};
331    my $url = $_[HEAP]->{wheel_url}->{$task_id};
332    my $profile = $_[HEAP]->{wheel_profile}->{$task_id};
333    my $pid = $_[HEAP]->{wheel_pid}->{$task_id};
334    return unless exists $_[HEAP]->{task}->{$task_id};
335    $_[HEAP]->{task}->{$task_id}->kill(-9);
336    delete $_[HEAP]->{task}->{$task_id};
337    my $clock = time();
338    @tasks = grep { $_ ne $pid } @tasks;
339    push @mozprofile, $profile;
340    push @threads, $thread;
341    print VERBOSE "    THREAD ID" . $thread . "=> $clock :: TIMEOUT $profile :: $url\n";
342    $_[KERNEL]->yield("next_task");
343}
344
345
346# Handle session termination explicitly.
347sub handle_task_shutdown {
348    my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
349    # delete all wheels.
350    delete $heap->{wheel};
351    # clear your alias
352    $kernel->alias_remove($heap->{alias});
353    # clear all alarms you might have set
354    $kernel->alarm_remove_all();
355    # get rid of external ref count
356    $kernel->refcount_decrement($session, 'my ref name');
357    # propagate the message to children
358    $kernel->post($heap->{child_session}, 'shutdown');
359    return;
360}
361
362
363# Detect the CHLD signal as each of our children exits.
364sub sig_child {
365    my ( $heap, $sig, $pid, $exit_val ) = @_[ HEAP, ARG0, ARG1, ARG2 ];
366    print VERBOSE "SIG_CHILD :: pid = $pid\n";
367    my $details = delete $heap->{$pid};
368
369    warn "$$: Child $pid exited";
370
371}
372
373##
374## END POE CODE BLOCK
375##
376###########################################################################
377
378
379###########################################################################
380##
381## BEGIN MAIN PROGRAM EXECUTION
382##
383###########################################################################
384
385# argument processing and validation
386Getopt::Long::GetOptions(
387    'firefox=s'         => \$firefox,
388    'display=s'         => \$x11_display,
389    'help'              => \$help,
390    'profile=s'         => \@mozprofile,
391    'quiet'             => \$quiet,
392    'source=s'          => \@source,
393    'timeout=i'         => \$timeout,
394    'verbose'           => \$debug,
395    'version'		=> \$version,
396) or usage("Usage ERROR:  Invalid command line option(s).");
397
398usage("Usage HELP:")
399  unless ! defined $help || exists $ARGV[1];
400
401version() unless ! defined $version;
402
403usage("Usage ERROR:  At least 1 source, 1 profile and a display must be specified.")
404  unless @mozprofile && @source & defined $x11_display;
405
406usage("Usage ERROR:  Must provide a valid path to Mozilla Firefox.")
407  unless ( -e $firefox );
408
409
410# verbose mode
411if ( defined $debug ) {
412    open( VERBOSE, '>&STDOUT' )
413} else {
414    open( VERBOSE, '>/dev/null' )
415    or die "ABORT:  Cannot open $!";
416}
417
418
419# quiet mode
420if ( ! defined $quiet ) {
421    open( QUIET, '>&STDERR' )
422} else {
423    open( QUIET, '>/dev/null' )
424    or die "ABORT:  Cannot open $!";
425}
426
427
428# Test profile arguments (create global variable with # of elements)
429$number_ff_profiles = ff_profiles(@mozprofile);
430
431
432# Build an array of urls to test  (create global variable of elements)
433@testurls = source_urls(@source);
434
435
436# Trap ctrl-c (threads run independently).
437print VERBOSE "Trapping SIG{INT}.\n";
438$SIG{INT}  = \&end_script;
439
440
441# Start the test cycle.
442print VERBOSE "Starting concurrent Mozilla Firefox thread(s):\n";
443print VERBOSE "    Max Threads => $number_ff_profiles\n";
444
445
446# Start the session that will manage all the children.  The _start and
447# next_task events are handled by the same function.
448POE::Session->create(
449    inline_states => {
450        _start          => \&start_task,
451        next_task       => \&start_task,
452        _stop           => \&handle_task_shutdown,
453        task_result     => \&handle_task_result,
454        task_done       => \&handle_task_done,
455        task_debug      => \&handle_task_debug,
456        task_timeout    => \&handle_task_timeout,
457        sig_child       => \&sig_child,
458    }
459) or die "CRITICAL FAULT>> cannot spawn POE::Session object: $!\n";
460
461
462# Launch the session.
463$poe_kernel->run();
464
465
466# Finish.
467print VERBOSE "DONE.\n";
468close VERBOSE;
469close QUIET;
470exit 0;