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 | BEGIN@10 | Tapper::MCP::Net::
1 | 1 | 1 | 1.53ms | 8.13ms | BEGIN@13 | Tapper::MCP::Net::
1 | 1 | 1 | 1.10ms | 2.04ms | BEGIN@12 | Tapper::MCP::Net::
1 | 1 | 1 | 897µs | 8.98ms | BEGIN@11 | Tapper::MCP::Net::
1 | 1 | 1 | 756µs | 3.72ms | BEGIN@16 | Tapper::MCP::Net::
1 | 1 | 1 | 700µs | 1.30ms | BEGIN@5 | Tapper::MCP::Net::
1 | 1 | 1 | 72µs | 123µs | BEGIN@7 | Tapper::MCP::Net::
1 | 1 | 1 | 30µs | 34µs | BEGIN@3 | Tapper::MCP::Net::
1 | 1 | 1 | 14µs | 42µs | BEGIN@14 | Tapper::MCP::Net::
1 | 1 | 1 | 13µs | 4.53ms | BEGIN@9 | Tapper::MCP::Net::
1 | 1 | 1 | 10µs | 51µs | BEGIN@7.9 | Tapper::MCP::Net::
1 | 1 | 1 | 10µs | 38µs | BEGIN@20 | Tapper::MCP::Net::
1 | 1 | 1 | 9µs | 26µs | BEGIN@242 | Tapper::MCP::Net::
1 | 1 | 1 | 9µs | 27µs | BEGIN@4 | Tapper::MCP::Net::
1 | 1 | 1 | 8µs | 44µs | BEGIN@15 | Tapper::MCP::Net::
0 | 0 | 0 | 0s | 0s | __ANON__[lib/Tapper/MCP/Net.pm:106] | Tapper::MCP::Net::
0 | 0 | 0 | 0s | 0s | conserver_connect | Tapper::MCP::Net::
0 | 0 | 0 | 0s | 0s | conserver_disconnect | Tapper::MCP::Net::
0 | 0 | 0 | 0s | 0s | hw_report_create | Tapper::MCP::Net::
0 | 0 | 0 | 0s | 0s | install_client_package | Tapper::MCP::Net::
0 | 0 | 0 | 0s | 0s | reboot_system | Tapper::MCP::Net::
0 | 0 | 0 | 0s | 0s | start_simnow | Tapper::MCP::Net::
0 | 0 | 0 | 0s | 0s | start_ssh | Tapper::MCP::Net::
0 | 0 | 0 | 0s | 0s | write_grub_file | Tapper::MCP::Net::
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; |