added dtop script and svn directories

git-svn-id: svn://anubis/misc/dtop@103 bd8a9e45-a331-0410-811e-c64571078777

trunk/dtop

@@ -0,0 +1,172 @@
+#!/usr/bin/perl
+
+# Prelude
+use strict;
+use warnings;
+use threads;
+use threads::shared;
+use Getopt::Long;
+use IO::Socket::INET;
+use Sys::Hostname;
+
+# "Constants"
+my $PROG_NAME = 'dtop';
+my $PROC_STAT = '/proc/stat';
+my $TICKS_PER_CORE_PER_SECOND = 100;
+my $PORT = 9119;
+
+# Globals
+my %hostnames : shared;
+my @hostloads : shared = (0);
+
+exit(main());
+
+sub main
+{
+    my $host = '';
+    my $port = 0;
+    my $id = 0;
+    GetOptions('host=s' => \$host,
+               'port=i' => \$port,
+               'id=i'   => \$id);
+
+    if ($host eq '')
+    {
+        # In the server
+        my @hostlist = <>;
+        chomp(@hostlist);
+
+        my $listen_thread = threads->create(sub {
+                my $listenSock = IO::Socket::INET->new('Listen'    => 5,
+                                                       'LocalPort' => $PORT,
+                                                       'Proto'     => 'tcp');
+
+                for (;;)
+                {
+                    my $client_sock = $listenSock->accept();
+                    my $client_thread = threads->create(sub {
+                            my ($client_sock) = @_;
+                            while (my $inLine = <$client_sock>)
+                            {
+                                if ($inLine =~ /^(\d+):\s+(\d+)/)
+                                {
+                                    $hostloads[$1] = $2;
+                                }
+                                print $client_sock ("ack\r\n");
+                            }
+                        }, $client_sock);
+                }
+            });
+
+        my $id = 1;
+        foreach my $host (@hostlist)
+        {
+            $hostnames{$id} = $host;
+            push(@hostloads, 0);
+            rexec($host, $id);
+            $id++;
+        }
+
+        # infinite loop to print host loads
+        for (;;)
+        {
+            cursorHome();
+            for my $id (1 .. $#hostloads)
+            {
+                printHostLoad($id);
+            }
+            sleep(1);
+        }
+    }
+    else
+    {
+        my $sock = IO::Socket::INET->new('PeerHost'  => $host,
+                                         'PeerPort'  => $port,
+                                         'Proto'     => 'tcp',
+                                         'ReuseAddr' => 1);
+
+        my $maxTicks = getTicksPerSecond();
+        my $lastTicks = getCurrentTicks();
+
+        for (;;)
+        {
+            my $curTicks = getCurrentTicks();
+            my $usage = int(($curTicks - $lastTicks) / $maxTicks * 100.0);
+            $lastTicks = $curTicks;
+            print $sock ("$id: $usage\r\n");
+            sleep(1);
+            my $data;
+            $sock->recv($data, 5);
+            last if (length($data) < 1);
+        }
+
+        $sock->shutdown(2);
+    }
+
+    return 0;
+}
+
+sub getCurrentTicks
+{
+    my $currentTicks = 0;
+
+    open(FILE, '<', $PROC_STAT);
+    while (my $line = <FILE>)
+    {
+        if ($line =~ /^cpu\d+\s+(\d+)\s/)
+        {
+            $currentTicks += $1;
+        }
+    }
+    close(FILE);
+
+    return $currentTicks;
+}
+
+sub getTicksPerSecond
+{
+    my $ticks = 0;
+
+    open(FILE, '<', $PROC_STAT);
+    while (my $line = <FILE>)
+    {
+        if ($line =~ /^cpu\d+\s/)
+        {
+            $ticks += $TICKS_PER_CORE_PER_SECOND;
+        }
+    }
+    close(FILE);
+
+    return $ticks;
+}
+
+sub rexec
+{
+    my ($rhost, $id) = @_;
+    async
+    {
+        system('ssh', $rhost,
+               $PROG_NAME, '--host', hostname(), '--port', $PORT, '--id', $id);
+    }
+}
+
+sub printHostLoad
+{
+    my ($id) = @_;
+    my $hostname = $hostnames{$id};
+    my $load = $hostloads[$id];
+    my $loadchars = int($load / 100.0 * 50.0);
+    $loadchars = 0 if ($loadchars < 0);
+    $loadchars = 50 if ($loadchars > 50);
+    my $loadstring = '=' x $loadchars;
+    my $leftoverstring = ' ' x (50 - $loadchars);
+    printf("%-24s: [%s>%s]\n",
+           $hostname,
+           $loadstring,
+           $leftoverstring);
+}
+
+sub cursorHome
+{
+    print("\e[H");
+}