/automation/test_harness.pl

http://showslow.googlecode.com/ · Perl · 470 lines · 264 code · 80 blank · 126 comment · 14 complexity · 476e637399ee248312c7c244d2f3c88f MD5 · raw file

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