diff options
| author | Paul Buetow <paul@buetow.org> | 2026-02-13 21:19:42 +0200 |
|---|---|---|
| committer | Paul Buetow <paul@buetow.org> | 2026-02-13 21:19:42 +0200 |
| commit | bf7c6ade292a6444877797c8d699d147aceb57cc (patch) | |
| tree | 4f7b7498c973126aefe32dd60b8ccbd0ccc9ef68 | |
| parent | 79627ce3c419a6a6d6e03c83e7c62333b60345d8 (diff) | |
Revert "Replace Perl threads with fork() for multi-host monitoring"
This reverts commit 79627ce3c419a6a6d6e03c83e7c62333b60345d8.
| -rw-r--r-- | lib/Loadbars/Main.pm | 190 | ||||
| -rw-r--r-- | lib/Loadbars/Shared.pm | 22 |
2 files changed, 53 insertions, 159 deletions
diff --git a/lib/Loadbars/Main.pm b/lib/Loadbars/Main.pm index 50d9804..4b750dc 100644 --- a/lib/Loadbars/Main.pm +++ b/lib/Loadbars/Main.pm @@ -17,8 +17,8 @@ use Time::HiRes qw(gettimeofday); use Proc::ProcessTable; -use IO::Select; -use POSIX ":sys_wait_h"; +use threads; +use threads::shared; use Loadbars::Config; use Loadbars::Constants; @@ -76,41 +76,35 @@ sub cpu_parse_line ($) { } sub threads_terminate_pids (@) { - my @processes = @_; + my @threads = @_; display_info 'Terminating sub-processes, hasta la vista!'; + $_->kill('TERM') for @threads; display_info_no_nl 'Terminating PIDs'; + for my $pid ( keys %PIDS ) { + my $proc_table = Proc::ProcessTable->new(); + for my $proc ( @{ $proc_table->table() } ) { + if ( $proc->ppid == $pid ) { + print $proc->pid . ' '; + kill 'TERM', $proc->pid if $proc->ppid == $pid; + } + } - # Terminate all child processes - for my $proc (@processes) { - my $pid = $proc->{pid}; - print "$pid "; + print $pid . ' '; kill 'TERM', $pid; - # Close the reader pipe - close $proc->{reader} if $proc->{reader}; - } - - # Wait for all child processes to exit - for my $proc (@processes) { - waitpid($proc->{pid}, 0); + #$_->join() for @threads; } say ''; + display_info 'Terminating done. I\'ll be back!'; } -sub threads_stats ($;$$) { - my ( $host, $user, $pipe ) = @_; +sub threads_stats ($;$) { + my ( $host, $user ) = @_; $user = defined $user ? "-l $user" : ''; - # Helper function to write data to pipe with protocol - my $write_data = sub { - my ($type, $key, $value) = @_; - return unless defined $pipe; - print $pipe "$type:$key=$value\n"; - }; - my ( $sigusr1, $sigterm ) = ( 0, 0 ); my $interval = Loadbars::Constants->INTERVAL; @@ -191,21 +185,21 @@ REMOTECODE ? "bash -c \"$remotecode\"" : "ssh $user -o StrictHostKeyChecking=no $C{sshopts} $host \"$remotecode\""; - my $ssh_pid = open my $ssh_pipe, "$cmd |" or do { + my $pid = open my $pipe, "$cmd |" or do { say "Warning: $!"; sleep 1; next; }; - $PIDS{$ssh_pid} = 1; + $PIDS{$pid} = 1; - # Signal handling for child process + # Toggle CPUs $SIG{USR1} = sub { $sigusr1 = 1 }; - $SIG{TERM} = sub { exit 0; }; + $SIG{TERM} = sub { threads->exit(); }; my $mode = 0; - while (<$ssh_pipe>) { + while (<$pipe>) { chomp; if ( $_ =~ $modeswitch_re ) { @@ -225,32 +219,32 @@ REMOTECODE } if ( $mode == 0 ) { - $write_data->('AVG', $host, $_); - $write_data->('AVGHAS', $host, 1); + $AVGSTATS{$host} = $_; + $AVGSTATS_HAS{$host} = 1; } elsif ( $mode == 1 ) { if ( 0 == index $_, $cpustring ) { my ( $name, $load ) = cpu_parse_line $_; - my $value = join ';', + $CPUSTATS{"$host;$name"} = join ';', map { $_ . '=' . $load->{$_} } grep { defined $load->{$_} } keys %$load; - $write_data->('CPU', "$host;$name", $value); } } elsif ( $mode == 2 ) { for my $meminfo (@meminfo) { if ( $_ =~ $meminfo->[1] ) { - $write_data->('MEM', "$host;$meminfo->[0]", $1); - $write_data->('MEMHAS', $host, 1); + $MEMSTATS{"$host;$meminfo->[0]"} = $1; + $MEMSTATS_HAS{$host} = 1 + unless defined $MEMSTATS_HAS{$host}; } } } elsif ( $mode == 3 ) { my ( $int, @stats ) = split ':', $_; - $write_data->('NET', "$host;$int", "@stats"); - $write_data->('NETTIME', "$host;$int;stamp", Time::HiRes::time()); - $write_data->('NETINT', $int, 1); - $write_data->('NETHAS', $host, 1); + $NETSTATS{"$host;$int"} = "@stats"; + $NETSTATS{"$host;$int;stamp"} = Time::HiRes::time(); + $NETSTATS_INT{$int} = 1 unless defined $NETSTATS_INT{$int}; + $NETSTATS_HAS{$host} = 1 unless defined $NETSTATS_HAS{$host}; } if ($sigusr1) { @@ -260,7 +254,7 @@ REMOTECODE } } - delete $PIDS{$ssh_pid}; + delete $PIDS{$pid}; return undef; } @@ -393,98 +387,8 @@ sub sdl_draw_background ($$) { } sub threads_create (@) { - my @processes; - - for my $host_spec (@_) { - my ($host, $user) = split ':', $host_spec; - - # Create a pipe for child->parent communication - pipe(my $reader, my $writer) or die "Cannot create pipe: $!"; - - my $pid = fork(); - die "Cannot fork: $!" unless defined $pid; - - if ($pid == 0) { - # Child process - close $reader; - - # Make writer unbuffered - my $old_fh = select($writer); - $| = 1; - select($old_fh); - - # Run stats collection and write to pipe - threads_stats($host, $user, $writer); - - close $writer; - exit 0; - } - - # Parent process - close $writer; - - # Store process info: {pid, reader, host} - push @processes, { - pid => $pid, - reader => $reader, - host => $host, - }; - - $PIDS{$pid} = 1; - } - - return @processes; -} - -sub read_from_processes (@) { - my @processes = @_; - return unless @processes; - - # Create IO::Select object for non-blocking reads - my @readers = map { $_->{reader} } @processes; - my $select = IO::Select->new(@readers); - - # Read from all ready pipes with timeout of 0.001 seconds - my @ready = $select->can_read(0.001); - - for my $fh (@ready) { - while (my $line = <$fh>) { - chomp $line; - - # Parse protocol: TYPE:KEY=VALUE - if ($line =~ /^([A-Z]+):(.+)=(.*)$/) { - my ($type, $key, $value) = ($1, $2, $3); - - if ($type eq 'AVG') { - $AVGSTATS{$key} = $value; - } - elsif ($type eq 'AVGHAS') { - $AVGSTATS_HAS{$key} = $value; - } - elsif ($type eq 'CPU') { - $CPUSTATS{$key} = $value; - } - elsif ($type eq 'MEM') { - $MEMSTATS{$key} = $value; - } - elsif ($type eq 'MEMHAS') { - $MEMSTATS_HAS{$key} = $value; - } - elsif ($type eq 'NET') { - $NETSTATS{$key} = $value; - } - elsif ($type eq 'NETTIME') { - $NETSTATS{$key} = $value; - } - elsif ($type eq 'NETINT') { - $NETSTATS_INT{$key} = $value; - } - elsif ($type eq 'NETHAS') { - $NETSTATS_HAS{$key} = $value; - } - } - } - } + return map { $_->detach(); $_ } + map { threads->create( 'threads_stats', split ':' ) } @_; } sub set_dimensions ($$) { @@ -518,14 +422,6 @@ sub loop ($@) { my $num_stats = 1; $C{width} = $C{barwidth}; - # Give threads a moment to fully initialize before starting SDL - # This helps avoid race conditions during SDL initialization - sleep 1; - - # Initialize SDL video subsystem in main thread only - # This must happen after threads are created to avoid threading issues - SDL::init(SDL::SDL_INIT_VIDEO); - my $title = do { if ( defined $C{title} ) { $C{title}; @@ -536,7 +432,8 @@ sub loop ($@) { }; my $app = SDLx::App->new( - title => "Loadbars", # Simple static title to avoid TTF rendering issues + title => $title, + icon_title => Loadbars::Constants->VERSION, width => $C{width}, height => $C{height}, depth => Loadbars::Constants->COLOR_DEPTH, @@ -558,10 +455,10 @@ sub loop ($@) { my $sdl_redraw_background = 0; my $sdl_font_height = 14; - my $infotxt = ''; - my $quit = 0; - my $resize_window = 0; - my %newsize; + my $infotxt : shared = ''; + my $quit : shared = 0; + my $resize_window : shared = 0; + my %newsize : shared; my $event = SDL::Event->new(); my ( $t1, $t2 ) = ( Time::HiRes::time(), undef ); @@ -588,7 +485,7 @@ sub loop ($@) { # 1 pressed $C{showcores} = !$C{showcores}; cpu_set_showcores_re; - kill 'USR1', $_->{pid} for @threads; + $_->kill('USR1') for @threads; $sdl_redraw_background = 1; display_info "Toggled CPUs $C{showcores}"; @@ -744,9 +641,6 @@ sub loop ($@) { }; do { - # Read data from child processes - read_from_processes(@threads); - my ( $x, $y ) = ( 0, 0 ); # Also substract 1 (each bar is followed by an 1px separator bar) diff --git a/lib/Loadbars/Shared.pm b/lib/Loadbars/Shared.pm index 4240c71..1cf6e80 100644 --- a/lib/Loadbars/Shared.pm +++ b/lib/Loadbars/Shared.pm @@ -19,24 +19,24 @@ our @EXPORT = qw( %I ); -our %PIDS; +our %PIDS : shared; -our %CPUSTATS; -our %AVGSTATS; -our %AVGSTATS_HAS; +our %CPUSTATS : shared; +our %AVGSTATS : shared; +our %AVGSTATS_HAS : shared; -our %MEMSTATS; -our %MEMSTATS_HAS; +our %MEMSTATS : shared; +our %MEMSTATS_HAS : shared; -our %NETSTATS; -our %NETSTATS_HAS; -our %NETSTATS_INT; +our %NETSTATS : shared; +our %NETSTATS_HAS : shared; +our %NETSTATS_INT : shared; # Global configuration hash -our %C; +our %C : shared; # Global configuration hash for internal settings (not configurable) -our %I; +our %I : shared; # Setting defaults %C = ( |
