← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:36 2012

Filename/2home/ss5/local/projects/Tapper/src/Tapper-MCP/lib/Tapper/MCP/Net.pm
StatementsExecuted 47 statements in 2.18ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1112.34ms3.87msTapper::MCP::Net::::BEGIN@10Tapper::MCP::Net::BEGIN@10
1111.53ms8.13msTapper::MCP::Net::::BEGIN@13Tapper::MCP::Net::BEGIN@13
1111.10ms2.04msTapper::MCP::Net::::BEGIN@12Tapper::MCP::Net::BEGIN@12
111897µs8.98msTapper::MCP::Net::::BEGIN@11Tapper::MCP::Net::BEGIN@11
111756µs3.72msTapper::MCP::Net::::BEGIN@16Tapper::MCP::Net::BEGIN@16
111700µs1.30msTapper::MCP::Net::::BEGIN@5Tapper::MCP::Net::BEGIN@5
11172µs123µsTapper::MCP::Net::::BEGIN@7Tapper::MCP::Net::BEGIN@7
11130µs34µsTapper::MCP::Net::::BEGIN@3Tapper::MCP::Net::BEGIN@3
11114µs42µsTapper::MCP::Net::::BEGIN@14Tapper::MCP::Net::BEGIN@14
11113µs4.53msTapper::MCP::Net::::BEGIN@9Tapper::MCP::Net::BEGIN@9
11110µs51µsTapper::MCP::Net::::BEGIN@7.9Tapper::MCP::Net::BEGIN@7.9
11110µs38µsTapper::MCP::Net::::BEGIN@20Tapper::MCP::Net::BEGIN@20
1119µs26µsTapper::MCP::Net::::BEGIN@242Tapper::MCP::Net::BEGIN@242
1119µs27µsTapper::MCP::Net::::BEGIN@4Tapper::MCP::Net::BEGIN@4
1118µs44µsTapper::MCP::Net::::BEGIN@15Tapper::MCP::Net::BEGIN@15
0000s0sTapper::MCP::Net::::__ANON__[lib/Tapper/MCP/Net.pm:106]Tapper::MCP::Net::__ANON__[lib/Tapper/MCP/Net.pm:106]
0000s0sTapper::MCP::Net::::conserver_connectTapper::MCP::Net::conserver_connect
0000s0sTapper::MCP::Net::::conserver_disconnectTapper::MCP::Net::conserver_disconnect
0000s0sTapper::MCP::Net::::hw_report_createTapper::MCP::Net::hw_report_create
0000s0sTapper::MCP::Net::::install_client_packageTapper::MCP::Net::install_client_package
0000s0sTapper::MCP::Net::::reboot_systemTapper::MCP::Net::reboot_system
0000s0sTapper::MCP::Net::::start_simnowTapper::MCP::Net::start_simnow
0000s0sTapper::MCP::Net::::start_sshTapper::MCP::Net::start_ssh
0000s0sTapper::MCP::Net::::write_grub_fileTapper::MCP::Net::write_grub_file
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Tapper::MCP::Net;
2
3319µs237µ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
use strict;
# spent 34µs making 1 call to Tapper::MCP::Net::BEGIN@3 # spent 4µs making 1 call to strict::import
4358µs244µ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
use warnings;
# spent 27µs making 1 call to Tapper::MCP::Net::BEGIN@4 # spent 18µs making 1 call to warnings::import
53134µs21.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
use English '-no_match_vars';
# spent 1.30ms making 1 call to Tapper::MCP::Net::BEGIN@5 # spent 413µs making 1 call to English::import
6
7693µs3215µs
# spent 51µs (10+41) within Tapper::MCP::Net::BEGIN@7.9 which was called: # once (10µs+41µs) by Tapper::MCP::Net::BEGIN@7 at line 7 # spent 123µs (72+51) within Tapper::MCP::Net::BEGIN@7 which was called: # once (72µs+51µs) by Tapper::MCP::Scheduler::Controller::BEGIN@11 at line 7
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
9358µs29.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
use Moose;
# 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]
103152µs24.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
use Socket;
# spent 3.87ms making 1 call to Tapper::MCP::Net::BEGIN@10 # spent 787µs making 1 call to Exporter::import
113118µs28.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
use Net::SSH;
# spent 8.98ms making 1 call to Tapper::MCP::Net::BEGIN@11 # spent 15µs making 1 call to Exporter::import
123108µs22.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
use Net::SCP;
# spent 2.04ms making 1 call to Tapper::MCP::Net::BEGIN@12 # spent 14µs making 1 call to Exporter::import
133115µs29.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
use IO::Socket::INET;
# spent 8.13ms making 1 call to Tapper::MCP::Net::BEGIN@13 # spent 1.29ms making 1 call to IO::Socket::import
14323µs269µ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
use Sys::Hostname;
# spent 42µs making 1 call to Tapper::MCP::Net::BEGIN@14 # spent 28µs making 1 call to Exporter::import
15318µs281µ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
use File::Basename;
# spent 44µs making 1 call to Tapper::MCP::Net::BEGIN@15 # spent 36µs making 1 call to Exporter::import
163122µs23.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
use YAML;
# spent 3.72ms making 1 call to Tapper::MCP::Net::BEGIN@16 # spent 39µs making 1 call to Exporter::import
17
1816µs16.51msextends 'Tapper::MCP';
# spent 6.51ms making 1 call to Moose::extends
19
203828µs267µ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
use Tapper::Model qw(model get_hardware_overview);
# 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
24This function opens a connection to the conserver. Conserver, port and user
25can 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
37sub 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
90Disconnect the filehandle given as first argument from the conserver.
91We first try to quit kindly but if this fails (by what reason ever)
92the filehandle is simply closed. Closing a socket can not fail, so the
93function 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
101sub 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
121Start a simnow installation on given host. Installer is supposed to
122start the simnow controller in turn.
123
124@param string - hostname
125
126@return success - 0
127@return error - error string
128
129=cut
130
131sub 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
149Start 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
158sub 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
171Install client package of given architecture on given host at optional
172given 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
182sub 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
212Reboot the named system. First we try to do it softly, if that does not
213work, we try a hard reboot. Unfortunately this does not give any
214feedback. Thus you have to wait for the typical reboot time of the
215system in question and if the system does not react after this time
216assume that the reboot failed. This is not included in this function,
217since 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
227sub 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 {
2423315µs243µ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
no strict 'refs'; ## no critic
# 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
257Write 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
268sub 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
286Create a report containing the test machines hw config as set in the hardware
287db. 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
296sub 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("
313TAP Version 13
3141..2
315# Tapper-Reportgroup-Testrun: %s
316# Tapper-Suite-Name: Hardwaredb Overview
317# Tapper-Suite-Version: %s
318# Tapper-Machine-Name: %s
319ok 1 - Getting hardware information
320%s
321ok 2 - Sending
322", $testrun_id, $Tapper::MCP::VERSION, $host->name, $yaml);
323
324 return (0, $report);
325}
326
32717µs1;