| Filename | /2home/ss5/local/projects/Tapper/src/Tapper-MCP/lib/Tapper/MCP/Net.pm |
| Statements | Executed 47 statements in 2.18ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 2.34ms | 3.87ms | Tapper::MCP::Net::BEGIN@10 |
| 1 | 1 | 1 | 1.53ms | 8.13ms | Tapper::MCP::Net::BEGIN@13 |
| 1 | 1 | 1 | 1.10ms | 2.04ms | Tapper::MCP::Net::BEGIN@12 |
| 1 | 1 | 1 | 897µs | 8.98ms | Tapper::MCP::Net::BEGIN@11 |
| 1 | 1 | 1 | 756µs | 3.72ms | Tapper::MCP::Net::BEGIN@16 |
| 1 | 1 | 1 | 700µs | 1.30ms | Tapper::MCP::Net::BEGIN@5 |
| 1 | 1 | 1 | 72µs | 123µs | Tapper::MCP::Net::BEGIN@7 |
| 1 | 1 | 1 | 30µs | 34µs | Tapper::MCP::Net::BEGIN@3 |
| 1 | 1 | 1 | 14µs | 42µs | Tapper::MCP::Net::BEGIN@14 |
| 1 | 1 | 1 | 13µs | 4.53ms | Tapper::MCP::Net::BEGIN@9 |
| 1 | 1 | 1 | 10µs | 51µs | Tapper::MCP::Net::BEGIN@7.9 |
| 1 | 1 | 1 | 10µs | 38µs | Tapper::MCP::Net::BEGIN@20 |
| 1 | 1 | 1 | 9µs | 26µs | Tapper::MCP::Net::BEGIN@242 |
| 1 | 1 | 1 | 9µs | 27µs | Tapper::MCP::Net::BEGIN@4 |
| 1 | 1 | 1 | 8µs | 44µs | Tapper::MCP::Net::BEGIN@15 |
| 0 | 0 | 0 | 0s | 0s | Tapper::MCP::Net::__ANON__[lib/Tapper/MCP/Net.pm:106] |
| 0 | 0 | 0 | 0s | 0s | Tapper::MCP::Net::conserver_connect |
| 0 | 0 | 0 | 0s | 0s | Tapper::MCP::Net::conserver_disconnect |
| 0 | 0 | 0 | 0s | 0s | Tapper::MCP::Net::hw_report_create |
| 0 | 0 | 0 | 0s | 0s | Tapper::MCP::Net::install_client_package |
| 0 | 0 | 0 | 0s | 0s | Tapper::MCP::Net::reboot_system |
| 0 | 0 | 0 | 0s | 0s | Tapper::MCP::Net::start_simnow |
| 0 | 0 | 0 | 0s | 0s | Tapper::MCP::Net::start_ssh |
| 0 | 0 | 0 | 0s | 0s | Tapper::MCP::Net::write_grub_file |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Tapper::MCP::Net; | ||||
| 2 | |||||
| 3 | 3 | 19µs | 2 | 37µs | # spent 34µs (30+4) within Tapper::MCP::Net::BEGIN@3 which was called:
# once (30µs+4µs) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 3 # spent 34µs making 1 call to Tapper::MCP::Net::BEGIN@3
# spent 4µs making 1 call to strict::import |
| 4 | 3 | 58µs | 2 | 44µs | # spent 27µs (9+18) within Tapper::MCP::Net::BEGIN@4 which was called:
# once (9µs+18µs) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 4 # spent 27µs making 1 call to Tapper::MCP::Net::BEGIN@4
# spent 18µs making 1 call to warnings::import |
| 5 | 3 | 134µs | 2 | 1.72ms | # spent 1.30ms (700µs+605µs) within Tapper::MCP::Net::BEGIN@5 which was called:
# once (700µs+605µs) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 5 # spent 1.30ms making 1 call to Tapper::MCP::Net::BEGIN@5
# spent 413µs making 1 call to English::import |
| 6 | |||||
| 7 | 6 | 93µs | 3 | 215µs | use 5.010; # spent 123µs making 1 call to Tapper::MCP::Net::BEGIN@7
# spent 51µs making 1 call to Tapper::MCP::Net::BEGIN@7.9
# spent 41µs making 1 call to feature::import |
| 8 | |||||
| 9 | 3 | 58µs | 2 | 9.04ms | # spent 4.53ms (13µs+4.51) within Tapper::MCP::Net::BEGIN@9 which was called:
# once (13µs+4.51ms) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 9 # spent 4.53ms making 1 call to Tapper::MCP::Net::BEGIN@9
# spent 4.51ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:492] |
| 10 | 3 | 152µs | 2 | 4.66ms | # spent 3.87ms (2.34+1.53) within Tapper::MCP::Net::BEGIN@10 which was called:
# once (2.34ms+1.53ms) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 10 # spent 3.87ms making 1 call to Tapper::MCP::Net::BEGIN@10
# spent 787µs making 1 call to Exporter::import |
| 11 | 3 | 118µs | 2 | 8.99ms | # spent 8.98ms (897µs+8.08) within Tapper::MCP::Net::BEGIN@11 which was called:
# once (897µs+8.08ms) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 11 # spent 8.98ms making 1 call to Tapper::MCP::Net::BEGIN@11
# spent 15µs making 1 call to Exporter::import |
| 12 | 3 | 108µs | 2 | 2.05ms | # spent 2.04ms (1.10+935µs) within Tapper::MCP::Net::BEGIN@12 which was called:
# once (1.10ms+935µs) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 12 # spent 2.04ms making 1 call to Tapper::MCP::Net::BEGIN@12
# spent 14µs making 1 call to Exporter::import |
| 13 | 3 | 115µs | 2 | 9.42ms | # spent 8.13ms (1.53+6.60) within Tapper::MCP::Net::BEGIN@13 which was called:
# once (1.53ms+6.60ms) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 13 # spent 8.13ms making 1 call to Tapper::MCP::Net::BEGIN@13
# spent 1.29ms making 1 call to IO::Socket::import |
| 14 | 3 | 23µs | 2 | 69µs | # spent 42µs (14+28) within Tapper::MCP::Net::BEGIN@14 which was called:
# once (14µs+28µs) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 14 # spent 42µs making 1 call to Tapper::MCP::Net::BEGIN@14
# spent 28µs making 1 call to Exporter::import |
| 15 | 3 | 18µs | 2 | 81µs | # spent 44µs (8+36) within Tapper::MCP::Net::BEGIN@15 which was called:
# once (8µs+36µs) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 15 # spent 44µs making 1 call to Tapper::MCP::Net::BEGIN@15
# spent 36µs making 1 call to Exporter::import |
| 16 | 3 | 122µs | 2 | 3.76ms | # spent 3.72ms (756µs+2.96) within Tapper::MCP::Net::BEGIN@16 which was called:
# once (756µs+2.96ms) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 16 # spent 3.72ms making 1 call to Tapper::MCP::Net::BEGIN@16
# spent 39µs making 1 call to Exporter::import |
| 17 | |||||
| 18 | 1 | 6µs | 1 | 6.51ms | extends 'Tapper::MCP'; # spent 6.51ms making 1 call to Moose::extends |
| 19 | |||||
| 20 | 3 | 828µs | 2 | 67µs | # spent 38µs (10+28) within Tapper::MCP::Net::BEGIN@20 which was called:
# once (10µs+28µs) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 20 # spent 38µs making 1 call to Tapper::MCP::Net::BEGIN@20
# spent 28µs making 1 call to Exporter::import |
| 21 | |||||
| 22 | =head2 conserver_connect | ||||
| 23 | |||||
| 24 | This function opens a connection to the conserver. Conserver, port and user | ||||
| 25 | can be given as arguments, yet are optional. | ||||
| 26 | @param string - system to open a console to | ||||
| 27 | @opt string - Address or name of the console server | ||||
| 28 | @opt int - port number of the console server | ||||
| 29 | @opt string - username to be used | ||||
| 30 | |||||
| 31 | |||||
| 32 | @returnlist success - (IO::Socket::INET object) | ||||
| 33 | @returnlist error - (error string) | ||||
| 34 | |||||
| 35 | =cut | ||||
| 36 | |||||
| 37 | sub conserver_connect | ||||
| 38 | { | ||||
| 39 | my ($self, $system, $conserver, $conserver_port, $conuser) = @_; | ||||
| 40 | $conserver ||= $self->cfg->{conserver}{server}; | ||||
| 41 | $conserver_port ||= $self->cfg->{conserver}{port}; | ||||
| 42 | $conuser ||= $self->cfg->{conserver}{user}; | ||||
| 43 | |||||
| 44 | my $sock = IO::Socket::INET->new(PeerPort => $conserver_port, | ||||
| 45 | PeerAddr => $conserver, | ||||
| 46 | Proto => 'tcp'); | ||||
| 47 | |||||
| 48 | return ("Can't open connection:$!") unless $sock; | ||||
| 49 | my $data=<$sock>; return($data) unless $data=~/^ok/; | ||||
| 50 | |||||
| 51 | print $sock "login $conuser\n"; | ||||
| 52 | $data=<$sock>; return($data) unless $data=~/^ok/; | ||||
| 53 | |||||
| 54 | print $sock "call $system\n"; | ||||
| 55 | my $port=<$sock>; | ||||
| 56 | if ($port=~ /@(\w+)/) { | ||||
| 57 | close $sock; | ||||
| 58 | return $self->conserver_connect ($system,$1,$conserver_port,$conuser); | ||||
| 59 | } else { | ||||
| 60 | if ($port !~ /^\d+/) { | ||||
| 61 | close $sock; | ||||
| 62 | return $port; # answer in $port is an error message | ||||
| 63 | } | ||||
| 64 | } | ||||
| 65 | |||||
| 66 | |||||
| 67 | print $sock "exit\n"; | ||||
| 68 | $data=<$sock>; return($data) unless $data=~/^goodbye/; | ||||
| 69 | close $sock; | ||||
| 70 | |||||
| 71 | $sock = IO::Socket::INET->new(PeerPort => int($port), | ||||
| 72 | PeerAddr => $conserver, | ||||
| 73 | Proto => 'tcp'); | ||||
| 74 | return ("Can't open connection to $conserver:$!") unless $sock; | ||||
| 75 | |||||
| 76 | |||||
| 77 | $data=<$sock>;return($data) unless $data=~/^ok/; | ||||
| 78 | print $sock "login $conuser\n"; | ||||
| 79 | $data=<$sock>;return($data) unless $data=~/^ok/; | ||||
| 80 | print $sock "call $system\n"; | ||||
| 81 | $data=<$sock>;return($data) unless $data=~/^(\[attached\]|\[spy\])/; | ||||
| 82 | |||||
| 83 | print ($sock "\005c;\n"); # console needs to be "activated" | ||||
| 84 | $data=<$sock>;return($data) unless $data=~/^(\[connected\])/; | ||||
| 85 | return($sock); | ||||
| 86 | } | ||||
| 87 | |||||
| 88 | =head2 conserver_disconnect | ||||
| 89 | |||||
| 90 | Disconnect the filehandle given as first argument from the conserver. | ||||
| 91 | We first try to quit kindly but if this fails (by what reason ever) | ||||
| 92 | the filehandle is simply closed. Closing a socket can not fail, so the | ||||
| 93 | function always succeeds. Thus no return value is needed. | ||||
| 94 | |||||
| 95 | @param IO::Socket::INET - file handle connected to the conserver | ||||
| 96 | |||||
| 97 | @return none | ||||
| 98 | |||||
| 99 | =cut | ||||
| 100 | |||||
| 101 | sub conserver_disconnect | ||||
| 102 | { | ||||
| 103 | my ($self, $sock) = @_; | ||||
| 104 | if ($sock) { | ||||
| 105 | eval { | ||||
| 106 | local $SIG{ALRM} = sub { die 'Timeout'; }; | ||||
| 107 | alarm (2); | ||||
| 108 | if ($sock->can("connected") and $sock->connected()) { | ||||
| 109 | print ($sock "\005c.\n"); | ||||
| 110 | <$sock>; # ignore return value, since we close the socket anyway | ||||
| 111 | } | ||||
| 112 | }; | ||||
| 113 | alarm (2); | ||||
| 114 | $sock->close() if $sock->can("close"); | ||||
| 115 | } | ||||
| 116 | } | ||||
| 117 | |||||
| 118 | |||||
| 119 | =head2 start_simnow | ||||
| 120 | |||||
| 121 | Start a simnow installation on given host. Installer is supposed to | ||||
| 122 | start the simnow controller in turn. | ||||
| 123 | |||||
| 124 | @param string - hostname | ||||
| 125 | |||||
| 126 | @return success - 0 | ||||
| 127 | @return error - error string | ||||
| 128 | |||||
| 129 | =cut | ||||
| 130 | |||||
| 131 | sub start_simnow | ||||
| 132 | { | ||||
| 133 | my ($self, $hostname) = @_; | ||||
| 134 | |||||
| 135 | my $simnow_installer = $self->cfg->{files}{simnow_installer}; | ||||
| 136 | my $server = Sys::Hostname::hostname() || $self->cfg->{mcp_host}; | ||||
| 137 | my $retval = Net::SSH::ssh("root\@$hostname",$simnow_installer, "--host=$server"); | ||||
| 138 | return "Can not start simnow installer: $!" if $retval; | ||||
| 139 | |||||
| 140 | |||||
| 141 | $self->log->info("Simnow installation started on $hostname."); | ||||
| 142 | return 0; | ||||
| 143 | |||||
| 144 | } | ||||
| 145 | |||||
| 146 | |||||
| 147 | =head2 start_ssh | ||||
| 148 | |||||
| 149 | Start a ssh testrun on given host. This starts both the Installer and PRC. | ||||
| 150 | |||||
| 151 | @param string - hostname | ||||
| 152 | |||||
| 153 | @return success - 0 | ||||
| 154 | @return error - error string | ||||
| 155 | |||||
| 156 | =cut | ||||
| 157 | |||||
| 158 | sub start_ssh | ||||
| 159 | { | ||||
| 160 | my ($self, $hostname) = @_; | ||||
| 161 | |||||
| 162 | my $tapper_script = $self->cfg->{files}{tapper_prc}; | ||||
| 163 | my $tftp_host = $self->cfg->{mcp_host}; | ||||
| 164 | my $error = Net::SSH::ssh("$hostname","$tapper_script --host $tftp_host"); | ||||
| 165 | return "Can not start PRC with ssh: $error" if $error; | ||||
| 166 | return 0; | ||||
| 167 | } | ||||
| 168 | |||||
| 169 | =head2 install_client_package | ||||
| 170 | |||||
| 171 | Install client package of given architecture on given host at optional | ||||
| 172 | given possition. | ||||
| 173 | |||||
| 174 | @param string - hostname | ||||
| 175 | @param hash ref - contains arch and dest_path | ||||
| 176 | |||||
| 177 | @return success - 0 | ||||
| 178 | @return error - error string | ||||
| 179 | |||||
| 180 | =cut | ||||
| 181 | |||||
| 182 | sub install_client_package | ||||
| 183 | { | ||||
| 184 | my ($self, $hostname, $package) = @_; | ||||
| 185 | |||||
| 186 | my $dest_path = $package->{dest_path} || '/tmp'; | ||||
| 187 | $dest_path .= "/tapper-clientpkg.tgz"; | ||||
| 188 | |||||
| 189 | my $arch = $package->{arch}; | ||||
| 190 | return "No architecture defined. Can not install client package" if not $arch; | ||||
| 191 | my $clientpkg = $self->cfg->{files}{tapper_package}{$arch}; | ||||
| 192 | |||||
| 193 | $clientpkg = $self->cfg->{paths}{package_dir}.$clientpkg | ||||
| 194 | if not $clientpkg =~ m,^/,; | ||||
| 195 | |||||
| 196 | my $scp = Net::SCP->new($hostname); | ||||
| 197 | my $success = $scp->put( | ||||
| 198 | $clientpkg, | ||||
| 199 | $dest_path, | ||||
| 200 | ); | ||||
| 201 | return "Can not copy client package '$clientpkg' to $hostname:/$dest_path: ".$scp->{errstr} if not $success; | ||||
| 202 | |||||
| 203 | my $error = Net::SSH::ssh("$hostname","tar -xzf $dest_path -C /"); | ||||
| 204 | return "Can not unpack client package on $hostname: $!" if $error; | ||||
| 205 | return 0; | ||||
| 206 | } | ||||
| 207 | |||||
| - - | |||||
| 210 | =head2 reboot_system | ||||
| 211 | |||||
| 212 | Reboot the named system. First we try to do it softly, if that does not | ||||
| 213 | work, we try a hard reboot. Unfortunately this does not give any | ||||
| 214 | feedback. Thus you have to wait for the typical reboot time of the | ||||
| 215 | system in question and if the system does not react after this time | ||||
| 216 | assume that the reboot failed. This is not included in this function, | ||||
| 217 | since it would make it to complex. | ||||
| 218 | |||||
| 219 | @param string - name of the system to be rebooted | ||||
| 220 | @param bool - hard reset without ssh | ||||
| 221 | |||||
| 222 | @return success - 0 | ||||
| 223 | @return error - error string | ||||
| 224 | |||||
| 225 | =cut | ||||
| 226 | |||||
| 227 | sub reboot_system | ||||
| 228 | { | ||||
| 229 | my ($self, $host, $hard) = @_; | ||||
| 230 | $self->log->debug("Trying to reboot $host."); | ||||
| 231 | |||||
| 232 | |||||
| 233 | my $reset_plugin = $self->cfg->{reset_plugin}; | ||||
| 234 | my $reset_plugin_options = $self->cfg->{reset_plugin_options}; | ||||
| 235 | |||||
| 236 | my $reset_class = "Tapper::MCP::Net::Reset::$reset_plugin"; | ||||
| 237 | eval "use $reset_class"; ## no critic | ||||
| 238 | |||||
| 239 | if ($@) { | ||||
| 240 | return "Could not load $reset_class"; | ||||
| 241 | } else { | ||||
| 242 | 3 | 315µs | 2 | 43µs | # spent 26µs (9+17) within Tapper::MCP::Net::BEGIN@242 which was called:
# once (9µs+17µs) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 242 # spent 26µs making 1 call to Tapper::MCP::Net::BEGIN@242
# spent 17µs making 1 call to strict::unimport |
| 243 | $self->log->debug("Call $reset_class->reset_host($host, $reset_plugin_options)"); | ||||
| 244 | my $reset_object = $reset_class->new(); | ||||
| 245 | my ($error, $retval) = $reset_object->reset_host($host, $reset_plugin_options); | ||||
| 246 | if ($error) { | ||||
| 247 | $self->log->error("Error occured: ".$retval); | ||||
| 248 | return $retval; | ||||
| 249 | } | ||||
| 250 | return 0; | ||||
| 251 | } | ||||
| 252 | } | ||||
| 253 | |||||
| 254 | |||||
| 255 | =head2 write_grub_file | ||||
| 256 | |||||
| 257 | Write the given text to the grub file for the system given as parameter. | ||||
| 258 | |||||
| 259 | @param string - name of the system | ||||
| 260 | @param string - text to put into grub file | ||||
| 261 | |||||
| 262 | |||||
| 263 | @return success - 0 | ||||
| 264 | @return error - error string | ||||
| 265 | |||||
| 266 | =cut | ||||
| 267 | |||||
| 268 | sub write_grub_file | ||||
| 269 | { | ||||
| 270 | my ($self, $system, $text) = @_; | ||||
| 271 | return "No grub text given" unless $text; | ||||
| 272 | |||||
| 273 | my $grub_file = $self->cfg->{paths}{grubpath}."/$system.lst"; | ||||
| 274 | $self->log->debug("writing grub file $grub_file"); | ||||
| 275 | |||||
| 276 | # create the initial grub file for installation of the test system, | ||||
| 277 | open (my $GRUBFILE, ">", $grub_file) or return "Can open ".$self->cfg->{paths}{grubpath}."/$system.lst for writing: $!"; | ||||
| 278 | print $GRUBFILE $text; | ||||
| 279 | close $GRUBFILE or return "Can't save grub file for $system:$!"; | ||||
| 280 | return(0); | ||||
| 281 | } | ||||
| 282 | |||||
| 283 | |||||
| 284 | =head2 hw_report_create | ||||
| 285 | |||||
| 286 | Create a report containing the test machines hw config as set in the hardware | ||||
| 287 | db. Leave the sending to caller | ||||
| 288 | |||||
| 289 | @param int - testrun id | ||||
| 290 | |||||
| 291 | @return success - (0, hw_report) | ||||
| 292 | @return error - (1, error string) | ||||
| 293 | |||||
| 294 | =cut | ||||
| 295 | |||||
| 296 | sub hw_report_create | ||||
| 297 | { | ||||
| 298 | my ($self, $testrun_id) = @_; | ||||
| 299 | my $testrun = model->resultset('Testrun')->find($testrun_id); | ||||
| 300 | my $host; | ||||
| 301 | eval { | ||||
| 302 | # parts of this chain may be undefined | ||||
| 303 | |||||
| 304 | $host = $testrun->testrun_scheduling->host; | ||||
| 305 | }; | ||||
| 306 | return (1, qq(testrun '$testrun_id' has no host associated)) unless $host; | ||||
| 307 | |||||
| 308 | my $data = get_hardware_overview($host->id); | ||||
| 309 | my $yaml = Dump($data); | ||||
| 310 | $yaml .= "...\n"; | ||||
| 311 | $yaml =~ s/^(.*)$/ $1/mg; # indent | ||||
| 312 | my $report = sprintf(" | ||||
| 313 | TAP Version 13 | ||||
| 314 | 1..2 | ||||
| 315 | # Tapper-Reportgroup-Testrun: %s | ||||
| 316 | # Tapper-Suite-Name: Hardwaredb Overview | ||||
| 317 | # Tapper-Suite-Version: %s | ||||
| 318 | # Tapper-Machine-Name: %s | ||||
| 319 | ok 1 - Getting hardware information | ||||
| 320 | %s | ||||
| 321 | ok 2 - Sending | ||||
| 322 | ", $testrun_id, $Tapper::MCP::VERSION, $host->name, $yaml); | ||||
| 323 | |||||
| 324 | return (0, $report); | ||||
| 325 | } | ||||
| 326 | |||||
| 327 | 1 | 7µs | 1; |