File Coverage

lib/Rex/Commands/Process.pm
Criterion Covered Total %
statement 20 69 28.9
branch 0 22 0.0
condition 0 7 0.0
subroutine 7 11 63.6
pod 4 4 100.0
total 31 113 27.4


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             =head1 NAME
6              
7             Rex::Commands::Process - Process management commands
8              
9             =head1 DESCRIPTION
10              
11             With this module you can manage processes. List, Kill, and so on.
12              
13             Version <= 1.0: All these functions will not be reported.
14              
15             All these functions are not idempotent.
16              
17             =head1 SYNOPSIS
18              
19             kill $pid;
20             killall "apache2";
21             nice($pid, $level);
22              
23             =head1 EXPORTED FUNCTIONS
24              
25             =cut
26              
27             package Rex::Commands::Process;
28              
29 32     32   462 use v5.12.5;
  32         141  
30 32     32   237 use warnings;
  32         88  
  32         1567  
31              
32             our $VERSION = '1.14.2.3'; # TRIAL VERSION
33              
34             require Rex::Exporter;
35 32     32   289 use Data::Dumper;
  32         107  
  32         1695  
36 32     32   223 use Rex::Helper::Run;
  32         93  
  32         1861  
37 32     32   582 use Rex::Commands::Gather;
  32         73  
  32         281  
38              
39 32     32   821 use vars qw(@EXPORT);
  32         434  
  32         1671  
40 32     32   240 use base qw(Rex::Exporter);
  32         239  
  32         28472  
41              
42             @EXPORT = qw(kill killall
43             ps
44             nice);
45              
46             =head2 kill($pid, $sig)
47              
48             Will kill the given process id. If $sig is specified it will kill with the given signal.
49              
50             task "kill", "server01", sub {
51             kill 9931;
52             kill 9931, -9;
53             };
54              
55             =cut
56              
57             sub kill {
58 0     0 1   my ( $process, $sig ) = @_;
59 0   0       $sig ||= "";
60              
61 0           i_run( "kill $sig " . $process, fail_ok => 1 );
62 0 0         if ( $? != 0 ) {
63 0           die("Error killing $process");
64             }
65             }
66              
67             =head2 killall($name, $sig)
68              
69             Will kill the given process. If $sig is specified it will kill with the given signal.
70              
71             task "kill-apaches", "server01", sub {
72             killall "apache2";
73             killall "apache2", -9;
74             };
75              
76             =cut
77              
78             sub killall {
79 0     0 1   my ( $process, $sig ) = @_;
80 0   0       $sig ||= "";
81              
82 0 0         if ( can_run("killall") ) {
83 0           i_run( "killall $sig $process", fail_ok => 1 );
84 0 0         if ( $? != 0 ) {
85 0           die("Error killing $process");
86             }
87             }
88             else {
89 0           die("Can't execute killall.");
90             }
91             }
92              
93             =head2 ps
94              
95             List all processes on a system. Will return all fields of a I.
96              
97             task "ps", "server01", sub {
98             for my $process (ps()) {
99             say "command > " . $process->{"command"};
100             say "pid > " . $process->{"pid"};
101             say "cpu-usage> " . $process->{"cpu"};
102             }
103             };
104              
105              
106             On most operating systems it is also possible to define custom parameters for ps() function.
107              
108             task "ps", "server01", sub {
109             my @list = grep { $_->{"ni"} == -5 } ps("command","ni");
110             };
111              
112             This example would contain all processes with a nice of -5.
113              
114              
115             =cut
116              
117             sub ps {
118 0     0 1   my (@custom) = @_;
119 0           my @list;
120              
121 0 0 0       if (is_openwrt) {
    0          
122              
123             # openwrt doesn't have ps aux
124 0           @list = i_run( "ps", fail_ok => 1 );
125              
126 0           my @ret = ();
127 0           for my $line (@list) {
128 0           $line =~ s/^\s*|\s*$//g;
129 0           my ( $pid, $user, $vsz, $stat, $command ) = split( /\s+/, $line, 5 );
130              
131 0           push(
132             @ret,
133             {
134             user => $user,
135             pid => $pid,
136             vsz => $vsz,
137             stat => $stat,
138             command => $command,
139             }
140             );
141             }
142              
143 0           return @ret;
144             }
145              
146             elsif ( operating_system_is("SunOS") && operating_system_version() <= 510 ) {
147 0 0         if (@custom) {
148 0           @list =
149             i_run( "/usr/ucb/ps awwx -o" . join( ",", @custom ), fail_ok => 1 );
150             }
151             else {
152 0           @list = i_run( "/usr/ucb/ps auwwx", fail_ok => 1 );
153             }
154             }
155             else {
156 0 0         if (@custom) {
157 0           @list = i_run( "ps awwx -o" . join( ",", @custom ), fail_ok => 1 );
158             }
159             else {
160 0           @list = i_run( "ps auwwx", fail_ok => 1 );
161             }
162             }
163              
164 0 0         if ( $? != 0 ) {
165 0 0         if (@custom) {
166 0           die( "Error running ps ax -o" . join( ",", @custom ) );
167             }
168             else {
169 0           die("Error running ps aux");
170             }
171             }
172 0           shift @list;
173              
174 0           my @ret = ();
175 0 0         if (@custom) {
176 0           for my $line (@list) {
177 0           $line =~ s/^\s+//;
178 0           my @col_vals = split( /\s+/, $line, scalar(@custom) );
179 0           my %vals;
180 0           @vals{@custom} = @col_vals;
181 0           push @ret, {%vals};
182             }
183             }
184             else {
185 0           for my $line (@list) {
186             my (
187 0           $user, $pid, $cpu, $mem, $vsz, $rss,
188             $tty, $stat, $start, $time, $command
189             ) = split( /\s+/, $line, 11 );
190              
191 0           push(
192             @ret,
193             {
194             user => $user,
195             pid => $pid,
196             cpu => $cpu,
197             mem => $mem,
198             vsz => $vsz,
199             rss => $rss,
200             tty => $tty,
201             stat => $stat,
202             start => $start,
203             time => $time,
204             command => $command,
205             }
206             );
207             }
208             }
209              
210 0           return @ret;
211             }
212              
213             #Will try to start a process with nohup in the background.
214             #
215             # task "start_in_bg", "server01", sub {
216             # nohup "/opt/srv/myserver";
217             # };
218              
219             #sub nohup {
220             # my ($cmd) = @_;
221             #
222             # run "nohup $cmd &";
223             #}
224              
225             =head2 nice($pid, $level)
226              
227             Renice a process identified by $pid with the priority $level.
228              
229             task "renice", "server01", sub {
230             nice (153, -5);
231             };
232              
233             =cut
234              
235             sub nice {
236 0     0 1   my ( $pid, $level ) = @_;
237 0           i_run "renice $level $pid", fail_ok => 1;
238 0 0         if ( $? != 0 ) {
239 0           die("Error renicing $pid");
240             }
241             }
242              
243             1;