proc/linux-lib.pl

   1 # linux-lib.pl
   2 # Functions for parsing linux ps output
   3
   4 use Time::Local;
   5
   6 sub get_ps_version
   7 {
   8 if (!$get_ps_version_cache) {
   9         local $out = &backquote_command("ps V 2>&1");
  10         if ($out =~ /version\s+([0-9\.]+)\./) {
  11                 $get_ps_version_cache = $1;
  12                 }
  13         }
  14 return $get_ps_version_cache;
  15 }
  16
  17 sub list_processes
  18 {
  19 local($pcmd, $line, $i, %pidmap, @plist, $dummy, @w, $_);
  20 local $ver = &get_ps_version();
  21 if ($ver >= 2) {
  22         # New version of ps, as found in redhat 6
  23         local $width;
  24         if ($ver >= 3.2) {
  25                 # Use width format character if allowed
  26                 $width = ":80";
  27                 }
  28         open(PS, "ps --cols 2048 -eo user$width,ruser$width,group$width,rgroup$width,pid,ppid,pgid,pcpu,vsz,nice,etime,time,stime,tty,args 2>/dev/null |");
  29         $dummy = <PS>;
  30         for($i=0; $line=<PS>; $i++) {
  31                 chop($line);
  32                 $line =~ s/^\s+//g;
  33                 eval { @w = split(/\s+/, $line, -1); };
  34                 if ($@) {
  35                         # Hit a split loop
  36                         $i--; next;
  37                         }
  38                 if ($line =~ /ps --cols 500 -eo user/) {
  39                         # Skip process ID 0 or ps command
  40                         $i--; next;
  41                         }
  42                 if (@_ && &indexof($w[4], @_) < 0) {
  43                         # Not interested in this PID
  44                         $i--; next;
  45                         }
  46                 $plist[$i]->{"pid"} = $w[4];
  47                 $plist[$i]->{"ppid"} = $w[5];
  48                 $plist[$i]->{"user"} = $w[0];
  49                 $plist[$i]->{"cpu"} = "$w[7] %";
  50                 $plist[$i]->{"size"} = "$w[8] kB";
  51                 $plist[$i]->{"time"} = $w[11];
  52                 $plist[$i]->{"_stime"} = $w[12];
  53                 $plist[$i]->{"nice"} = $w[9];
  54                 $plist[$i]->{"args"} = @w<15 ? "defunct" : join(' ', @w[14..$#w]);
  55                 $plist[$i]->{"_group"} = $w[2];
  56                 $plist[$i]->{"_ruser"} = $w[1];
  57                 $plist[$i]->{"_rgroup"} = $w[3];
  58                 $plist[$i]->{"_pgid"} = $w[6];
  59                 $plist[$i]->{"_tty"} = $w[13] =~ /\?/ ? $text{'edit_none'} : "/dev/$w[13]";
  60                 }
  61         close(PS);
  62         }
  63 else {
  64         # Old version of ps
  65         $pcmd = join(' ' , @_);
  66         open(PS, "ps aulxhwwww $pcmd 2>/dev/nul |");
  67         for($i=0; $line=<PS>; $i++) {
  68                 chop($line);
  69                 if ($line =~ /ps aulxhwwww/) { $i--; next; }
  70                 if ($line !~ /^\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+([\-\d]+)\s+([\-\d]+)\s+(\d+)\s+(\d+)\s+(\S*)\s+(\S+)[\s<>N]+(\S+)\s+([0-9:]+)\s+(.*)$/) {
  71                         $i--;
  72                         next;
  73                         }
  74                 $pidmap{$3} = $i;
  75                 $plist[$i]->{"pid"} = $3;
  76                 $plist[$i]->{"ppid"} = $4;
  77                 $plist[$i]->{"user"} = getpwuid($2);
  78                 $plist[$i]->{"size"} = "$7 kB";
  79                 $plist[$i]->{"cpu"} = "Unknown";
  80                 $plist[$i]->{"time"} = $12;
  81                 $plist[$i]->{"nice"} = $6;
  82                 $plist[$i]->{"args"} = $13;
  83                 $plist[$i]->{"_pri"} = $5;
  84                 $plist[$i]->{"_tty"} = $11 eq "?" ? $text{'edit_none'} : "/dev/tty$11";
  85                 $plist[$i]->{"_status"} = $stat_map{substr($10, 0, 1)};
  86                 ($plist[$i]->{"_wchan"} = $9) =~ s/\s+$//g;
  87                 if (!$plist[$i]->{"_wchan"}) { delete($plist[$i]->{"_wchan"}); }
  88                 if ($plist[$i]->{"args"} =~ /^\((.*)\)/)
  89                         { $plist[$i]->{"args"} = $1; }
  90                 }
  91         close(PS);
  92         open(PS, "ps auxh $pcmd |");
  93         while($line=<PS>) {
  94                 if ($line =~ /^\s*(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+/ &&
  95                     defined($pidmap{$2})) {
  96                         $plist[$pidmap{$2}]->{"cpu"} = $3;
  97                         $plist[$pidmap{$2}]->{"_mem"} = "$4 %";
  98                         }
  99                 }
 100         close(PS);
 101         }
 102 return @plist;
 103 }
 104
 105 # renice_proc(pid, nice)
 106 sub renice_proc
 107 {
 108 return undef if (&is_readonly_mode());
 109 local $out = &backquote_logged("renice $_[1] -p $_[0] 2>&1");
 110 if ($?) { return $out; }
 111 return undef;
 112 }
 113
 114 # find_mount_processes(mountpoint)
 115 # Find all processes under some mount point
 116 sub find_mount_processes
 117 {
 118 local($out);
 119 $out = &backquote_command("fuser -m ".quotemeta($_[0])." 2>/dev/null");
 120 $out =~ s/[^0-9 ]//g;
 121 $out =~ s/^\s+//g; $out =~ s/\s+$//g;
 122 return split(/\s+/, $out);
 123 }
 124
 125 # find_file_processes([file]+)
 126 # Find all processes with some file open
 127 sub find_file_processes
 128 {
 129 local($out, $files);
 130 $files = join(' ', map { quotemeta($_) } map { glob($_) } @_);
 131 $out = &backquote_command("fuser $files 2>/dev/null");
 132 $out =~ s/[^0-9 ]//g;
 133 $out =~ s/^\s+//g; $out =~ s/\s+$//g;
 134 return split(/\s+/, $out);
 135 }
 136
 137 # get_new_pty()
 138 # Returns the filehandles and names for a pty and tty
 139 sub get_new_pty
 140 {
 141 if (-r "/dev/ptmx" && -d "/dev/pts" && open(PTMX, "+>/dev/ptmx")) {
 142         # Can use new-style PTY number allocation device
 143         local $unl;
 144         local $ptn;
 145
 146         # ioctl to unlock the PTY (TIOCSPTLCK)
 147         $unl = pack("i", 0);
 148         ioctl(PTMX, 0x40045431, $unl) || &error("Unlock ioctl failed : $!");
 149         $unl = unpack("i", $unl);
 150
 151         # ioctl to request a TTY (TIOCGPTN)
 152         ioctl(PTMX, 0x80045430, $ptn) || &error("PTY ioctl failed : $!");
 153         $ptn = unpack("i", $ptn);
 154
 155         local $tty = "/dev/pts/$ptn";
 156         return (*PTMX, undef, $tty, $tty);
 157         }
 158 else {
 159         # Have to search manually through pty files!
 160         local @ptys;
 161         local $devstyle;
 162         if (-d "/dev/pty") {
 163                 opendir(DEV, "/dev/pty");
 164                 @ptys = map { "/dev/pty/$_" } readdir(DEV);
 165                 closedir(DEV);
 166                 $devstyle = 1;
 167                 }
 168         else {
 169                 opendir(DEV, "/dev");
 170                 @ptys = map { "/dev/$_" } (grep { /^pty/ } readdir(DEV));
 171                 closedir(DEV);
 172                 $devstyle = 0;
 173                 }
 174         local ($pty, $tty);
 175         foreach $pty (@ptys) {
 176                 open(PTY, "+>$pty") || next;
 177                 local $tty = $pty;
 178                 if ($devstyle == 0) {
 179                         $tty =~ s/pty/tty/;
 180                         }
 181                 else {
 182                         $tty =~ s/m(\d+)$/s$1/;
 183                         }
 184                 local $old = select(PTY); $| = 1; select($old);
 185                 if ($< == 0) {
 186                         # Don't need to open the TTY file here for root,
 187                         # as it will be opened later after the controlling
 188                         # TTY has been released.
 189                         return (*PTY, undef, $pty, $tty);
 190                         }
 191                 else {
 192                         # Must open now ..
 193                         open(TTY, "+>$tty");
 194                         select(TTY); $| = 1; select($old);
 195                         return (*PTY, *TTY, $pty, $tty);
 196                         }
 197                 }
 198         return ();
 199         }
 200 }
 201
 202 # close_controlling_pty()
 203 # Disconnects this process from it's controlling PTY, if connected
 204 sub close_controlling_pty
 205 {
 206 if (open(DEVTTY, "/dev/tty")) {
 207         # Special ioctl to disconnect (TIOCNOTTY)
 208         ioctl(DEVTTY, 0x5422, 0);
 209         close(DEVTTY);
 210         }
 211 }
 212
 213 # open_controlling_pty(ptyfh, ttyfh, ptyfile, ttyfile)
 214 # Makes a PTY returned from get_new_pty the controlling TTY (/dev/tty) for
 215 # this process.
 216 sub open_controlling_pty
 217 {
 218 local ($ptyfh, $ttyfh, $pty, $tty) = @_;
 219
 220 # Call special ioctl to attach /dev/tty to this new tty (TIOCSCTTY)
 221 ioctl($ttyfh, 0x540e, 0);
 222 }
 223
 224 # get_memory_info()
 225 # Returns a list containing the real mem, free real mem, swap and free swap
 226 # (In kilobytes).
 227 sub get_memory_info
 228 {
 229 local %m;
 230 if (open(BEAN, "/proc/user_beancounters")) {
 231         # If we are running under Virtuozzo, there may be a limit on memory
 232         # use in force that is less than the real system's memory.
 233         while(<BEAN>) {
 234                 if (/^privvmpages\s+(\d+)\s+(\d+)\s+(\d+)/) {
 235                         return ($3, $3-$1, undef, undef);
 236                         }
 237                 }
 238         close(BEAN);
 239         }
 240 open(MEMINFO, "/proc/meminfo") || return ();
 241 while(<MEMINFO>) {
 242         if (/^(\S+):\s+(\d+)/) {
 243                 $m{lc($1)} = $2;
 244                 }
 245         }
 246 close(MEMINFO);
 247 return ( $m{'memtotal'}, $m{'cached'} > $m{'memtotal'} ? $m{'memfree'}
 248                                 : $m{'memfree'}+$m{'buffers'}+$m{'cached'},
 249          $m{'swaptotal'}, $m{'swapfree'} );
 250 }
 251
 252 # os_get_cpu_info()
 253 # Returns a list containing the 5, 10 and 15 minute load averages, and the
 254 # CPU mhz, model, vendor, cache and count
 255 sub os_get_cpu_info
 256 {
 257 open(LOAD, "/proc/loadavg") || return ();
 258 local @load = split(/\s+/, <LOAD>);
 259 close(LOAD);
 260 local %c;
 261 open(CPUINFO, "/proc/cpuinfo");
 262 while(<CPUINFO>) {
 263         if (/^(\S[^:]*\S)\s*:\s*(.*)/) {
 264                 $c{lc($1)} = $2;
 265                 }
 266         }
 267 close(CPUINFO);
 268 $c{'model name'} =~ s/\d+\s*mhz//i;
 269 if ($c{'cache size'} =~ /^(\d+)\s+KB/i) {
 270         $c{'cache size'} = $1*1024;
 271         }
 272 elsif ($c{'cache size'} =~ /^(\d+)\s+MB/i) {
 273         $c{'cache size'} = $1*1024*1024;
 274         }
 275 if ($c{'cpu mhz'}) {
 276         return ( $load[0], $load[1], $load[2],
 277                  int($c{'cpu mhz'}), $c{'model name'}, $c{'vendor_id'},
 278                  $c{'cache size'}, $c{'processor'}+1 );
 279         }
 280 else {
 281         return ( $load[0], $load[1], $load[2] );
 282         }
 283 }
 284
 285 $has_trace_command = &has_command("strace");
 286
 287 # open_process_trace(pid, [&syscalls])
 288 # Starts tracing on some process, and returns a trace object
 289 sub open_process_trace
 290 {
 291 local $fh = time().$$;
 292 local $sc;
 293 if (@{$_[1]}) {
 294         $sc = "-e trace=".join(",", @{$_[1]});
 295         }
 296 local $tpid = open($fh, "strace -t -p $_[0] $sc 2>&1 |");
 297 $line = <$fh>;
 298 return { 'pid' => $_[0],
 299          'tpid' => $tpid,
 300          'fh' => $fh };
 301 }
 302
 303 # close_process_trace(&trace)
 304 # Halts tracing on some trace object
 305 sub close_process_trace
 306 {
 307 kill('TERM', $_[0]->{'tpid'}) if ($_[0]->{'tpid'});
 308 close($_[0]->{'fh'});
 309 }
 310
 311 # read_process_trace(&trace)
 312 # Returns an action structure representing one action by traced process, or
 313 # undef if an error occurred
 314 sub read_process_trace
 315 {
 316 local $fh = $_[0]->{'fh'};
 317 local @tm = localtime(time());
 318 while(1) {
 319         local $line = <$fh>;
 320         return undef if (!$line);
 321         if ($line =~ /^(\d+):(\d+):(\d+)\s+([^\(]+)\((.*)\)\s*=\s*(\-?\d+|\?)/) {
 322                 local $tm = timelocal($3, $2, $1, $tm[3], $tm[4], $tm[5]);
 323                 local $action = { 'time' => $tm,
 324                                   'call' => $4,
 325                                   'rv' => $6 eq "?" ? undef : $6 };
 326                 local $args = $5;
 327                 local @args;
 328                 while(1) {
 329                         if ($args =~ /^[ ,]*(\{[^}]*\})(.*)$/) {
 330                                 # A structure in { }
 331                                 push(@args, $1);
 332                                 $args = $2;
 333                                 }
 334                         elsif ($args =~ /^[ ,]*"([^"]*)"\.*(.*)$/) {
 335                                 # A quoted string
 336                                 push(@args, $1);
 337                                 $args = $2;
 338                                 }
 339                         elsif ($args =~ /^[ ,]*\[([^\]]*)\](.*)$/) {
 340                                 # A square-bracket number
 341                                 push(@args, $1);
 342                                 $args = $2;
 343                                 }
 344                         elsif ($args =~ /^[ ,]*\<([^\>]*)\>(.*)$/) {
 345                                 # An angle-bracketed string
 346                                 push(@args, $1);
 347                                 $args = $2;
 348                                 }
 349                         elsif ($args =~ /[ ,]*([^, ]+)(.*)$/) {
 350                                 # Just a number
 351                                 push(@args, $1);
 352                                 $args = $2;
 353                                 }
 354                         else {
 355                                 last;
 356                                 }
 357                         }
 358                 if ($args[$#args] eq $action->{'rv'}) {
 359                         pop(@args);     # last arg is same as return value?
 360                         }
 361                 $action->{'args'} = \@args;
 362                 return $action;
 363                 }
 364         }
 365 }
 366
 367 foreach $ia (keys %text) {
 368         if ($ia =~ /^linux(_\S+)/) {
 369                 $info_arg_map{$1} = $text{$ia};
 370                 }
 371         elsif ($ia =~ /^linuxstat_(\S+)/) {
 372                 $stat_map{$1} = $text{$ia};
 373                 }
 374         }
 375
 376 @nice_range = (-20 .. 20);
 377
 378 $has_fuser_command = 1;
 379
 380 # os_list_scheduling_classes()
 381 # Returns a list of Linux scheduling classes, if supported. Each element is a
 382 # 2-element array ref containing a code and description.
 383 sub os_list_scheduling_classes
 384 {
 385 if (&has_command("ionice")) {
 386         return ( [ 1, $text{'linux_real'} ],
 387                  [ 2, $text{'linux_be'} ],
 388                  [ 3, $text{'linux_idle'} ] );
 389         }
 390 return ( );
 391 }
 392
 393 # os_list_scheduling_priorities()
 394 # Returns a list of IO priorities, each of which is an array ref containing
 395 # a number and description
 396 sub os_list_scheduling_priorities
 397 {
 398 return ( [ 0, "0 ($text{'edit_prihigh'})" ],
 399          [ 1 ], [ 2 ], [ 3 ], [ 4 ], [ 5 ], [ 6 ],
 400          [ 7, "7 ($text{'edit_prilow'})" ] );
 401 }
 402
 403 # os_get_scheduling_class(pid)
 404 # Returns the IO scheduling class and priority for a running program
 405 sub os_get_scheduling_class
 406 {
 407 local ($pid) = @_;
 408 local $out = &backquote_command("ionice -p ".quotemeta($pid));
 409 if ($out =~ /^(realtime|best-effort|idle|none):\s+prio\s+(\d+)/) {
 410         return ($1 eq "realtime" ? 1 : $1 eq "best-effort" ? 2 :
 411                 $1 eq "idle" ? 3 : 0, $2);
 412         }
 413 return ( );
 414 }
 415
 416 # os_set_scheduling_class(pid, class, priority)
 417 # Sets the ID scheduling class and priority for some process. Returns an error
 418 # message on failure, undef on success.
 419 sub os_set_scheduling_class
 420 {
 421 local ($pid, $class, $prio) = @_;
 422 local $cmd = "ionice -c ".quotemeta($class);
 423 $cmd .= " -n ".quotemeta($prio) if (defined($prio));
 424 $cmd .= " -p ".quotemeta($pid);
 425 local $out = &backquote_logged("$cmd 2>&1 </dev/null");
 426 return $? ? $out : undef;
 427 }
 428
 429 1;
 430