proc/proc-lib.pl

   1 # proc-lib.pl
   2 # Functions for managing processes
   3
   4 BEGIN { push(@INC, ".."); };
   5 use WebminCore;
   6 use POSIX;
   7 use Config;
   8
   9 &init_config();
  10 if ($module_info{'usermin'} && !$ENV{'FOREIGN_MODULE_NAME'}) {
  11         &switch_to_remote_user();
  12         }
  13 do "$config{ps_style}-lib.pl";
  14 if ($module_info{'usermin'}) {
  15         %access = ( 'edit' => 1,
  16                     'run' => 1,
  17                     'users' => 'x' );
  18         $no_module_config = 1;
  19         $user_processes_only = 1;
  20         $index_file = "$user_module_config_directory/index";
  21         }
  22 else {
  23         %access = &get_module_acl();
  24         map { $hide{$_}++ } split(/\s+/, $access{'hide'});
  25         $index_file = "$module_config_directory/index";
  26         $user_processes_only = $access{'only'};
  27         if (!defined($access{'users'})) {
  28                 $access{'users'} = $access{'uid'} < 0 ? "x" :
  29                                    $access{'uid'} == 0 ? "*" :
  30                                         getpwuid($access{'uid'});
  31                 }
  32         }
  33 if ($access{'run'}) {
  34         if ($access{'users'} eq "*") {
  35                 $default_run_user = "root";
  36                 }
  37         elsif (&can_edit_process($remote_user)) {
  38                 $default_run_user = $remote_user;
  39                 }
  40         else {
  41                 local @canu = split(/\s+/, $access{'users'});
  42                 if ($canu[0] =~ /^\@(.*)$/) {
  43                         $default_run_user = undef;
  44                         }
  45                 elsif ($can[0] =~ /^(\d+)\-(\d+)$/) {
  46                         $default_run_user = getpwuid($1);
  47                         }
  48                 else {
  49                         $default_run_user = $canu[0];
  50                         }
  51                 }
  52         }
  53
  54 sub process_info
  55 {
  56 local @plist = &list_processes($_[0]);
  57 return @plist ? %{$plist[0]} : ();
  58 }
  59
  60 # index_links(current)
  61 sub index_links
  62 {
  63 local(%linkname, $l);
  64 print "<b>$text{'index_display'} : </b>\n";
  65 local @links;
  66 foreach $l ("tree", "user", "size", "cpu", ($has_zone ? ("zone") : ()),
  67             "search", "run") {
  68         next if ($l eq "run" && !$access{'run'});
  69         local $link;
  70         if ($l ne $_[0]) { $link .= "<a href=index_$l.cgi>"; }
  71         else { $link .= "<b>"; }
  72         $link .= $text{"index_$l"};
  73         if ($l ne $_[0]) { $link .= "</a>"; }
  74         else { $link .= "</b>"; }
  75         push(@links, $link);
  76         }
  77 print &ui_links_row(\@links);
  78 print "<p>\n";
  79 &create_user_config_dirs();
  80 open(INDEX, ">$index_file");
  81 $0 =~ /([^\/]+)$/;
  82 print INDEX "$1?$in\n";
  83 close(INDEX);
  84 }
  85
  86 # cut_string(string, [length])
  87 sub cut_string
  88 {
  89 local $len = $_[1] || $config{'cut_length'};
  90 if ($len && length($_[0]) > $len) {
  91         return substr($_[0], 0, $len)." ...";
  92         }
  93 return $_[0];
  94 }
  95
  96 # switch_acl_uid()
  97 sub switch_acl_uid
  98 {
  99 return if ($module_info{'usermin'});    # already switched!
 100 if ($access{'uid'} < 0) {
 101         local @u = getpwnam($remote_user);
 102         @u || &error("Failed to find user $remote_user");
 103         &switch_to_unix_user(\@u);
 104         }
 105 elsif ($access{'uid'}) {
 106         local @u = getpwuid($access{'uid'});
 107         &switch_to_unix_user(\@u);
 108         }
 109 }
 110
 111 # safe_process_exec(command, uid, gid, handle, [input], [fixtags], [bsmode],
 112 #                   [timeout], [safe])
 113 # Executes the given command as the given user/group and writes all output
 114 # to the given file handle. Finishes when there is no more output or the
 115 # process stops running. Returns the number of bytes read.
 116 sub safe_process_exec
 117 {
 118 if (&is_readonly_mode() && !$_[8]) {
 119         # Veto command in readonly mode
 120         return 0;
 121         }
 122 &webmin_debug_log('CMD', "cmd=$_[0] uid=$_[1] gid=$_[2]")
 123         if ($gconfig{'debug_what_cmd'});
 124
 125 if ($gconfig{'os_type'} eq 'windows') {
 126         # For Windows, just run the command and read output
 127         local $temp = &transname();
 128         open(TEMP, ">$temp");
 129         print TEMP $_[4];
 130         close(TEMP);
 131         &open_execute_command(OUT, "$_[0] <$temp 2>&1", 1);
 132         local $fh = $_[3];
 133         while(<OUT>) {
 134                 if ($_[5]) {
 135                         print $fh &html_escape($_);
 136                         }
 137                 else {
 138                         print $fh $_;
 139                         }
 140                 }
 141         close(OUT);
 142         return $got;
 143         }
 144 else {
 145         # setup pipes and fork the process
 146         local $chld = $SIG{'CHLD'};
 147         $SIG{'CHLD'} = \&safe_exec_reaper;
 148         pipe(OUTr, OUTw);
 149         pipe(INr, INw);
 150         local $pid = fork();
 151         if (!$pid) {
 152                 #setsid();
 153                 untie(*STDIN);
 154                 untie(*STDOUT);
 155                 untie(*STDERR);
 156                 open(STDIN, "<&INr");
 157                 open(STDOUT, ">&OUTw");
 158                 open(STDERR, ">&OUTw");
 159                 $| = 1;
 160                 close(OUTr); close(INw);
 161
 162                 if ($_[1]) {
 163                         if (defined($_[2])) {
 164                                 # switch to given UID and GID
 165                                 &switch_to_unix_user(
 166                                         [ undef, undef, $_[1], $_[2] ]);
 167                                 }
 168                         else {
 169                                 # switch to UID and all GIDs
 170                                 local @u = getpwuid($_[1]);
 171                                 &switch_to_unix_user(\@u);
 172                                 }
 173                         }
 174
 175                 # run the command
 176                 delete($ENV{'FOREIGN_MODULE_NAME'});
 177                 delete($ENV{'SCRIPT_NAME'});
 178                 exec("/bin/sh", "-c", $_[0]);
 179                 print "Exec failed : $!\n";
 180                 exit 1;
 181                 }
 182         close(OUTw); close(INr);
 183
 184         # Feed input (if any)
 185         print INw $_[4];
 186         close(INw);
 187
 188         # Read and show output
 189         local $fn = fileno(OUTr);
 190         local $got = 0;
 191         local $out = $_[3];
 192         local $line;
 193         local $start = time();
 194         $safe_process_exec_timeout = 0;
 195         while(1) {
 196                 local ($rmask, $buf);
 197                 vec($rmask, $fn, 1) = 1;
 198                 local $sel = select($rmask, undef, undef, 1);
 199                 if ($sel > 0 && vec($rmask, $fn, 1)) {
 200                         # got something to read.. print it
 201                         sysread(OUTr, $buf, 1024) || last;
 202                         $got += length($buf);
 203                         if ($_[5]) {
 204                                 $buf = &html_escape($buf);
 205                                 }
 206                         if ($_[6]) {
 207                                 # Convert backspaces and returns and escapes
 208                                 $line .= $buf;
 209                                 while($line =~ s/^([^\n]*\n)//) {
 210                                         local $one = $1;
 211                                         while($one =~ s/.\010//) { }
 212                                         $one =~ s/\033[^m]+m//g;
 213                                         print $out $one;
 214                                         }
 215                                 }
 216                         else {
 217                                 print $out $buf;
 218                                 }
 219                         }
 220                 elsif ($sel == 0) {
 221                         # nothing to read. maybe the process is done, and a
 222                         # subprocess is hanging things up
 223                         last if (!kill(0, $pid));
 224                         }
 225                 if ($_[7] && time() - $start > $_[7]) {
 226                         # Timeout exceeded - kill the process
 227                         kill(KILL, $pid);
 228                         $safe_process_exec_timeout = 1;
 229                         }
 230                 }
 231         close(OUTr);
 232         print $out $line;
 233         $SIG{'CHLD'} = $chld;
 234         return $got;
 235         }
 236 }
 237
 238 # safe_process_exec_logged(..)
 239 # Like safe_process_exec, but also logs the command
 240 sub safe_process_exec_logged
 241 {
 242 &additional_log('exec', undef, $_[0]);
 243 return &safe_process_exec(@_);
 244 }
 245
 246 sub safe_exec_reaper
 247 {
 248 local $xp;
 249 do {    local $oldexit = $?;
 250         $xp = waitpid(-1, WNOHANG);
 251         $? = $oldexit if ($? < 0);
 252         } while($xp > 0);
 253 }
 254
 255 # pty_process_exec(command, [uid, gid])
 256 # Starts the given command in a new pty and returns the pty filehandle and PID
 257 sub pty_process_exec
 258 {
 259 local ($cmd, $uid, $gid) = @_;
 260 if (&is_readonly_mode()) {
 261         # When in readonly mode, don't run the command
 262         $cmd = "/bin/true";
 263         }
 264 &webmin_debug_log('CMD', "cmd=$cmd uid=$uid gid=$gid")
 265         if ($gconfig{'debug_what_cmd'});
 266
 267 eval "use IO::Pty";
 268 if (!$@) {
 269         # Use the IO::Pty perl module if installed
 270         local $ptyfh = new IO::Pty;
 271         if (!$ptyfh) {
 272                 &error("Failed to create new PTY with IO::Pty");
 273                 }
 274         local $pid = fork();
 275         if (!$pid) {
 276                 local $ttyfh = $ptyfh->slave();
 277                 local $tty = $ptyfh->ttyname();
 278                 if (defined(&close_controlling_pty)) {
 279                         &close_controlling_pty();
 280                         }
 281                 setsid();       # create a new session group
 282                 $ptyfh->make_slave_controlling_terminal();
 283
 284                 # Turn off echoing, if we can
 285                 eval "use IO::Stty";
 286                 if (!$@) {
 287                         IO::Stty::stty($ttyfh, 'raw', '-echo');
 288                         }
 289
 290                 close(STDIN); close(STDOUT); close(STDERR);
 291                 untie(*STDIN); untie(*STDOUT); untie(*STDERR);
 292                 if ($_[1]) {
 293                         &switch_to_unix_user([ undef, undef, $_[1], $_[2] ]);
 294                         }
 295
 296                 close($ptyfh);          # Used by other side only
 297                 open(STDIN, "<&".fileno($ttyfh));
 298                 open(STDOUT, ">&".fileno($ttyfh));
 299                 open(STDERR, ">&".fileno($ttyfh));
 300                 close($ttyfh);          # Already dup'd
 301                 exec($cmd);
 302                 print "Exec failed : $!\n";
 303                 exit 1;
 304                 }
 305         $ptyfh->close_slave();
 306         return ($ptyfh, $pid);
 307         }
 308 else {
 309         # Need to create a PTY using built-in Webmin code
 310         local ($ptyfh, $ttyfh, $pty, $tty) = &get_new_pty();
 311         $tty || &error("Failed to create new PTY - try installing the IO::Tty Perl module");
 312         local $pid = fork();
 313         if (!$pid) {
 314                 if (defined(&close_controlling_pty)) {
 315                         &close_controlling_pty();
 316                         }
 317
 318                 setsid();       # create a new session group
 319
 320                 if (!$ttyfh) {
 321                         # Needs to be opened, as get_new_pty on linux cannot do
 322                         # this so soon
 323                         $ttyfh = "TTY";
 324                         if ($_[1]) {
 325                                 chown($_[1], $_[2], $tty);
 326                                 }
 327                         open($ttyfh, "+<$tty") || &error("Failed to open $tty : $!");
 328                         }
 329
 330                 # Turn off echoing, if we can
 331                 eval "use IO::Stty";
 332                 if (!$@) {
 333                         IO::Stty::stty($ttyfh, 'raw', '-echo');
 334                         }
 335
 336                 if (defined(&open_controlling_pty)) {
 337                         &open_controlling_pty($ptyfh, $ttyfh, $pty, $tty);
 338                         }
 339
 340                 close(STDIN); close(STDOUT); close(STDERR);
 341                 untie(*STDIN); untie(*STDOUT); untie(*STDERR);
 342                 #setpgrp(0, $$);
 343                 if ($_[1]) {
 344                         &switch_to_unix_user([ undef, undef, $_[1], $_[2] ]);
 345                         }
 346
 347                 open(STDIN, "<$tty");
 348                 open(STDOUT, ">&$ttyfh");
 349                 open(STDERR, ">&STDOUT");
 350                 close($ptyfh);
 351                 exec($cmd);
 352                 print "Exec failed : $!\n";
 353                 exit 1;
 354                 }
 355         close($ttyfh);
 356         return ($ptyfh, $pid);
 357         }
 358 }
 359
 360 # pty_process_exec_logged(..)
 361 # Like pty_process_exec, but logs the command as well
 362 sub pty_process_exec_logged
 363 {
 364 &additional_log('exec', undef, $_[0]);
 365 return &pty_process_exec(@_);
 366 }
 367
 368 # find_process(name)
 369 # Returns an array of all processes matching some name
 370 sub find_process
 371 {
 372 local $name = $_[0];
 373 local @rv = grep { $_->{'args'} =~ /$name/ } &list_processes();
 374 return wantarray ? @rv : $rv[0];
 375 }
 376
 377 $has_lsof_command = &has_command("lsof");
 378
 379 # find_socket_processes(protocol, port)
 380 # Returns all processes using some port and protocol
 381 sub find_socket_processes
 382 {
 383 local @rv;
 384 open(LSOF, "lsof -i '$_[0]:$_[1]' |");
 385 while(<LSOF>) {
 386         if (/^(\S+)\s+(\d+)/) {
 387                 push(@rv, $2);
 388                 }
 389         }
 390 close(LSOF);
 391 return @rv;
 392 }
 393
 394 # find_ip_processes(ip)
 395 # Returns all processes using some IP address
 396 sub find_ip_processes
 397 {
 398 local @rv;
 399 open(LSOF, "lsof -i '\@$_[0]' |");
 400 while(<LSOF>) {
 401         if (/^(\S+)\s+(\d+)/) {
 402                 push(@rv, $2);
 403                 }
 404         }
 405 close(LSOF);
 406 return @rv;
 407 }
 408
 409 # find_process_sockets(pid)
 410 # Returns all network connections made by some process
 411 sub find_process_sockets
 412 {
 413 local @rv;
 414 open(LSOF, "lsof -i tcp -i udp -n |");
 415 while(<LSOF>) {
 416         if (/^(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+).*(TCP|UDP)\s+(.*)/
 417             && $2 eq $_[0]) {
 418                 local $n = { 'fd' => $4,
 419                              'type' => $5,
 420                              'proto' => $7 };
 421                 local $m = $8;
 422                 if ($m =~ /^([^:\s]+):([^:\s]+)\s+\(listen\)/i) {
 423                         $n->{'lhost'} = $1;
 424                         $n->{'lport'} = $2;
 425                         $n->{'listen'} = 1;
 426                         }
 427                 elsif ($m =~ /^([^:\s]+):([^:\s]+)->([^:\s]+):([^:\s]+)\s+\((\S+)\)/) {
 428                         $n->{'lhost'} = $1;
 429                         $n->{'lport'} = $2;
 430                         $n->{'rhost'} = $3;
 431                         $n->{'rport'} = $4;
 432                         $n->{'state'} = $5;
 433                         }
 434                 elsif ($m =~ /^([^:\s]+):([^:\s]+)/) {
 435                         $n->{'lhost'} = $1;
 436                         $n->{'lport'} = $2;
 437                         }
 438                 push(@rv, $n);
 439                 }
 440         }
 441 close(LSOF);
 442 return @rv;
 443 }
 444
 445 # find_process_files(pid)
 446 # Returns all files currently held open by some process
 447 sub find_process_files
 448 {
 449 local @rv;
 450 open(LSOF, "lsof -p '$_[0]' |");
 451 while(<LSOF>) {
 452         if (/^(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+),(\d+)\s+(\d+)\s+(\d+)\s+(.*)/) {
 453                 push(@rv, { 'fd' => lc($4),
 454                             'type' => lc($5),
 455                             'device' => [ $6, $7 ],
 456                             'size' => $8,
 457                             'inode' => $9,
 458                             'file' => $10 });
 459                 }
 460         elsif (/^(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\d+),(\d+)\s+(\d+)\s+(.*)/) {
 461                 push(@rv, { 'fd' => lc($4),
 462                             'type' => lc($5),
 463                             'device' => [ $6, $7 ],
 464                             'inode' => $8,
 465                             'file' => $9 });
 466                 }
 467         }
 468 close(LSOF);
 469 return @rv;
 470 }
 471
 472 # pty_backquote(cmd, uid, gid)
 473 # Like the normal Perl backquote operator, but executes the command in a PTY
 474 sub pty_backquote
 475 {
 476 local $rv;
 477 local ($fh, $pid) = &pty_process_exec(@_);
 478 while(<$fh>) {
 479         $rv .= $_;
 480         }
 481 close($fh);
 482 waitpid($pid, WNOHANG);
 483 return $rv;
 484 }
 485
 486 # pty_backquote_logged(cmd, uid, gid)
 487 # Like pty_backquote, but logs the command as well
 488 sub pty_backquote_logged
 489 {
 490 &additional_log('exec', undef, $_[0]);
 491 return &pty_backquote(@_);
 492 }
 493
 494 # get_cpu_info()
 495 # Returns a list containing the 5, 10 and 15 minute load averages, and possibly
 496 # the CPU mhz, model, vendor, cache and count
 497 sub get_cpu_info
 498 {
 499 if (defined(&os_get_cpu_info)) {
 500         return &os_get_cpu_info();
 501         }
 502 &clean_language();
 503 local $out = &backquote_command("uptime 2>&1");
 504 &reset_environment();
 505 return $out =~ /average(s)?:\s+([0-9\.]+),?\s+([0-9\.]+),?\s+([0-9\.]+)/i ?
 506                 ( $2, $3, $4 ) : ( );
 507 }
 508
 509 # find_subprocesses(&proc, [&plist])
 510 # Returns a list of all processes under the one given
 511 sub find_subprocesses
 512 {
 513 local $proc = $_[0];
 514 local @plist = $_[1] ? @{$_[1]} : &list_processes();
 515 local @sp = grep { $_->{'ppid'} &&
 516                    $_->{'ppid'} == $proc->{'pid'} } @plist;
 517 local (@rv, $sp);
 518 foreach $sp (@sp) {
 519         push(@rv, $sp, &find_subprocesses($sp, \@plist));
 520         }
 521 return @rv;
 522 }
 523
 524 # supported_signals()
 525 # Returns signal names known to Perl for the kill function
 526 sub supported_signals
 527 {
 528 if (defined(&os_supported_signals)) {
 529         return &os_supported_signals();
 530         }
 531 else {
 532         return split(/\s+/, $Config{'sig_name'});
 533         }
 534 }
 535
 536 # can_view_process(user)
 537 # Returns 1 if processes belong to this user can be seen
 538 sub can_view_process
 539 {
 540 local ($user) = @_;
 541 if ($hide{$user}) {
 542         return 0;
 543         }
 544 elsif ($user_processes_only) {
 545         return &can_edit_process($user);
 546         }
 547 else {
 548         return 1;
 549         }
 550 }
 551
 552 # can_edit_process(user)
 553 # Returns 1 if processes belong to this user can be edited. The 'manage as'
 554 # user will still apply though.
 555 sub can_edit_process
 556 {
 557 local ($user) = @_;
 558 if (!$access{'edit'}) {
 559         return 0;
 560         }
 561 elsif ($hide{$user}) {
 562         return 0;
 563         }
 564 elsif ($access{'users'} eq '*') {
 565         return 1;
 566         }
 567 elsif ($access{'users'} eq 'x') {
 568         return $user eq $remote_user;
 569         }
 570 else {
 571         local @uinfo = getpwnam($user);
 572         foreach my $u (split(/\s+/, $access{'users'})) {
 573                 if ($u =~ /^\@(.*)$/) {
 574                         # Is he in this group?
 575                         local @ginfo = getgrnam($1);
 576                         return 1 if ($uinfo[3] == $ginfo[2]);
 577                         return 1 if (&indexof($ginfo[0],
 578                                               &other_groups($user)) >= 0);
 579                         }
 580                 elsif ($u =~ /^(\d+)\-(\d+)$/) {
 581                         # Check UID
 582                         return 1 if ($uinfo[2] >= $1 && $uinfo[2] <= $2);
 583                         }
 584                 else {
 585                         return 1 if ($u eq $user);
 586                         }
 587                 }
 588         return 0;
 589         }
 590 }
 591
 592 # nice_selector(name, value)
 593 # Returns a menu for selecting a nice level
 594 sub nice_selector
 595 {
 596 local ($name, $value) = @_;
 597 local $l = scalar(@nice_range);
 598 return &ui_select($name, $value,
 599         [ map { [ $_, $_.($_ == $nice_range[0] ? " ($text{'edit_prihigh'})" :
 600                           $_ == 0 ? " ($text{'edit_pridef'})" :
 601                           $_ == $nice_range[$l-1] ? " ($text{'edit_prilow'})" :
 602                                                     "") ] } @nice_range ]);
 603 }
 604
 605 # get_kernel_info()
 606 # Returns the system's kernel version, architecture and OS
 607 sub get_kernel_info
 608 {
 609 if (defined(&os_get_kernel_info)) {
 610         return &os_get_kernel_info();
 611         }
 612 else {
 613         my $uname = &has_command("uptrack-uname") || &has_command("uname");
 614         my $out = &backquote_command("$uname -r 2>/dev/null ; ".
 615                                      "$uname -m 2>/dev/null ; ".
 616                                      "$uname -s 2>/dev/null");
 617         return split(/\r?\n/, $out);
 618         }
 619 }
 620
 621 # get_system_uptime()
 622 # Returns uptime in days, minutes and hours
 623 sub get_system_uptime
 624 {
 625 my $out = &backquote_command("LC_ALL='' LANG='' uptime");
 626 if ($out =~ /up\s+(\d+)\s+(day|days),?\s+(\d+):(\d+)/) {
 627         # up 198 days,  2:06
 628         return ( $1, $3, $4 );
 629         }
 630 elsif ($out =~ /up\s+(\d+)\s+(day|days),?\s+(\d+)\s+min/) {
 631         # up 198 days,  10 mins
 632         return ( $1, 0, $3 );
 633         }
 634 elsif ($out =~ /up\s+(\d+):(\d+)/) {
 635         # up 3:10
 636         return ( 0, $1, $2 );
 637         }
 638 elsif ($out =~ /up\s+(\d+)\s+min/) {
 639         # up 45 mins
 640         return ( 0, 0, $1 );
 641         }
 642 else {
 643         return ( );
 644         }
 645 }
 646
 647 1;
 648