| OLD | NEW |
|---|
| (Empty) |
| 1 # Copyright (C) 2005, 2006, 2007, 2008, 2009 Apple Inc. All rights reserved | |
| 2 # Copyright (C) 2006 Alexey Proskuryakov (ap@nypop.com) | |
| 3 # Copyright (C) 2010 Andras Becsi (abecsi@inf.u-szeged.hu), University of Szeged | |
| 4 # Copyright (C) 2011 Research In Motion Limited. All rights reserved. | |
| 5 # | |
| 6 # Redistribution and use in source and binary forms, with or without | |
| 7 # modification, are permitted provided that the following conditions | |
| 8 # are met: | |
| 9 # | |
| 10 # 1. Redistributions of source code must retain the above copyright | |
| 11 # notice, this list of conditions and the following disclaimer. | |
| 12 # 2. Redistributions in binary form must reproduce the above copyright | |
| 13 # notice, this list of conditions and the following disclaimer in the | |
| 14 # documentation and/or other materials provided with the distribution. | |
| 15 # 3. Neither the name of Apple Computer, Inc. ("Apple") nor the names of | |
| 16 # its contributors may be used to endorse or promote products derived | |
| 17 # from this software without specific prior written permission. | |
| 18 # | |
| 19 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY | |
| 20 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED | |
| 21 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE | |
| 22 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY | |
| 23 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES | |
| 24 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; | |
| 25 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND | |
| 26 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | |
| 27 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF | |
| 28 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |
| 29 | |
| 30 # Module to share code to start and stop the Apache daemon. | |
| 31 | |
| 32 use strict; | |
| 33 use warnings; | |
| 34 | |
| 35 use File::Copy; | |
| 36 use File::Path; | |
| 37 use File::Spec; | |
| 38 use File::Spec::Functions; | |
| 39 use Fcntl ':flock'; | |
| 40 use IPC::Open2; | |
| 41 | |
| 42 use webkitdirs; | |
| 43 | |
| 44 BEGIN { | |
| 45 use Exporter (); | |
| 46 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); | |
| 47 $VERSION = 1.00; | |
| 48 @ISA = qw(Exporter); | |
| 49 @EXPORT = qw(&getHTTPDPath | |
| 50 &hasHTTPD | |
| 51 &getHTTPDConfigPathForTestDirectory | |
| 52 &getDefaultConfigForTestDirectory | |
| 53 &openHTTPD | |
| 54 &closeHTTPD | |
| 55 &setShouldWaitForUserInterrupt | |
| 56 &waitForHTTPDLock | |
| 57 &getWaitTime); | |
| 58 %EXPORT_TAGS = ( ); | |
| 59 @EXPORT_OK = (); | |
| 60 } | |
| 61 | |
| 62 my $tmpDir = "/tmp"; | |
| 63 my $httpdLockPrefix = "WebKitHttpd.lock."; | |
| 64 my $myLockFile; | |
| 65 my $exclusiveLockFile = File::Spec->catfile($tmpDir, "WebKit.lock"); | |
| 66 my $httpdPidDir = File::Spec->catfile($tmpDir, "WebKit"); | |
| 67 my $httpdPidFile = File::Spec->catfile($httpdPidDir, "httpd.pid"); | |
| 68 my $httpdPid; | |
| 69 my $waitForUserInterrupt = 0; | |
| 70 my $waitBeginTime; | |
| 71 my $waitEndTime; | |
| 72 | |
| 73 $SIG{'INT'} = 'handleInterrupt'; | |
| 74 $SIG{'TERM'} = 'handleInterrupt'; | |
| 75 | |
| 76 sub getHTTPDPath | |
| 77 { | |
| 78 my $httpdPath; | |
| 79 if (isDebianBased()) { | |
| 80 $httpdPath = "/usr/sbin/apache2"; | |
| 81 } else { | |
| 82 $httpdPath = "/usr/sbin/httpd"; | |
| 83 } | |
| 84 return $httpdPath; | |
| 85 } | |
| 86 | |
| 87 sub hasHTTPD | |
| 88 { | |
| 89 my @command = (getHTTPDPath(), "-v"); | |
| 90 return system(@command) == 0; | |
| 91 } | |
| 92 | |
| 93 sub getApacheVersion | |
| 94 { | |
| 95 my $httpdPath = getHTTPDPath(); | |
| 96 my $version = `$httpdPath -v`; | |
| 97 $version =~ s/.*Server version: Apache\/(\d+\.\d+).*/$1/s; | |
| 98 return $version; | |
| 99 } | |
| 100 | |
| 101 sub getDefaultConfigForTestDirectory | |
| 102 { | |
| 103 my ($testDirectory) = @_; | |
| 104 die "No test directory has been specified." unless ($testDirectory); | |
| 105 | |
| 106 my $httpdConfig = getHTTPDConfigPathForTestDirectory($testDirectory); | |
| 107 my $documentRoot = "$testDirectory/http/tests"; | |
| 108 my $jsTestResourcesDirectory = $testDirectory . "/fast/js/resources"; | |
| 109 my $mediaResourcesDirectory = $testDirectory . "/media"; | |
| 110 my $typesConfig = "$testDirectory/http/conf/mime.types"; | |
| 111 my $httpdLockFile = File::Spec->catfile($httpdPidDir, "httpd.lock"); | |
| 112 my $httpdScoreBoardFile = File::Spec->catfile($httpdPidDir, "httpd.scoreboar
d"); | |
| 113 | |
| 114 my @httpdArgs = ( | |
| 115 "-f", "$httpdConfig", | |
| 116 "-C", "DocumentRoot \"$documentRoot\"", | |
| 117 # Setup a link to where the js test templates are stored, use -c so that
mod_alias will already be loaded. | |
| 118 "-c", "Alias /js-test-resources \"$jsTestResourcesDirectory\"", | |
| 119 "-c", "Alias /media-resources \"$mediaResourcesDirectory\"", | |
| 120 "-c", "TypesConfig \"$typesConfig\"", | |
| 121 # Apache wouldn't run CGIs with permissions==700 otherwise | |
| 122 "-c", "User \"#$<\"", | |
| 123 "-c", "PidFile \"$httpdPidFile\"", | |
| 124 "-c", "ScoreBoardFile \"$httpdScoreBoardFile\"", | |
| 125 ); | |
| 126 | |
| 127 if (getApacheVersion() eq "2.2") { | |
| 128 push(@httpdArgs, "-c", "LockFile \"$httpdLockFile\""); | |
| 129 } | |
| 130 | |
| 131 # FIXME: Enable this on Windows once <rdar://problem/5345985> is fixed | |
| 132 # The version of Apache we use with Cygwin does not support SSL | |
| 133 my $sslCertificate = "$testDirectory/http/conf/webkit-httpd.pem"; | |
| 134 push(@httpdArgs, "-c", "SSLCertificateFile \"$sslCertificate\"") unless isCy
gwin(); | |
| 135 | |
| 136 return @httpdArgs; | |
| 137 | |
| 138 } | |
| 139 | |
| 140 sub getHTTPDConfigPathForTestDirectory | |
| 141 { | |
| 142 my ($testDirectory) = @_; | |
| 143 die "No test directory has been specified." unless ($testDirectory); | |
| 144 | |
| 145 my $httpdConfig; | |
| 146 my $httpdPath = getHTTPDPath(); | |
| 147 my $httpdConfDirectory = "$testDirectory/http/conf/"; | |
| 148 my $apacheVersion = getApacheVersion(); | |
| 149 | |
| 150 if (isCygwin()) { | |
| 151 my $libPHP4DllPath = "/usr/lib/apache/libphp4.dll"; | |
| 152 # FIXME: run-webkit-tests should not modify the user's system, especiall
y not in this method! | |
| 153 unless (-x $libPHP4DllPath) { | |
| 154 copy("$httpdConfDirectory/libphp4.dll", $libPHP4DllPath); | |
| 155 chmod(0755, $libPHP4DllPath); | |
| 156 } | |
| 157 $httpdConfig = "cygwin-httpd.conf"; # This is an apache 1.3 config. | |
| 158 } elsif (isDebianBased()) { | |
| 159 $httpdConfig = "debian-httpd-$apacheVersion.conf"; | |
| 160 } elsif (isFedoraBased()) { | |
| 161 $httpdConfig = "fedora-httpd-$apacheVersion.conf"; | |
| 162 } else { | |
| 163 # All other ports use apache2, so just use our default apache2 config. | |
| 164 $httpdConfig = "apache2-httpd.conf"; | |
| 165 } | |
| 166 return "$httpdConfDirectory/$httpdConfig"; | |
| 167 } | |
| 168 | |
| 169 sub openHTTPD(@) | |
| 170 { | |
| 171 my (@args) = @_; | |
| 172 die "No HTTPD configuration has been specified" unless (@args); | |
| 173 mkdir($httpdPidDir, 0755); | |
| 174 die "No write permissions to $httpdPidDir" unless (-w $httpdPidDir); | |
| 175 | |
| 176 if (-f $httpdPidFile) { | |
| 177 open (PIDFILE, $httpdPidFile); | |
| 178 my $oldPid = <PIDFILE>; | |
| 179 chomp $oldPid; | |
| 180 close PIDFILE; | |
| 181 if (0 != kill 0, $oldPid) { | |
| 182 print "\nhttpd is already running: pid $oldPid, killing...\n"; | |
| 183 if (!killHTTPD($oldPid)) { | |
| 184 cleanUp(); | |
| 185 die "Timed out waiting for httpd to quit"; | |
| 186 } | |
| 187 } | |
| 188 unlink $httpdPidFile; | |
| 189 } | |
| 190 | |
| 191 my $httpdPath = getHTTPDPath(); | |
| 192 | |
| 193 open2(">&1", \*HTTPDIN, $httpdPath, @args); | |
| 194 | |
| 195 my $retryCount = 20; | |
| 196 while (!-f $httpdPidFile && $retryCount) { | |
| 197 sleep 1; | |
| 198 --$retryCount; | |
| 199 } | |
| 200 | |
| 201 if (!$retryCount) { | |
| 202 cleanUp(); | |
| 203 die "Timed out waiting for httpd to start"; | |
| 204 } | |
| 205 | |
| 206 $httpdPid = <PIDFILE> if open(PIDFILE, $httpdPidFile); | |
| 207 chomp $httpdPid if $httpdPid; | |
| 208 close PIDFILE; | |
| 209 | |
| 210 waitpid($httpdPid, 0) if ($waitForUserInterrupt && $httpdPid); | |
| 211 | |
| 212 return 1; | |
| 213 } | |
| 214 | |
| 215 sub closeHTTPD | |
| 216 { | |
| 217 close HTTPDIN; | |
| 218 my $succeeded = killHTTPD($httpdPid); | |
| 219 cleanUp(); | |
| 220 unless ($succeeded) { | |
| 221 print STDERR "Timed out waiting for httpd to terminate!\n" unless $succe
eded; | |
| 222 return 0; | |
| 223 } | |
| 224 return 1; | |
| 225 } | |
| 226 | |
| 227 sub killHTTPD | |
| 228 { | |
| 229 my ($pid) = @_; | |
| 230 | |
| 231 return 1 unless $pid; | |
| 232 | |
| 233 kill 15, $pid; | |
| 234 | |
| 235 my $retryCount = 20; | |
| 236 while (kill(0, $pid) && $retryCount) { | |
| 237 sleep 1; | |
| 238 --$retryCount; | |
| 239 } | |
| 240 return $retryCount != 0; | |
| 241 } | |
| 242 | |
| 243 sub setShouldWaitForUserInterrupt | |
| 244 { | |
| 245 $waitForUserInterrupt = 1; | |
| 246 } | |
| 247 | |
| 248 sub handleInterrupt | |
| 249 { | |
| 250 # On Cygwin, when we receive a signal Apache is still running, so we need | |
| 251 # to kill it. On other platforms (at least Mac OS X), Apache will have | |
| 252 # already been killed, and trying to kill it again will cause us to hang. | |
| 253 # All we need to do in this case is clean up our own files. | |
| 254 if (isCygwin()) { | |
| 255 closeHTTPD(); | |
| 256 } else { | |
| 257 cleanUp(); | |
| 258 } | |
| 259 | |
| 260 print "\n"; | |
| 261 exit(1); | |
| 262 } | |
| 263 | |
| 264 sub cleanUp | |
| 265 { | |
| 266 rmdir $httpdPidDir; | |
| 267 unlink $exclusiveLockFile; | |
| 268 unlink $myLockFile if $myLockFile; | |
| 269 } | |
| 270 | |
| 271 sub extractLockNumber | |
| 272 { | |
| 273 my ($lockFile) = @_; | |
| 274 return -1 unless $lockFile; | |
| 275 return substr($lockFile, length($httpdLockPrefix)); | |
| 276 } | |
| 277 | |
| 278 sub getLockFiles | |
| 279 { | |
| 280 opendir(TMPDIR, $tmpDir) or die "Could not open " . $tmpDir . "."; | |
| 281 my @lockFiles = grep {m/^$httpdLockPrefix\d+$/} readdir(TMPDIR); | |
| 282 @lockFiles = sort { extractLockNumber($a) <=> extractLockNumber($b) } @lockF
iles; | |
| 283 closedir(TMPDIR); | |
| 284 return @lockFiles; | |
| 285 } | |
| 286 | |
| 287 sub getNextAvailableLockNumber | |
| 288 { | |
| 289 my @lockFiles = getLockFiles(); | |
| 290 return 0 unless @lockFiles; | |
| 291 return extractLockNumber($lockFiles[-1]) + 1; | |
| 292 } | |
| 293 | |
| 294 sub getLockNumberForCurrentRunning | |
| 295 { | |
| 296 my @lockFiles = getLockFiles(); | |
| 297 return 0 unless @lockFiles; | |
| 298 return extractLockNumber($lockFiles[0]); | |
| 299 } | |
| 300 | |
| 301 sub waitForHTTPDLock | |
| 302 { | |
| 303 $waitBeginTime = time; | |
| 304 scheduleHttpTesting(); | |
| 305 # If we are the only one waiting for Apache just run the tests without any f
urther checking | |
| 306 if (scalar getLockFiles() > 1) { | |
| 307 my $currentLockFile = File::Spec->catfile($tmpDir, "$httpdLockPrefix" .
getLockNumberForCurrentRunning()); | |
| 308 my $currentLockPid = <SCHEDULER_LOCK> if (-f $currentLockFile && open(SC
HEDULER_LOCK, "<$currentLockFile")); | |
| 309 # Wait until we are allowed to run the http tests | |
| 310 while ($currentLockPid && $currentLockPid != $$) { | |
| 311 $currentLockFile = File::Spec->catfile($tmpDir, "$httpdLockPrefix" .
getLockNumberForCurrentRunning()); | |
| 312 if ($currentLockFile eq $myLockFile) { | |
| 313 $currentLockPid = <SCHEDULER_LOCK> if open(SCHEDULER_LOCK, "<$cu
rrentLockFile"); | |
| 314 if ($currentLockPid != $$) { | |
| 315 print STDERR "\nPID mismatch.\n"; | |
| 316 last; | |
| 317 } | |
| 318 } else { | |
| 319 sleep 1; | |
| 320 } | |
| 321 } | |
| 322 } | |
| 323 $waitEndTime = time; | |
| 324 } | |
| 325 | |
| 326 sub scheduleHttpTesting | |
| 327 { | |
| 328 # We need an exclusive lock file to avoid deadlocks and starvation and ensur
e that the scheduler lock numbers are sequential. | |
| 329 # The scheduler locks are used to schedule the running test sessions in firs
t come first served order. | |
| 330 while (!(open(SEQUENTIAL_GUARD_LOCK, ">$exclusiveLockFile") && flock(SEQUENT
IAL_GUARD_LOCK, LOCK_EX|LOCK_NB))) {} | |
| 331 $myLockFile = File::Spec->catfile($tmpDir, "$httpdLockPrefix" . getNextAvail
ableLockNumber()); | |
| 332 open(SCHEDULER_LOCK, ">$myLockFile"); | |
| 333 print SCHEDULER_LOCK "$$"; | |
| 334 print SEQUENTIAL_GUARD_LOCK "$$"; | |
| 335 close(SCHEDULER_LOCK); | |
| 336 close(SEQUENTIAL_GUARD_LOCK); | |
| 337 unlink $exclusiveLockFile; | |
| 338 } | |
| 339 | |
| 340 sub getWaitTime | |
| 341 { | |
| 342 my $waitTime = 0; | |
| 343 if ($waitBeginTime && $waitEndTime) { | |
| 344 $waitTime = $waitEndTime - $waitBeginTime; | |
| 345 } | |
| 346 return $waitTime; | |
| 347 } | |
| OLD | NEW |
|---|
Chromium Code Reviews
Issue 1253013003:
Remove all perl scripts from Tools/Scripts (Closed)
Base URL: svn://svn.chromium.org/blink/trunk