1# -*- cperl -*- 2# Copyright (c) 2004, 2010, Oracle and/or its affiliates. All rights reserved. 3# 4# This program is free software; you can redistribute it and/or modify 5# it under the terms of the GNU General Public License, version 2.0, 6# as published by the Free Software Foundation. 7# 8# This program is also distributed with certain software (including 9# but not limited to OpenSSL) that is licensed under separate terms, 10# as designated in a particular file or component or in included license 11# documentation. The authors of MySQL hereby grant you an additional 12# permission to link the program and your derivative works with the 13# separately licensed software that they have included with MySQL. 14# 15# This program is distributed in the hope that it will be useful, 16# but WITHOUT ANY WARRANTY; without even the implied warranty of 17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18# GNU General Public License, version 2.0, for more details. 19# 20# You should have received a copy of the GNU General Public License 21# along with this program; if not, write to the Free Software 22# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 23 24# This is a library file used by the Perl version of mysql-test-run, 25# and is part of the translation of the Bourne shell script with the 26# same name. 27 28use strict; 29use Socket; 30use Errno; 31use My::Platform; 32use if IS_WINDOWS, "Net::Ping"; 33 34# Ancient perl might not have port_number method for Net::Ping. 35# Check it and use fallback to connect() if it is not present. 36BEGIN 37{ 38 my $use_netping= 0; 39 if (IS_WINDOWS) 40 { 41 my $ping = Net::Ping->new(); 42 if ($ping->can("port_number")) 43 { 44 $use_netping= 1; 45 } 46 } 47 eval 'sub USE_NETPING { $use_netping }'; 48} 49 50sub sleep_until_file_created ($$$); 51sub mtr_ping_port ($); 52 53sub mtr_ping_port ($) { 54 my $port= shift; 55 56 mtr_verbose("mtr_ping_port: $port"); 57 58 if (IS_WINDOWS && USE_NETPING) 59 { 60 # Under Windows, connect to a port that is not open is slow 61 # It takes ~1sec. Net::Ping with small timeout is much faster. 62 my $ping = Net::Ping->new(); 63 $ping->port_number($port); 64 if ($ping->ping("localhost",0.1)) 65 { 66 mtr_verbose("USED"); 67 return 1; 68 } 69 else 70 { 71 mtr_verbose("FREE"); 72 return 0; 73 } 74 } 75 76 my $remote= "localhost"; 77 my $iaddr= inet_aton($remote); 78 if ( ! $iaddr ) 79 { 80 mtr_error("can't find IP number for $remote"); 81 } 82 my $paddr= sockaddr_in($port, $iaddr); 83 my $proto= getprotobyname('tcp'); 84 if ( ! socket(SOCK, PF_INET, SOCK_STREAM, $proto) ) 85 { 86 mtr_error("can't create socket: $!"); 87 } 88 89 mtr_debug("Pinging server (port: $port)..."); 90 91 if ( connect(SOCK, $paddr) ) 92 { 93 close(SOCK); # FIXME check error? 94 mtr_verbose("USED"); 95 return 1; 96 } 97 else 98 { 99 mtr_verbose("FREE"); 100 return 0; 101 } 102} 103 104############################################################################## 105# 106# Wait for a file to be created 107# 108############################################################################## 109 110# FIXME check that the pidfile contains the expected pid! 111 112sub sleep_until_file_created ($$$) { 113 my $pidfile= shift; 114 my $timeout= shift; 115 my $proc= shift; 116 my $sleeptime= 100; # Milliseconds 117 my $loops= ($timeout * 1000) / $sleeptime; 118 119 for ( my $loop= 1; $loop <= $loops; $loop++ ) 120 { 121 if ( -r $pidfile ) 122 { 123 return 1; 124 } 125 126 my $seconds= ($loop * $sleeptime) / 1000; 127 128 # Check if it died after the fork() was successful 129 if ( defined $proc and ! $proc->wait_one(0) ) 130 { 131 mtr_warning("Process $proc died after mysql-test-run waited $seconds " . 132 "seconds for $pidfile to be created."); 133 return 0; 134 } 135 136 mtr_debug("Sleep $sleeptime milliseconds waiting for $pidfile"); 137 138 # Print extra message every 60 seconds 139 if ( $seconds > 1 && int($seconds * 10) % 600 == 0 && $seconds < $timeout ) 140 { 141 my $left= $timeout - $seconds; 142 mtr_warning("Waited $seconds seconds for $pidfile to be created, " . 143 "still waiting for $left seconds..."); 144 } 145 146 mtr_milli_sleep($sleeptime); 147 148 } 149 150 mtr_warning("Timeout after mysql-test-run waited $timeout seconds " . 151 "for the process $proc to create a pid file."); 152 return 0; 153} 154 155 1561; 157