From 4439dadb1e3b4a1feda0df825fc5052cb78f78ec Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 12:20:11 +0100
Subject: [PATCH 01/26] clusterd: Reap children
Currently we leave zombies after udp_rx_push2() and possibly in other
places.
Reap children in the main loop.
---
clusterd/clusterd | 1 +
1 file changed, 1 insertion(+)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index afcb828..2ce4626 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -283,6 +283,7 @@ sub run {
for (@WRITER) { vec($wvec,$_->[0]->fileno,1)=1 } ;
for (@EXCEPT) { vec($evec,$_->[0]->fileno,1)=1 } ;
+ wait;
my $ready=select($rvec,$wvec,$evec,1);
if ($ready>0) {
for (my $i=0;$i<@READER;$i++) {
From afb494681e2056d0a869af2c561c8260d91eb430 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 12:29:37 +0100
Subject: [PATCH 02/26] clusterd: close STDIN in daemon
When in daemon mode, close stdin right away. This avoids the need to
close stdin in various places after a fork.
---
clusterd/clusterd | 5 +----
1 file changed, 1 insertion(+), 4 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 2ce4626..021e292 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -884,7 +884,6 @@ sub udp_rx_exec {
defined $pid or exit 1;
$pid and exit;
- open STDIN,'<','/dev/null';
open STDOUT,'>','/dev/null';
open STDERR,'>','/dev/null';
alarm(60);
@@ -903,7 +902,6 @@ sub udp_rx_exec2 {
return;
}
if ($pid == 0) {
- open STDIN,'<','/dev/null';
alarm(60);
chdir '/';
for my $cmd (@cmd) {
@@ -1412,7 +1410,6 @@ sub run_cmd {
warn "exec ".join(' ',@cmd)."\n";
$opipe->writer();
$epipe->writer();
- open STDIN,'<','/dev/null';
open STDOUT,'>&',$opipe;
open STDERR,'>&',$epipe;
exec @cmd;
@@ -2021,7 +2018,6 @@ FILE:
}
}
}
- open STDIN, '<', '/dev/null';
chdir '/';
alarm(60);
for my $cmd (@$post_ary) {
@@ -2167,6 +2163,7 @@ if (defined $options{'push'}) {
udp_broadcast_message($donald_s,'reexport');
} elsif (defined $options{'daemon'}) {
$SIG{PIPE}='IGNORE';
+ open STDIN,'<','/dev/null';
$donald_s=new My::Select::INET(Proto=>'udp',Broadcast=>1,LocalPort=>$UDP_PORT) or die "$!\n";
$donald_s->receive_data(\&udp_message,$donald_s);
From 3e1cff57b2dc5a4f8cd0245346751685e7ba7f97 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 12:34:57 +0100
Subject: [PATCH 03/26] clusters: Do not return ignored values from clp_rx_
functions
---
clusterd/clusterd | 2 --
1 file changed, 2 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 021e292..7d33865 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -1391,7 +1391,6 @@ sub clp_rx_LSOF {
}
close $socket;
wait;
- return 1;
}
sub run_cmd {
@@ -1538,7 +1537,6 @@ sub clp_rx_CMD {
my ($socket,@args)=@_;
run_cmd($socket,@args);
close $socket;
- return 1;
}
# send_tcp_cp($socket,$cb,$timeout,@args)
From 1264eb272f8f2d03d80c4aefc69cff34b035a2af Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 12:51:35 +0100
Subject: [PATCH 04/26] clusterd: Wait for specific pids
Now that we accept random children to exist and exit at any time, use
waitpid() instead of wait() when we wait for a specific child somewhere
else in the code.
This change revealed an error in udp_rx_exec2() which might have
executed /sbin/make-automaps redundantly. Fix that. This is not tested
or analyzed very much, but udp_rx_exec2() is obsolete and should go away
soon anyway.
---
clusterd/clusterd | 19 +++++++++----------
1 file changed, 9 insertions(+), 10 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 7d33865..5d82389 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -783,7 +783,7 @@ sub push_amd_tar {
exec 'tar','cf',$filename,'.';
die "$!\n";
}
- wait;
+ waitpid $pid, 0;
$? and return;
my $fh=new IO::File $filename,'<' or return warn "$filename: $!\n";
@@ -796,7 +796,7 @@ sub push_amd_tar {
exec 'gzip','-f',$filename;
die "$!\n";
}
- wait;
+ waitpid $pid, 0;
$? and return;
$filename='/tmp/amd.tar.gz';
@@ -891,7 +891,6 @@ sub udp_rx_exec {
exec '/bin/sh','-c',$CMD{$cmd};
exit 1;
}
- wait;
}
sub udp_rx_exec2 {
@@ -973,13 +972,13 @@ sub udp_rx_amdtardata {
exec 'tar','xzf',$st_want->name;
die "$!\n";
}
- }
- wait;
- $? and return;
+ waitpid $pid, 0;
+ $? and return;
- warn "installed /etc/amd - ",Digest::MD5::md5_hex($digest),"\n";
- $INSTALLED_DIGEST=$digest;
- system '/sbin/make-automaps';
+ warn "installed /etc/amd - ",Digest::MD5::md5_hex($digest),"\n";
+ $INSTALLED_DIGEST=$digest;
+ system '/sbin/make-automaps';
+ }
}
our ($machine,$SYS_lchown,$SYS_mknod);
@@ -1390,7 +1389,7 @@ sub clp_rx_LSOF {
exit;
}
close $socket;
- wait;
+ waitpid $pid, 0;
}
sub run_cmd {
From 9a2eaf985ebc8566bb15ff9a3e50c908c8a69fe1 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 12:59:43 +0100
Subject: [PATCH 05/26] clusterd: Remove double-forks
In two places we used double forks, probably so that we don't need to
reap. Now children are reaped in the main loop, so remove the extra
forks.
---
clusterd/clusterd | 38 ++++++++++++++------------------------
1 file changed, 14 insertions(+), 24 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 5d82389..8e53815 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -880,10 +880,6 @@ sub udp_rx_exec {
return;
}
unless ($pid) {
- $pid=fork;
- defined $pid or exit 1;
- $pid and exit;
-
open STDOUT,'>','/dev/null';
open STDERR,'>','/dev/null';
alarm(60);
@@ -1366,30 +1362,24 @@ sub clp_rx_LSOF {
return;
}
unless ($pid) {
- my $pid=fork;
- defined $pid or die "$!\n";
- unless ($pid) {
- $socket->blocking(1);
- # -n inhibits the conversion of network numbers to host names for network files.
- # -b causes lsof to avoid kernel functions that might block - lstat(2), readlink(2), and stat(2).
- # -w disables warning messages.
- open P,'timeout -k 92s 90s lsof -n -b -w|' or die "$!\n";
- while (<P>) {
- next if defined $pattern && index($_,$pattern)<0;
- $socket->send(pack('n',length($_)).$_,0);
- }
- close P;
- if ($?) {
- $_=sprintf("** lsof timout/error on %s\n",$my_hostname);
- $socket->send(pack('n',length($_)).$_,0);
- }
- close $socket;
- exit;
+ $socket->blocking(1);
+ # -n inhibits the conversion of network numbers to host names for network files.
+ # -b causes lsof to avoid kernel functions that might block - lstat(2), readlink(2), and stat(2).
+ # -w disables warning messages.
+ open P,'timeout -k 92s 90s lsof -n -b -w|' or die "$!\n";
+ while (<P>) {
+ next if defined $pattern && index($_,$pattern)<0;
+ $socket->send(pack('n',length($_)).$_,0);
+ }
+ close P;
+ if ($?) {
+ $_=sprintf("** lsof timout/error on %s\n",$my_hostname);
+ $socket->send(pack('n',length($_)).$_,0);
}
+ close $socket;
exit;
}
close $socket;
- waitpid $pid, 0;
}
sub run_cmd {
From 756e25226e3204d3e213c66d35a66072a7069151 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 13:35:44 +0100
Subject: [PATCH 06/26] clusterd: Add syntax "clusterd exec @host cmd.."
---
clusterd/clusterd | 9 ++++++++-
1 file changed, 8 insertions(+), 1 deletion(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 8e53815..6952b24 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -2096,6 +2096,7 @@ usage: $0 [options]
push [--post CMD] files... # push files over tcp
exec CMD... # execute CMD on all nodes
CMD : mkmotd | flush-gidcache | reexport | make-automaps
+ exec @host cmd... # execute (any) command on host
__EOF__
@@ -2185,7 +2186,13 @@ if (defined $options{'push'}) {
cmd_push($options{'post'} || [], @args);
} elsif ($cmd eq 'exec') {
@args > 0 or die USAGE;
- cmd_exec(@args);
+ if (substr($args[0], 0, 1) eq '@') {
+ my $host = substr(shift @args, 1);
+ @args > 0 or die USAGE;
+ exec_at($host ,@args);
+ } else {
+ cmd_exec(@args);
+ }
} else {
die USAGE;
}
From 8cc7e8b3a598e8a663443abdaa2ea525adf291f7 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 13:46:51 +0100
Subject: [PATCH 07/26] clusterd: Remove obsolete commands
---
clusterd/clusterd | 37 ++++++-------------------------------
1 file changed, 6 insertions(+), 31 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 6952b24..d7d3193 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -2080,14 +2080,7 @@ use constant USAGE => <<'__EOF__';
usage: $0 [options]
- --push file # broadcast this file
- --push-amd-tar # broadcast /etc/amd
--send-restart # broadcast a restart request to all nodes
- --exec mkmotd # execute /usr/sbin/mkmotd.pl on all nodes
- --exec @node cmd [args...] # execute cmd on node
- --flush-gidcache # flush rpc auth.unix.gid cache on all nodes
- --make-automaps # execute /usr/sbin/make-automaps on all nodes
- --reexport # execute /usr/bin/mxmount --reexport-only on all nodes
--lsof=pattern
@@ -2116,39 +2109,21 @@ GetOptions (
) or die USAGE;
if (defined $options{'push'}) {
- sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
- $donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
- push_file($donald_s,$options{'push'});
+ die ("`clusterd --push` is obsolete. Please use `clusterd push`\n");
} elsif (defined $options{'exec'}) {
- if (substr($options{'exec'},0,1) eq '@') {
- length(length($options{'exec'})>1) or die USAGE;
- @ARGV>=1 or die USAGE;
- exec_at(substr($options{'exec'},1),@ARGV);
- } else {
- sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
- $donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
- send_exec($donald_s,$options{'exec'});
- }
+ die ("`clusterd --exec` is obsolete. Please use `clusterd push --post` or `clusterd exec`\n");
} elsif (defined $options{'push_amd_tar'}) {
- sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
- $donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
- push_amd_tar($donald_s);
+ die ("`clusterd --push-amd-tar` is obsolete. Please use `clusterd push`\n");
} elsif (defined $options{'send-restart'}) {
sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
$donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
udp_broadcast_message($donald_s,'restart');
} elsif (defined $options{'flush-gidcache'}) {
- sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
- $donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
- udp_broadcast_message($donald_s,'flush-gidcache');
+ die ("`clusterd --flush-gidcache` is obsolete. Please use `clusterd push --post flush-gidcache` or `clusterd exec flush-gidcache`\n");
} elsif (defined $options{'make-automaps'}) {
- sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
- $donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
- udp_broadcast_message($donald_s,'make-automaps');
+ die ("`clusterd --make-automaps` is obsolete. Please use `clusterd push --post make-automaps` or `clusterd exec make-automaps`\n");
} elsif (defined $options{'reexport'}) {
- sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
- $donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
- udp_broadcast_message($donald_s,'reexport');
+ die ("`clusterd --reexport` is obsolete. Please use `clusterd push --post reexport` or `clusterd exec reexport`\n");
} elsif (defined $options{'daemon'}) {
$SIG{PIPE}='IGNORE';
open STDIN,'<','/dev/null';
From 66ad71d999760d93fcd866e8a2220cf63edd4d91 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 13:53:11 +0100
Subject: [PATCH 08/26] clusterd: Change "lsof" from option to command.
---
clusterd/clusterd | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index d7d3193..d3d5440 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -2082,14 +2082,13 @@ usage: $0 [options]
--send-restart # broadcast a restart request to all nodes
- --lsof=pattern
-
--daemon # start a daemon
push [--post CMD] files... # push files over tcp
exec CMD... # execute CMD on all nodes
CMD : mkmotd | flush-gidcache | reexport | make-automaps
exec @host cmd... # execute (any) command on host
+ lsof pattern # list open file matching pattern on all nodes
__EOF__
@@ -2152,7 +2151,7 @@ if (defined $options{'push'}) {
My::Select::run();
} elsif ($options{'lsof'}) {
- lsof($options{'lsof'});
+ die ("`clusterd --lsof` is obsolete. Please use `clusterd lsof`\n");
} else {
@ARGV or die USAGE;
my ($cmd,@args)=@ARGV;
@@ -2168,6 +2167,9 @@ if (defined $options{'push'}) {
} else {
cmd_exec(@args);
}
+ } elsif ($cmd eq 'lsof') {
+ @args == 1 or die USAGE;
+ lsof(@args);
} else {
die USAGE;
}
From 64737734b7e9667781f3b5259d700746e12ba6b2 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 13:56:13 +0100
Subject: [PATCH 09/26] clusterd: Change "send-restart" from option to command
---
clusterd/clusterd | 12 +++++++-----
1 file changed, 7 insertions(+), 5 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index d3d5440..a23605a 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -2080,8 +2080,6 @@ use constant USAGE => <<'__EOF__';
usage: $0 [options]
- --send-restart # broadcast a restart request to all nodes
-
--daemon # start a daemon
push [--post CMD] files... # push files over tcp
@@ -2089,6 +2087,7 @@ usage: $0 [options]
CMD : mkmotd | flush-gidcache | reexport | make-automaps
exec @host cmd... # execute (any) command on host
lsof pattern # list open file matching pattern on all nodes
+ send-restart # send restart request to all nodes
__EOF__
@@ -2114,9 +2113,7 @@ if (defined $options{'push'}) {
} elsif (defined $options{'push_amd_tar'}) {
die ("`clusterd --push-amd-tar` is obsolete. Please use `clusterd push`\n");
} elsif (defined $options{'send-restart'}) {
- sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
- $donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
- udp_broadcast_message($donald_s,'restart');
+ die ("`clusterd --send-restart` is obsolete. Please use `clusterd send-restart`\n");
} elsif (defined $options{'flush-gidcache'}) {
die ("`clusterd --flush-gidcache` is obsolete. Please use `clusterd push --post flush-gidcache` or `clusterd exec flush-gidcache`\n");
} elsif (defined $options{'make-automaps'}) {
@@ -2170,6 +2167,11 @@ if (defined $options{'push'}) {
} elsif ($cmd eq 'lsof') {
@args == 1 or die USAGE;
lsof(@args);
+ } elsif ($cmd eq 'send-restart') {
+ @args == 0 or die USAGE;
+ sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
+ $donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
+ udp_broadcast_message($donald_s,'restart');
} else {
die USAGE;
}
From 90c27dd6ef0da5dad802817e29861dfa7ad5a9a9 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 13:58:07 +0100
Subject: [PATCH 10/26] clusterd: Factor out daemon start code
---
clusterd/clusterd | 56 +++++++++++++++++++++++++----------------------
1 file changed, 30 insertions(+), 26 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index a23605a..e9744dd 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -2049,6 +2049,35 @@ sub cmd_exec {
udp_broadcast_message($donald_s, 'exec.2', @cmd);
}
+sub cmd_daemon() {
+ $SIG{PIPE}='IGNORE';
+ open STDIN,'<','/dev/null';
+
+ $donald_s=new My::Select::INET(Proto=>'udp',Broadcast=>1,LocalPort=>$UDP_PORT) or die "$!\n";
+ $donald_s->receive_data(\&udp_message,$donald_s);
+
+ openlog('clusterd','pid','daemon');
+ Sys::Syslog::setlogsock('unix'); # with 'native' we get EOLs in the logfile, option "noeol" doesn't work
+
+ check_progfile_status();
+ warn "server started - ".version_info()."\n";
+ init_area();
+ mgmt_init();
+ clp_init();
+ trustcheck_init();
+
+ sync_cluster_pw() or warn "$CLUSTER_PW_FILE: $!\n";
+
+ My::Select::timeout(60,\&purge_old_receiver);
+ My::Select::timeout(rand(60),\&send_stat);
+ My::Select::timeout(0,\&sample_rproc);
+ $my_hostname eq $STAT_TARGET and My::Cluster::Updown::init();
+ $my_hostname eq 'macheteinfach' and My::NetlogReceiver::init();
+ My::Select::timeout(600,\&check_overload);
+
+ My::Select::run();
+}
+
#------------------------------------------------------------
our $TRUSTCHECK_PORT=236;
@@ -2121,32 +2150,7 @@ if (defined $options{'push'}) {
} elsif (defined $options{'reexport'}) {
die ("`clusterd --reexport` is obsolete. Please use `clusterd push --post reexport` or `clusterd exec reexport`\n");
} elsif (defined $options{'daemon'}) {
- $SIG{PIPE}='IGNORE';
- open STDIN,'<','/dev/null';
-
- $donald_s=new My::Select::INET(Proto=>'udp',Broadcast=>1,LocalPort=>$UDP_PORT) or die "$!\n";
- $donald_s->receive_data(\&udp_message,$donald_s);
-
- openlog('clusterd','pid','daemon');
- Sys::Syslog::setlogsock('unix'); # with 'native' we get EOLs in the logfile, option "noeol" doesn't work
-
- check_progfile_status();
- warn "server started - ".version_info()."\n";
- init_area();
- mgmt_init();
- clp_init();
- trustcheck_init();
-
- sync_cluster_pw() or warn "$CLUSTER_PW_FILE: $!\n";
-
- My::Select::timeout(60,\&purge_old_receiver);
- My::Select::timeout(rand(60),\&send_stat);
- My::Select::timeout(0,\&sample_rproc);
- $my_hostname eq $STAT_TARGET and My::Cluster::Updown::init();
- $my_hostname eq 'macheteinfach' and My::NetlogReceiver::init();
- My::Select::timeout(600,\&check_overload);
-
- My::Select::run();
+ cmd_daemon();
} elsif ($options{'lsof'}) {
die ("`clusterd --lsof` is obsolete. Please use `clusterd lsof`\n");
} else {
From 481951c35b014b09abdf0be5a1c17979a1c2da9e Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:00:07 +0100
Subject: [PATCH 11/26] clusterd: Make "daemon" from option into command
---
clusterd/clusterd | 8 +++++---
clusterd/clusterd.service | 2 +-
2 files changed, 6 insertions(+), 4 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index e9744dd..58af3ea 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -2109,14 +2109,13 @@ use constant USAGE => <<'__EOF__';
usage: $0 [options]
- --daemon # start a daemon
-
push [--post CMD] files... # push files over tcp
exec CMD... # execute CMD on all nodes
CMD : mkmotd | flush-gidcache | reexport | make-automaps
exec @host cmd... # execute (any) command on host
lsof pattern # list open file matching pattern on all nodes
send-restart # send restart request to all nodes
+ daemon # run the daemon
__EOF__
@@ -2150,7 +2149,7 @@ if (defined $options{'push'}) {
} elsif (defined $options{'reexport'}) {
die ("`clusterd --reexport` is obsolete. Please use `clusterd push --post reexport` or `clusterd exec reexport`\n");
} elsif (defined $options{'daemon'}) {
- cmd_daemon();
+ die ("`clusterd --daemon` is obsolete. Please use `clusterd daemon`\n");
} elsif ($options{'lsof'}) {
die ("`clusterd --lsof` is obsolete. Please use `clusterd lsof`\n");
} else {
@@ -2176,6 +2175,9 @@ if (defined $options{'push'}) {
sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
$donald_s=new My::Select::INET(Proto=>'udp') or die "$!\n";
udp_broadcast_message($donald_s,'restart');
+ } elsif ($cmd eq 'daemon') {
+ @args == 0 or die USAGE;
+ cmd_daemon();
} else {
die USAGE;
}
diff --git a/clusterd/clusterd.service b/clusterd/clusterd.service
index 99125df..d3397bc 100644
--- a/clusterd/clusterd.service
+++ b/clusterd/clusterd.service
@@ -1,5 +1,5 @@
[Service]
-ExecStart=/usr/sbin/clusterd --daemon
+ExecStart=/usr/sbin/clusterd daemon
Restart=always
RestartSec=10s
From 29bf2c6c9d4e79f66a63a234e70ddfc89f315c01 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:05:39 +0100
Subject: [PATCH 12/26] clusterd: Improve usage string
Improve usage string from really ugly to ugly, you are not a designer.
---
clusterd/clusterd | 9 ++++++---
1 file changed, 6 insertions(+), 3 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 58af3ea..6f27884 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -2107,16 +2107,19 @@ sub trustcheck_connect_request {
use constant USAGE => <<'__EOF__';
-usage: $0 [options]
+usage: $0 cmd [options] args...
- push [--post CMD] files... # push files over tcp
+Commands:
+
+ push [--post CMD] files... # push files over tcp
exec CMD... # execute CMD on all nodes
- CMD : mkmotd | flush-gidcache | reexport | make-automaps
exec @host cmd... # execute (any) command on host
lsof pattern # list open file matching pattern on all nodes
send-restart # send restart request to all nodes
daemon # run the daemon
+ CMD: mkmotd | flush-gidcache | reexport | make-automaps
+
__EOF__
use Getopt::Long;
From 7c40515f6b57dc014d365921750b1fd8f744cb07 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:11:32 +0100
Subject: [PATCH 13/26] clusterd: Remove push_file() and push_amd_tar()
Remove the functions which implemented the obsolete commands `--push`
and `--push-amd-tar`.
---
clusterd/clusterd | 80 -----------------------------------------------
1 file changed, 80 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 6f27884..cda8cde 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -772,86 +772,6 @@ sub udp_send_message { # udp_send_message( dst, @args) # dst='141.14.31.255' 'zo
#----------------------------------------------------------
-sub push_amd_tar {
- my ($donald_s)=@_;
- my $filename='/tmp/amd.tar';
-
- my $pid=fork;
- defined $pid or return warn "$!\n";
- unless($pid) {
- chdir '/etc/amd' or die "/etc/amd: $!\n";
- exec 'tar','cf',$filename,'.';
- die "$!\n";
- }
- waitpid $pid, 0;
- $? and return;
-
- my $fh=new IO::File $filename,'<' or return warn "$filename: $!\n";
- my $digest=Digest::MD5->new->addfile($fh)->digest;
- warn "tar digest is ",Digest::MD5::md5_hex($digest),"\n";
-
- $pid=fork;
- defined $pid or return warn "$!\n";
- unless($pid) {
- exec 'gzip','-f',$filename;
- die "$!\n";
- }
- waitpid $pid, 0;
- $? and return;
-
- $filename='/tmp/amd.tar.gz';
-
- my $st=Donald::FileInfo->lstat($filename);
- defined $st or return warn "$filename: $!\n";
- $st->type eq 'F' or return warn "$filename: not a plain file\n";
-
- $fh=new IO::File $filename,'<' or return warn "$filename: $!\n";
-
- my $i=0;
- for (my $pos=0;$pos<$st->size;$pos+=1024) {
- my $data;
- defined $fh->sysread($data,1024) or return warn "$filename: $!\n";
- # warn "send bytes $pos to ",$pos+length($data),"\n";
- ++$i % $BC_RATE or sleep 1;
- udp_broadcast_message($donald_s,'amdtardata',$st,$pos,$data,$digest);
- }
-}
-
-sub push_file {
- my ($donald_s,$filename)=@_;
-
- $filename =~ m"^/" or return warn "$filename: please use absolute path\n";
-
- my $st=Donald::FileInfo->lstat($filename);
- defined $st or return warn "$filename: $!\n";
- my $rpc;
- if ($st->type eq 'F') {
- $rpc='filedata';
- $st->size<=80000 or die "$filename: to big for broadcast (max 80000 bytes)\n";
- if ($st->size==0) {
- udp_broadcast_message($donald_s,$rpc,$st,0,'');
- return;
- }
-
- my $fh=new IO::File $filename,'<' or return warn "$filename: $!\n";
- my $i=0;
- for (my $pos=0;$pos<$st->size;$pos+=1024) {
- my $data;
- defined $fh->sysread($data,1024) or return warn "$filename: $!\n";
- # warn "send bytes $pos to ",$pos+length($data),"\n";
- udp_broadcast_message($donald_s,$rpc,$st,$pos,$data);
- ++$i % $BC_RATE or sleep 1;
- }
- } elsif ($st->type eq 'L') {
- $rpc='filedata.2';
- udp_broadcast_message($donald_s,$rpc,$st,0,'');
- return;
- } else {
- die "file type not supported\n";
- }
-
-}
-
our %CMD = (
'mkmotd' => '/usr/sbin/mkmotd.pl',
'flush-gidcache' => 'date -d tomorrow +%s > /proc/net/rpc/auth.unix.gid/flush',
From 7cc660efaea339baf103978d7cd5bfc949c41cf9 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:24:27 +0100
Subject: [PATCH 14/26] clusterd: Remove udp handler flush-gidcache,
make-automaps, reexport
---
clusterd/clusterd | 24 ------------------------
1 file changed, 24 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index cda8cde..8cd351e 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -743,9 +743,6 @@ our %UDP_HANDLER = (
'amdtardata' => \&udp_rx_amdtardata,
'loadavg.2' => \&udp_rx_loadavg2,
'restart' => \&udp_rx_restart,
- 'flush-gidcache' => \&udp_rx_flush_gidcache,
- 'make-automaps' => \&udp_rx_make_automaps,
- 'reexport' => \&udp_rx_reexport,
'log' => \&udp_rx_log,
'exec' => \&udp_rx_exec,
'exec.2' => \&udp_rx_exec2,
@@ -1142,27 +1139,6 @@ sub udp_rx_restart {
exit 40;
}
-sub udp_rx_flush_gidcache {
- if (open my $out,'>','/proc/net/rpc/auth.unix.gid/flush') {
- print $out time();
- } else {
- warn "proc/net/rpc/auth.unix.gid/flush: $!\n";
- }
-}
-
-sub udp_rx_make_automaps {
- if (open my $out,'>','/proc/net/rpc/auth.unix.gid/flush') {
- print $out time();
- } else {
- warn "proc/net/rpc/auth.unix.gid/flush: $!\n";
- }
- system '/sbin/make-automaps';
-}
-
-sub udp_rx_reexport {
- system '/usr/bin/mxmount --reexport-only';
-}
-
#----------- tcp mgmt console -----------------------------
our $MGMT_PORT=234;
From bac1702779cde228193e2ac7a68da9595c7ee6d2 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:33:07 +0100
Subject: [PATCH 15/26] Remove udp handler udp_rx_exec
---
clusterd/clusterd | 23 -----------------------
1 file changed, 23 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 8cd351e..b95f266 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -744,7 +744,6 @@ our %UDP_HANDLER = (
'loadavg.2' => \&udp_rx_loadavg2,
'restart' => \&udp_rx_restart,
'log' => \&udp_rx_log,
- 'exec' => \&udp_rx_exec,
'exec.2' => \&udp_rx_exec2,
'push' => \&udp_rx_push,
'push.2' => \&udp_rx_push2,
@@ -784,28 +783,6 @@ sub send_exec {
udp_broadcast_message($donald_s,'exec',$cmd);
}
-sub udp_rx_exec {
- my ($cmd)=@_;
-
- warn "exec $cmd\n";
- exists $CMD{$cmd} or return;
-
- my $pid;
- $pid=fork;
- unless (defined $pid) {
- warn "$!\n";
- return;
- }
- unless ($pid) {
- open STDOUT,'>','/dev/null';
- open STDERR,'>','/dev/null';
- alarm(60);
- chdir '/';
- exec '/bin/sh','-c',$CMD{$cmd};
- exit 1;
- }
-}
-
sub udp_rx_exec2 {
my @cmd = @_;
my $pid = fork;
From 235ad3bd01281111117b73e2bd8a3713b9905f3a Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:35:02 +0100
Subject: [PATCH 16/26] Remove udp handler udp_rx_push
---
clusterd/clusterd | 77 -----------------------------------------------
1 file changed, 77 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index b95f266..74b2621 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -745,7 +745,6 @@ our %UDP_HANDLER = (
'restart' => \&udp_rx_restart,
'log' => \&udp_rx_log,
'exec.2' => \&udp_rx_exec2,
- 'push' => \&udp_rx_push,
'push.2' => \&udp_rx_push2,
);
@@ -1699,82 +1698,6 @@ sub clp_rx_PULL {
My::Select::writer($s,$cb_write);
}
-sub udp_rx_push {
- my ($ip,$st_want)=@_;
-
- my $filename=$st_want->name;
- my $tmp_filename="$filename.tmp";
-
- $ip eq $my_ip and return;
-
- my $st_is=Donald::FileInfo->lstat($st_want->name);
-
- unless ($st_want->type eq 'F') {
- warn "$filename: type ".$st_want->type." not yet implemented\n";
- return;
- }
-
- if ($st_is
- && $st_is->type eq 'F'
- && $st_is->size == $st_want->size
- && $st_is->mtime == $st_want->mtime
- && $st_is->uid == $st_want->uid
- && $st_is->gid == $st_want->gid
- && $st_is->perm == $st_want->perm
- ) {
- warn "$filename: already okay\n";
- return;
- }
-
- if ($st_want->size==0) {
- -e $tmp_filename and unlink($tmp_filename);
- my $fh=IO::File->new($tmp_filename,O_WRONLY|O_CREAT|O_EXCL|O_NOFOLLOW,0);
- defined $fh or return warn "$tmp_filename: $!\n";
- # no need to fsync empty file
- chown $st_want->uid,$st_want->gid,$tmp_filename or return warn "$tmp_filename: $!\n";
- chmod $st_want->perm,$tmp_filename or return warn "$tmp_filename: $!\n";
- utime($st_want->mtime,$st_want->mtime,$tmp_filename);
- rename($tmp_filename,$filename) or return warn "rename $tmp_filename $filename: $!\n";;
- warn "installed (empty) $filename\n";
- return;
- }
-
- my $s;
- $s=My::Select::INET::connect_tcp($ip,$CLP_PORT,$TCP_TIMEOUT,sub {
- $! and return warn "$ip: $!\n";
- send_tcp_cp($s,sub {
- $! and return warn "$ip: $!\n";
- -e $tmp_filename and unlink($tmp_filename);
- my $fh = IO::File->new($tmp_filename,O_WRONLY|O_CREAT|O_EXCL|O_NOFOLLOW,0);
- defined $fh or return warn "$tmp_filename: $!\n";
-
- my $cb;
- my $bytes=$st_want->size;
- $cb=sub {
- # note, we need to break the circular references $cb of our caller, if no longer needed
- my ($buf)=@_;
- if ($!) { warn "$ip: $!\n";$cb=undef;return; }
- if (length($buf)==0) { warn "$ip: EOF\n";$cb=undef;return;}
- $fh->print($buf) or return warn "$tmp_filename: $!\n";
- $bytes-=length($buf);
- if ($bytes>0) {
- My::Select::INET::read_with_timeout($s,$cb,$TCP_TIMEOUT);
- return;
- }
- $cb=undef;
- $fh->flush();
- $fh->sync();
- chown $st_want->uid,$st_want->gid,$tmp_filename or return warn "$tmp_filename: $!\n";
- chmod $st_want->perm,$tmp_filename or return warn "$tmp_filename: $!\n";
- utime($st_want->mtime,$st_want->mtime,$tmp_filename);
- rename($tmp_filename,$filename) or return warn "rename $tmp_filename $filename: $!\n";
- warn "installed $filename\n";
- };
- My::Select::INET::read_with_timeout($s,$cb,$TCP_TIMEOUT);
- },$TCP_TIMEOUT,'PULL',$st_want);
- });
-}
-
our %TRUSTED_IP = (
'141.14.28.170' => 1, # afk
'141.14.16.131' => 1, # wtf
From 356679a5854ea6c9a187a84fceaa2f9514d53359 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:37:31 +0100
Subject: [PATCH 17/26] Remove udp handler amdtardata
---
clusterd/clusterd | 31 -------------------------------
1 file changed, 31 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 74b2621..820c9ea 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -740,7 +740,6 @@ our ($udp_peer_addr,$udp_peer_port); # ('141.14.12.12',1234)
our %UDP_HANDLER = (
'filedata' => \&udp_rx_filedata,
'filedata.2' => \&udp_rx_filedata,
- 'amdtardata' => \&udp_rx_amdtardata,
'loadavg.2' => \&udp_rx_loadavg2,
'restart' => \&udp_rx_restart,
'log' => \&udp_rx_log,
@@ -838,38 +837,8 @@ sub purge_old_receiver {
#-------------------------------------------------------------
-our $INSTALLED_DIGEST='';
-
our $rx_filedata_done;
-sub udp_rx_amdtardata {
- my ($st_want,$pos,$data,$digest)=@_;
-
- ref($st_want) eq 'My::FileInfo' and bless $st_want,'Donald::FileInfo';
-
- ### $digest eq $INSTALLED_DIGEST and $pos==0 and warn "/etc/amd - ",Digest::MD5::md5_hex($digest)," already installed\n";
- $digest eq $INSTALLED_DIGEST and return;
-
- #### $pos==0 and warn "receiving /etc/amd - ",Digest::MD5::md5_hex($digest),"\n";
-
- udp_rx_filedata($st_want,$pos,$data);
- if ($rx_filedata_done) {
- my $pid=fork;
- defined $pid or return warn "$!\n";
- unless($pid) {
- chdir '/etc/amd' or die "/etc/amd: $!\n";
- exec 'tar','xzf',$st_want->name;
- die "$!\n";
- }
- waitpid $pid, 0;
- $? and return;
-
- warn "installed /etc/amd - ",Digest::MD5::md5_hex($digest),"\n";
- $INSTALLED_DIGEST=$digest;
- system '/sbin/make-automaps';
- }
-}
-
our ($machine,$SYS_lchown,$SYS_mknod);
our ($SYS_utimensat,$AT_FDCWD,$UTIME_OMIT,$AT_SYMLINK_NOFOLLOW);
From fbad65abf3a56a88dfa7a19ccc40eb897d108ea6 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:42:53 +0100
Subject: [PATCH 18/26] Remove udp handler filedata and filedata2
---
clusterd/clusterd | 143 ----------------------------------------------
1 file changed, 143 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 820c9ea..7ebbcac 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -738,8 +738,6 @@ $ENV{'PATH'} = '/usr/local/bin:/sbin:/usr/sbin:/bin'.($ENV{PATH}?':'.$ENV{PATH}:
our ($udp_peer_addr,$udp_peer_port); # ('141.14.12.12',1234)
our %UDP_HANDLER = (
- 'filedata' => \&udp_rx_filedata,
- 'filedata.2' => \&udp_rx_filedata,
'loadavg.2' => \&udp_rx_loadavg2,
'restart' => \&udp_rx_restart,
'log' => \&udp_rx_log,
@@ -801,44 +799,6 @@ sub udp_rx_exec2 {
#-------------------------------------------------------------
-sub normalize_seg { # [pos,len],[pos,len],...
- my @s=sort {$a->[0] <=> $b->[0]} @_;
-
- my $i=0;
- while ($i<$#s) {
- # is element $i joinable with next element
-
- my $end_0=$s[$i]->[0]+$s[$i]->[1];
- if ($end_0 >= $s[$i+1]->[0] ) {
- my $end_1=$s[$i+1]->[0]+$s[$i+1]->[1];
- $s[$i]->[1] = ($end_0>$end_1 ? $end_0 : $end_1)-$s[$i]->[0];
- splice @s,$i+1,1;
- } else {
- $i++;
- }
- }
- return @s;
-}
-
-my %RECEIVER; # ( filename => $receiver, .... )
-
-# $receiver : [ st_want , last_rx , io_handle , [ [pos,len] , [pos,len] , ... ] ]
-
-sub purge_old_receiver {
- while (my ($n,$v)=each %RECEIVER) {
- if ($v->[1]+10<My::Select::time) {
- warn 'timeout receiving ',$v->[0]->name,"\n";
- log_to_stat_target('timeout receiving ',$v->[0]->name);
- delete $RECEIVER{$n};
- }
- }
- My::Select::timeout_requeue(60);
-}
-
-#-------------------------------------------------------------
-
-our $rx_filedata_done;
-
our ($machine,$SYS_lchown,$SYS_mknod);
our ($SYS_utimensat,$AT_FDCWD,$UTIME_OMIT,$AT_SYMLINK_NOFOLLOW);
@@ -876,108 +836,6 @@ sub lmtime {
syscall($SYS_utimensat,$AT_FDCWD,$path,$tsa,$AT_SYMLINK_NOFOLLOW)==0 or return warn "$path: failed to lmtime: $!\n";
}
-sub udp_rx_filedata {
-
-# set rx_filedata_done as a side effect
-
- my ($st_want,$pos,$data)=@_;
-
- ref($st_want) eq 'My::FileInfo' and bless $st_want,'Donald::FileInfo';
-
- my $filename=$st_want->name;
- my $tmp_filename="$filename.tmp";
-
- $rx_filedata_done=0;
-
- my $st_is=Donald::FileInfo->lstat($st_want->name);
- if ($st_is && $st_is->type eq 'F' && $st_is->size==$st_want->size && $st_is->mtime==$st_want->mtime) {
- #### $pos==0 and warn " $filename seems to be current\n";
- return;
- }
-
- if ($st_want->type eq 'L') {
- if (!$st_is || $st_is->type ne 'L' || $st_is->target ne $st_want->target) {
- $st_is and (unlink($filename) or return warn "$filename: failed to unlink: $!\n");
- symlink($st_want->target,$filename) or return warn "$filename: failed to create symlink: $!\n";
- lchown($st_want->uid,$st_want->gid,$filename);
- lmtime($st_want->mtime,$filename);
- warn "installed $filename -> ".$st_want->target."\n";
- } else {
- if ($st_is->uid != $st_want->uid || $st_is->gid != $st_want->gid) {
- lchown($st_want->uid,$st_want->gid,$filename);
- }
- if ($st_is->mtime != $st_want->mtime) {
- lmtime($st_want->mtime,$filename);
- }
- }
- return;
-}
-
- if (length($data) == $st_want->size) {
- # complete file in one broadcast
- -e $tmp_filename and unlink($tmp_filename);
- my $fh=IO::File->new($tmp_filename,O_WRONLY|O_CREAT|O_EXCL|O_NOFOLLOW,0);
- defined $fh or return warn "$tmp_filename: $!\n";
- if ($st_want->size) {
- $fh->syswrite($data) or return warn "$tmp_filename: $!\n";
- $fh->sync();
- }
- chown $st_want->uid,$st_want->gid,$tmp_filename or return warn "$tmp_filename: $!\n";
- chmod $st_want->perm,$tmp_filename or return warn "$tmp_filename: $!\n";
- utime($st_want->mtime,$st_want->mtime,$tmp_filename);
- rename($tmp_filename,$filename) or return warn "rename $tmp_filename $filename: $!\n";
- warn "installed $filename\n";
- $rx_filedata_done=1;
- return;
- }
-
- length($data) or return; # shouldn't happen.
-
- my $receiver=$RECEIVER{$st_want->name};
-
- if (defined $receiver) {
- if ( $receiver->[0]->size != $st_want->size or $receiver->[0]->mtime != $st_want->mtime ) {
- $receiver=undef;
- }
- }
-
- unless (defined $receiver) {
- # create new receiver
- ## warn "start receiving $filename from $udp_peer_addr\n";
- -e $tmp_filename and unlink($tmp_filename);
- my $fh=IO::File->new($tmp_filename,O_WRONLY|O_CREAT|O_EXCL|O_NOFOLLOW,0);
- defined $fh or return warn "$tmp_filename: $!\n";
- $receiver = [$st_want,My::Select::time,$fh,[]];
- $RECEIVER{$filename}=$receiver;
- }
-
- {
- # warn "$filename: receive $pos length ",length($data),"\n";
-
- # write data ( size cant be 0 here )
- $receiver->[2]->seek($pos,0) or return warn "$tmp_filename: $!\n";
- $receiver->[2]->print($data) or return warn "$tmp_filename: $!\n";;
- $receiver->[1]=My::Select::time;
- my $s=$receiver->[3]=[normalize_seg(@{$receiver->[3]},[$pos,length($data)])];
-
- #warn "$filename: receive $pos length ",length($data)," segments now: ",join(",",map( {'['.$_->[0].','.$_->[1].']'} @{$receiver->[3]})),"\n";
-
- # all there ?
-
- if (@$s == 1 && $s->[0]->[0]==0 && $s->[0]->[1]==$st_want->size) {
- $receiver->[2]->flush();
- $receiver->[2]->sync();
- chown $st_want->uid,$st_want->gid,$tmp_filename or return warn "$tmp_filename: $!\n";
- chmod $st_want->perm,$tmp_filename or return warn "$tmp_filename: $!\n";
- utime($st_want->mtime,$st_want->mtime,$tmp_filename);
- rename($tmp_filename,$filename) or return warn "rename $tmp_filename $filename: $!\n";
- warn "installed $filename\n";
- delete $RECEIVER{$filename};
- $rx_filedata_done=1;
- }
- }
-}
-
#----------------------------------------------------------- sample running proc every 10 seconds
our @proc_running=(0)x12; # 12 samples every 5 seconds -> minute average
@@ -1833,7 +1691,6 @@ sub cmd_daemon() {
sync_cluster_pw() or warn "$CLUSTER_PW_FILE: $!\n";
- My::Select::timeout(60,\&purge_old_receiver);
My::Select::timeout(rand(60),\&send_stat);
My::Select::timeout(0,\&sample_rproc);
$my_hostname eq $STAT_TARGET and My::Cluster::Updown::init();
From d9bc5d709ebdb1c0133e556055bc7dad94aa96f0 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:46:55 +0100
Subject: [PATCH 19/26] clusterd: Remove unused functions hostname() and
machine()
---
clusterd/clusterd | 16 ----------------
1 file changed, 16 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 7ebbcac..2ebd0e0 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -15,22 +15,6 @@ our $VERSION = '1.00';
use Storable;
use Digest::MD5;
-sub hostname {
- our $hostname;
- unless (defined $hostname) {
- $hostname=lc `/bin/hostname`;
- chomp($hostname);
- $hostname =~ s/\.molgen\.mpg\.de$//;
- }
- return $hostname;
-}
-
-sub machine {
- our $machine;
- chomp($machine=`uname -m`) unless defined $machine;
- return $machine;
-}
-
sub uptime {
open U,'<','/proc/uptime' or die "/proc/uptime: $!\n";
my $data;
From 189ec2605e1a97b7c29b04c58d27e58604c75991 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:50:56 +0100
Subject: [PATCH 20/26] clusterd: Remove Donald::Tools namespace
---
clusterd/clusterd | 37 +++++++++++--------------------------
1 file changed, 11 insertions(+), 26 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 2ebd0e0..c3db66e 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -6,23 +6,7 @@ use strict;
use POSIX;
use IO::Pipe;
use Digest::MD5;
-
-#-------------------------------------
-package Donald::Tools;
-
-our $VERSION = '1.00';
-
use Storable;
-use Digest::MD5;
-
-sub uptime {
- open U,'<','/proc/uptime' or die "/proc/uptime: $!\n";
- my $data;
- sysread(U,$data,1024);
- close U;
- $data=~ /^(\d+\.?\d*)/ or die "bad data from /proc/uptime: $data\n";
- return $1+0;
-}
sub encode {
return Storable::nfreeze([@_]);
@@ -52,14 +36,6 @@ sub decode {
return @$msg;
}
-#-------------------------------------
-package main;
-
-*encode=*Donald::Tools::encode{CODE};
-*sign=*Donald::Tools::sign{CODE};
-*check_sign=*Donald::Tools::check_sign{CODE};
-*decode=*Donald::Tools::decode{CODE};
-
#-------------------------------------
package Donald::FileInfo;
@@ -184,7 +160,16 @@ sub lstat {
#-------------------------------------
package My::Select;
-our $time=Donald::Tools::uptime();
+sub uptime {
+ open U,'<','/proc/uptime' or die "/proc/uptime: $!\n";
+ my $data;
+ sysread(U,$data,1024);
+ close U;
+ $data=~ /^(\d+\.?\d*)/ or die "bad data from /proc/uptime: $data\n";
+ return $1+0;
+}
+
+our $time = uptime();
sub My::Select::time {
return $time;
@@ -254,7 +239,7 @@ sub cancel_handle {
sub run {
while (1) {
- $time=Donald::Tools::uptime();
+ $time = uptime();
while (@TIMER && $TIMER[0]->[0]<=$time) {
$active_timer_cb=(shift @TIMER)->[1];
$active_timer_cb->();
From 5a6c5c3327dc858da10905565118e34c3e8e89f3 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 14:57:04 +0100
Subject: [PATCH 21/26] clusterd: Move some declarations
---
clusterd/clusterd | 67 ++++++++++++++++++++++-------------------------
1 file changed, 31 insertions(+), 36 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index c3db66e..b0d648e 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -1,41 +1,5 @@
#! /usr/local/system/perl/bin/perl
-use warnings;
-use strict;
-
-use POSIX;
-use IO::Pipe;
-use Digest::MD5;
-use Storable;
-
-sub encode {
- return Storable::nfreeze([@_]);
-}
-
-sub sign {
- my ($password,$data)=@_;
- return Digest::MD5::md5($password.$data).$data; # 16 byte prefix
-}
-
-sub check_sign { # signed-data -> undef or signed-data -> data
- my ($password,$data)=@_;
- length $data>16 or return undef;
- my $rx_digest=substr($data,0,16);
- my $signature=Digest::MD5::md5($password.substr($data,16));
- $rx_digest eq $signature or return undef;
- return substr($data,16);
-}
-
-sub decode {
- my ($data)=@_;
- my $msg;
- eval {
- $msg=Storable::thaw($data);
- };
- $@ and return undef;
- return @$msg;
-}
-
#-------------------------------------
package Donald::FileInfo;
@@ -657,11 +621,14 @@ sub init {
#------------------------------------------------------------------------
package main;
+use warnings;
use strict;
use IO::File;
use Sys::Syslog;
use IO::Socket::INET;
use Data::Dumper;
+use IO::Pipe;
+use Digest::MD5;
our $UDP_MAX=1472;
our $UDP_PORT=234;
@@ -702,6 +669,34 @@ our $CLUSTER_PW_TIMESTAMP=0;
$ENV{'PATH'} = '/usr/local/bin:/sbin:/usr/sbin:/bin'.($ENV{PATH}?':'.$ENV{PATH}:''); # for ps , tar (gnu!)
+sub encode {
+ return Storable::nfreeze([@_]);
+}
+
+sub sign {
+ my ($password,$data)=@_;
+ return Digest::MD5::md5($password.$data).$data; # 16 byte prefix
+}
+
+sub check_sign { # signed-data -> undef or signed-data -> data
+ my ($password,$data)=@_;
+ length $data>16 or return undef;
+ my $rx_digest=substr($data,0,16);
+ my $signature=Digest::MD5::md5($password.substr($data,16));
+ $rx_digest eq $signature or return undef;
+ return substr($data,16);
+}
+
+sub decode {
+ my ($data)=@_;
+ my $msg;
+ eval {
+ $msg=Storable::thaw($data);
+ };
+ $@ and return undef;
+ return @$msg;
+}
+
#---------------------------------------------------------- UDP
our ($udp_peer_addr,$udp_peer_port); # ('141.14.12.12',1234)
From 96e3be5185838bced0d57f299d95a08794032f0b Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 15:08:09 +0100
Subject: [PATCH 22/26] clusterd: Remove dead code
---
clusterd/clusterd | 115 ----------------------------------------------
1 file changed, 115 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index b0d648e..5025fa9 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -255,14 +255,6 @@ use IO::Socket::INET;
our $UDP_MAX = 1472;
-our $SOL_SOCKET=1;
-our $SO_ERROR=4;
-
-sub get_socket_error {
- my ($s)=@_;
- return unpack('i',getsockopt($s,$SOL_SOCKET,$SO_ERROR));
-}
-
sub new { # ( Proto=>'udp',Broadcast=>1,LocalPort=>$UDP_PORT )
my ($class,@args)=@_;
our $socket=new IO::Socket::INET (@args) or return undef;
@@ -296,98 +288,6 @@ sub receive_data {
My::Select::reader($$self,$receive_data_cb);
}
-# send_tcp($socket,$data,$timeout,$cb);
-#
-# send data asynchronously over noblocking tcp socket
-# call callback when done ($!=0) or on error ($! set)
-#
-# all arguments required
-#
-sub send_tcp {
- my ($s,$data,$timeout,$cb)=@_;
- my $len=$s->send($data,0);
- defined $len or return $cb->();
- if ($len==length($data)) {
- $!=0;
- $cb->();
- return;
- }
- my $pos=$len;
- my $cb_tmo=sub {
- My::Select::cancel_handle($s);
- $!=110;
- $cb->();
- };
- my $cb_write=sub {
- My::Select::timeout_cancel($cb_tmo);
- my $len=send($s,substr($data,$pos),0);
- defined $len or return $cb->();
- if ($len==length($data)-$pos) {
- $!=0;
- $cb->();
- return;
- }
- $pos+=$len;
- My::Select::timeout($timeout,$cb_tmo);
- My::Select::writer_requeue();
- };
- My::Select::timeout($timeout,$cb_tmo);
- My::Select::writer($s,$cb_write);
-}
-
-# $socket = connect_tcp ($ip,$port,$timeout,$cb)
-#
-# asynchronously connect to tcp socket.
-# call callback when done or on error (with $! set)
-#
-# all arguments required
-#
-sub connect_tcp {
- my ($ip,$port,$timeout,$cb)=@_;
-
- my $s=new IO::Socket::INET (PeerAddr=>$ip,PeerPort=>$port,Blocking=>0);
- defined $s or return $cb->();
- my $cb_tmo=sub {
- My::Select::cancel_handle($s);
- $!=110;
- $cb->();
- };
- my $cb_write=sub {
- My::Select::timeout_cancel($cb_tmo);
- $!=get_socket_error($s);
- $cb->();
- };
- My::Select::timeout($timeout,$cb_tmo);
- My::Select::writer($s,$cb_write);
- return $s;
-}
-
-# read_with_timeout($socket,$callback,$timeout)
-#
-# asynchronously read from tcp socket.
-#
-sub read_with_timeout {
- my ($s,$cb,$timeout)=@_;
- my $cb_tmo=sub {
- My::Select::cancel_handle($s);
- $!=110;
- $cb->(undef);
- };
- my $cb_read=sub {
- My::Select::timeout_cancel($cb_tmo);
- my $buf='';
- my $l=sysread($s,$buf,102400,0);
- if (!defined $l) {
- $cb->(undef);
- } else {
- $!=0;
- $cb->($buf);
- }
- };
- My::Select::timeout($timeout,$cb_tmo);
- My::Select::reader($s,$cb_read)
-}
-
#--------------------------------------
package My::Cluster::Updown;
@@ -630,10 +530,7 @@ use Data::Dumper;
use IO::Pipe;
use Digest::MD5;
-our $UDP_MAX=1472;
our $UDP_PORT=234;
-our $BC_RATE = 8; # packets per second broadcast
-our $TCP_TIMEOUT=30; # default timeout for tcp processing
our (%options); # RUN OPTIONS
@@ -1191,18 +1088,6 @@ sub clp_rx_CMD {
close $socket;
}
-# send_tcp_cp($socket,$cb,$timeout,@args)
-#
-# send a cluster protocoll message over an async tcp socket.
-#
-# assume $CLUSTER_PW is valid
-#
-sub send_tcp_cp {
- my ($s,$cb,$timeout,@args)=@_;
- my $data=sign($CLUSTER_PW,encode(@args));
- My::Select::INET::send_tcp($s,pack('n',length($data)).$data,$timeout,$cb);
-}
-
sub send_tcp_cp_sync {
my ($s, @args) = @_;
my $data = sign($CLUSTER_PW, encode(@args));
From 6072f023b3438df0f0177708dee9ba21a88a995e Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 15:08:43 +0100
Subject: [PATCH 23/26] clusterd: Remove stray comment
---
clusterd/clusterd | 6 ------
1 file changed, 6 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 5025fa9..401526f 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -963,12 +963,6 @@ sub run_cmd {
exec @cmd;
die "$!\n";
}
-# $::SIG{'CHLD'}=sub {
-# my $pid=wait;
-# my $buffer="X$?";
-# $socket->send(pack('n',length($buffer)).$buffer,0);
-# exit;
-# };
$opipe->reader();
$epipe->reader();
my $ofn=$opipe->fileno;
From eb7ecab48638438db49bf855fade3abf4ebfa6d8 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 15:15:40 +0100
Subject: [PATCH 24/26] clusterd: Move is_trusted_ip() up
---
clusterd/clusterd | 20 ++++++++++----------
1 file changed, 10 insertions(+), 10 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 401526f..603bcc6 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -594,6 +594,16 @@ sub decode {
return @$msg;
}
+our %TRUSTED_IP = (
+ '141.14.28.170' => 1, # afk
+ '141.14.16.131' => 1, # wtf
+);
+
+sub is_trusted_ip {
+ my ($ip) = @_;
+ return exists $TRUSTED_IP{$ip} ? 1 : 0;
+}
+
#---------------------------------------------------------- UDP
our ($udp_peer_addr,$udp_peer_port); # ('141.14.12.12',1234)
@@ -1368,16 +1378,6 @@ sub clp_rx_PULL {
My::Select::writer($s,$cb_write);
}
-our %TRUSTED_IP = (
- '141.14.28.170' => 1, # afk
- '141.14.16.131' => 1, # wtf
-);
-
-sub is_trusted_ip {
- my ($ip) = @_;
- return exists $TRUSTED_IP{$ip} ? 1 : 0;
-}
-
sub udp_rx_push2 {
my ($ip, $st_ary, $post_ary) = @_;
From 185c5ada49bd58f73c9704557240634b8000abf4 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 15:17:24 +0100
Subject: [PATCH 25/26] clusterd: Refactor run_cmd into its only caller
---
clusterd/clusterd | 9 ++-------
1 file changed, 2 insertions(+), 7 deletions(-)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 603bcc6..3f09b06 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -952,7 +952,7 @@ sub clp_rx_LSOF {
close $socket;
}
-sub run_cmd {
+sub clp_rx_CMD {
my ($socket,@cmd)=@_;
my $pid=fork;
unless (defined $pid) {
@@ -1017,6 +1017,7 @@ sub run_cmd {
}
}
}
+ close $socket;
}
#----------- CLP cluster protocol -----------------------------
@@ -1086,12 +1087,6 @@ sub clp_send_message { # clp_send_message($socket, @args)
$s->send(pack('n',length($data)).$data);
}
-sub clp_rx_CMD {
- my ($socket,@args)=@_;
- run_cmd($socket,@args);
- close $socket;
-}
-
sub send_tcp_cp_sync {
my ($s, @args) = @_;
my $data = sign($CLUSTER_PW, encode(@args));
From 2c1722481b2c8920fd55d252a47bf7f5e9e98565 Mon Sep 17 00:00:00 2001
From: Donald Buczek <buczek@molgen.mpg.de>
Date: Wed, 29 Jan 2025 15:33:59 +0100
Subject: [PATCH 26/26] clusterd: Accept commands only from trusted hosts
---
clusterd/clusterd | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/clusterd/clusterd b/clusterd/clusterd
index 3f09b06..44fe3fe 100755
--- a/clusterd/clusterd
+++ b/clusterd/clusterd
@@ -954,6 +954,12 @@ sub clp_rx_LSOF {
sub clp_rx_CMD {
my ($socket,@cmd)=@_;
+
+ unless (is_trusted_ip($socket->peerhost())) {
+ warn "reveived command from untrusted host ". $socket->peerhost(). "\n";
+ return;
+ }
+
my $pid=fork;
unless (defined $pid) {
warn"$!\n";
@@ -1224,6 +1230,8 @@ sub expand_hostconfig_hosts {
sub exec_at {
my ($host,@cmd)=@_;
+ is_trusted_ip($my_ip) or die "This command only works on a trusted host\n";
+
sync_cluster_pw() or die "$CLUSTER_PW_FILE: $!\n";
my $s=new IO::Socket::INET(PeerAddr=>$host,PeerPort=>$CLP_PORT);
unless (defined $s) {