1#!/usr/bin/perl 2 3# Copyright (C) 2006 Alexey Proskuryakov (ap@nypop.com) 4# 5# Redistribution and use in source and binary forms, with or without 6# modification, are permitted provided that the following conditions 7# are met: 8# 9# 1. Redistributions of source code must retain the above copyright 10# notice, this list of conditions and the following disclaimer. 11# 2. Redistributions in binary form must reproduce the above copyright 12# notice, this list of conditions and the following disclaimer in the 13# documentation and/or other materials provided with the distribution. 14# 3. Neither the name of Apple Computer, Inc. ("Apple") nor the names of 15# its contributors may be used to endorse or promote products derived 16# from this software without specific prior written permission. 17# 18# THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY 19# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21# DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY 22# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 23# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 24# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 25# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 27# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 29# A script to semi-automatically run mangleme tests. 30 31use strict; 32use warnings; 33 34use Cwd; 35use File::Spec; 36use FindBin; 37use Getopt::Long; 38use IPC::Open2; 39 40use lib $FindBin::Bin; 41use webkitdirs; 42 43sub openHTTPDIfNeeded(); 44sub closeHTTPD(); 45sub runSafariWithMangleme(); 46 47# Argument handling 48my $guardMalloc = ''; 49my $httpdPort = 8000; 50my $downloadTest; 51 52GetOptions( 53 'guard-malloc|g' => \$guardMalloc, 54 'get=s' => \$downloadTest, 55 'port=i' => \$httpdPort 56); 57 58 59setConfiguration(); 60my $productDir = productDir(); 61 62chdirWebKit(); 63 64checkFrameworks(); 65 66mkdir "WebKitBuild/mangleme"; 67(system "/usr/bin/make", "-C", "Tools/mangleme") == 0 or die; 68 69my $httpdOpen = 0; 70openHTTPDIfNeeded(); 71 72if ($downloadTest) { 73 system "/usr/bin/curl -o ~/Desktop/mangleme$downloadTest.html http://127.0.0.1:$httpdPort/remangle.cgi?$downloadTest"; 74 print "Saved the test as mangleme$downloadTest.html on the desktop\n"; 75} else { 76 runSafariWithMangleme(); 77 print "Last generated tests:\n"; 78 system "grep 'Mangle attempt' /tmp/WebKit/error_log.txt | tail -n -5 | awk ' {print \$4}'"; 79} 80 81closeHTTPD(); 82 83 84sub runSafariWithMangleme() 85{ 86 my $redirectTo; 87 if (@ARGV) { 88 $redirectTo = "http://127.0.0.1:$httpdPort/remangle.cgi?$ARGV[0]"; 89 } else { 90 $redirectTo = "http://127.0.0.1:$httpdPort/mangle.cgi"; 91 } 92 93 open REDIRECT_HTML, ">", "/tmp/WebKit/redirect.html" or die; 94 print REDIRECT_HTML "<html>\n"; 95 print REDIRECT_HTML " <head>\n"; 96 print REDIRECT_HTML " <meta http-equiv=\"refresh\" content=\"1;URL=$redirectTo\" />\n"; 97 print REDIRECT_HTML " <script type=\"text/javascript\">\n"; 98 print REDIRECT_HTML " document.location = \"$redirectTo\";\n"; 99 print REDIRECT_HTML " </script>\n"; 100 print REDIRECT_HTML " </head>\n"; 101 print REDIRECT_HTML " <body>\n"; 102 print REDIRECT_HTML " </body>\n"; 103 print REDIRECT_HTML "</html>\n"; 104 close REDIRECT_HTML; 105 106 local %ENV; 107 $ENV{DYLD_INSERT_LIBRARIES} = "/usr/lib/libgmalloc.dylib" if $guardMalloc; 108 system "Tools/Scripts/run-safari", "-NSOpen", "/tmp/WebKit/redirect.html"; 109} 110 111sub openHTTPDIfNeeded() 112{ 113 return if $httpdOpen; 114 115 mkdir "/tmp/WebKit"; 116 117 if (-f "/tmp/WebKit/httpd.pid") { 118 my $oldPid = `cat /tmp/WebKit/httpd.pid`; 119 chomp $oldPid; 120 if (0 != kill 0, $oldPid) { 121 print "\nhttpd is already running: pid $oldPid, killing...\n"; 122 kill 15, $oldPid; 123 124 my $retryCount = 20; 125 while ((0 != kill 0, $oldPid) && $retryCount) { 126 sleep 1; 127 --$retryCount; 128 } 129 130 die "Timed out waiting for httpd to quit" unless $retryCount; 131 } 132 } 133 134 my $testDirectory = getcwd() . "/LayoutTests"; 135 my $manglemeDirectory = getcwd() . "/WebKitBuild/mangleme"; 136 my $httpdPath = "/usr/sbin/httpd"; 137 my $httpdConfig = "$testDirectory/http/conf/httpd.conf"; 138 $httpdConfig = "$testDirectory/http/conf/apache2-httpd.conf" if `$httpdPath -v` =~ m|Apache/2|; 139 my $documentRoot = "$manglemeDirectory"; 140 my $typesConfig = "$testDirectory/http/conf/mime.types"; 141 my $sslCertificate = "$testDirectory/http/conf/webkit-httpd.pem"; 142 my $listen = "127.0.0.1:$httpdPort"; 143 144 open2(\*HTTPDIN, \*HTTPDOUT, $httpdPath, 145 "-f", "$httpdConfig", 146 "-C", "DocumentRoot \"$documentRoot\"", 147 "-C", "Listen $listen", 148 "-c", "TypesConfig \"$typesConfig\"", 149 "-c", "CustomLog \"/tmp/WebKit/access_log.txt\" common", 150 "-c", "ErrorLog \"/tmp/WebKit/error_log.txt\"", 151 "-c", "SSLCertificateFile \"$sslCertificate\"", 152 # Apache wouldn't run CGIs with permissions==700 otherwise 153 "-c", "User \"#$<\""); 154 155 my $retryCount = 20; 156 while (system("/usr/bin/curl -q --silent --stderr - --output " . File::Spec->devnull() . " $listen") && $retryCount) { 157 sleep 1; 158 --$retryCount; 159 } 160 161 die "Timed out waiting for httpd to start" unless $retryCount; 162 163 $httpdOpen = 1; 164} 165 166sub closeHTTPD() 167{ 168 return if !$httpdOpen; 169 170 close HTTPDIN; 171 close HTTPDOUT; 172 173 kill 15, `cat /tmp/WebKit/httpd.pid` if -f "/tmp/WebKit/httpd.pid"; 174 175 $httpdOpen = 0; 176} 177