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 FindBin; 36use Getopt::Long; 37use IPC::Open2; 38 39use lib $FindBin::Bin; 40use webkitdirs; 41 42sub openHTTPDIfNeeded(); 43sub closeHTTPD(); 44sub runSafariWithMangleme(); 45 46# Argument handling 47my $guardMalloc = ''; 48my $httpdPort = 8000; 49my $downloadTest; 50 51GetOptions( 52 'guard-malloc|g' => \$guardMalloc, 53 'get=s' => \$downloadTest, 54 'port=i' => \$httpdPort 55); 56 57 58setConfiguration(); 59my $productDir = productDir(); 60 61chdirWebKit(); 62 63checkFrameworks(); 64 65mkdir "WebKitBuild/mangleme"; 66(system "/usr/bin/make", "-C", "WebKitTools/mangleme") == 0 or die; 67 68my $httpdOpen = 0; 69openHTTPDIfNeeded(); 70 71if ($downloadTest) { 72 system "/usr/bin/curl -o ~/Desktop/mangleme$downloadTest.html http://127.0.0.1:$httpdPort/remangle.cgi?$downloadTest"; 73 print "Saved the test as mangleme$downloadTest.html on the desktop\n"; 74} else { 75 runSafariWithMangleme(); 76 print "Last generated tests:\n"; 77 system "grep 'Mangle attempt' /tmp/WebKit/error_log.txt | tail -n -5 | awk ' {print \$4}'"; 78} 79 80closeHTTPD(); 81 82 83sub runSafariWithMangleme() 84{ 85 my $redirectTo; 86 if (@ARGV) { 87 $redirectTo = "http://127.0.0.1:$httpdPort/remangle.cgi?$ARGV[0]"; 88 } else { 89 $redirectTo = "http://127.0.0.1:$httpdPort/mangle.cgi"; 90 } 91 92 open REDIRECT_HTML, ">", "/tmp/WebKit/redirect.html" or die; 93 print REDIRECT_HTML "<html>\n"; 94 print REDIRECT_HTML " <head>\n"; 95 print REDIRECT_HTML " <meta http-equiv=\"refresh\" content=\"1;URL=$redirectTo\" />\n"; 96 print REDIRECT_HTML " <script type=\"text/javascript\">\n"; 97 print REDIRECT_HTML " document.location = \"$redirectTo\";\n"; 98 print REDIRECT_HTML " </script>\n"; 99 print REDIRECT_HTML " </head>\n"; 100 print REDIRECT_HTML " <body>\n"; 101 print REDIRECT_HTML " </body>\n"; 102 print REDIRECT_HTML "</html>\n"; 103 close REDIRECT_HTML; 104 105 local %ENV; 106 $ENV{DYLD_INSERT_LIBRARIES} = "/usr/lib/libgmalloc.dylib" if $guardMalloc; 107 system "WebKitTools/Scripts/run-safari", "-NSOpen", "/tmp/WebKit/redirect.html"; 108} 109 110sub openHTTPDIfNeeded() 111{ 112 return if $httpdOpen; 113 114 mkdir "/tmp/WebKit"; 115 116 if (-f "/tmp/WebKit/httpd.pid") { 117 my $oldPid = `cat /tmp/WebKit/httpd.pid`; 118 chomp $oldPid; 119 if (0 != kill 0, $oldPid) { 120 print "\nhttpd is already running: pid $oldPid, killing...\n"; 121 kill 15, $oldPid; 122 123 my $retryCount = 20; 124 while ((0 != kill 0, $oldPid) && $retryCount) { 125 sleep 1; 126 --$retryCount; 127 } 128 129 die "Timed out waiting for httpd to quit" unless $retryCount; 130 } 131 } 132 133 my $testDirectory = getcwd() . "/LayoutTests"; 134 my $manglemeDirectory = getcwd() . "/WebKitBuild/mangleme"; 135 my $httpdPath = "/usr/sbin/httpd"; 136 my $httpdConfig = "$testDirectory/http/conf/httpd.conf"; 137 $httpdConfig = "$testDirectory/http/conf/apache2-httpd.conf" if `$httpdPath -v` =~ m|Apache/2|; 138 my $documentRoot = "$manglemeDirectory"; 139 my $typesConfig = "$testDirectory/http/conf/mime.types"; 140 my $sslCertificate = "$testDirectory/http/conf/webkit-httpd.pem"; 141 my $listen = "127.0.0.1:$httpdPort"; 142 143 open2(\*HTTPDIN, \*HTTPDOUT, $httpdPath, 144 "-f", "$httpdConfig", 145 "-C", "DocumentRoot \"$documentRoot\"", 146 "-C", "Listen $listen", 147 "-c", "TypesConfig \"$typesConfig\"", 148 "-c", "CustomLog \"/tmp/WebKit/access_log.txt\" common", 149 "-c", "ErrorLog \"/tmp/WebKit/error_log.txt\"", 150 "-c", "SSLCertificateFile \"$sslCertificate\"", 151 # Apache wouldn't run CGIs with permissions==700 otherwise 152 "-c", "User \"#$<\""); 153 154 my $retryCount = 20; 155 while (system("/usr/bin/curl -q --silent --stderr - --output /dev/null $listen") && $retryCount) { 156 sleep 1; 157 --$retryCount; 158 } 159 160 die "Timed out waiting for httpd to start" unless $retryCount; 161 162 $httpdOpen = 1; 163} 164 165sub closeHTTPD() 166{ 167 return if !$httpdOpen; 168 169 close HTTPDIN; 170 close HTTPDOUT; 171 172 kill 15, `cat /tmp/WebKit/httpd.pid` if -f "/tmp/WebKit/httpd.pid"; 173 174 $httpdOpen = 0; 175} 176