aboutsummaryrefslogtreecommitdiff
path: root/testscripts/slave-agent
diff options
context:
space:
mode:
Diffstat (limited to 'testscripts/slave-agent')
-rwxr-xr-xtestscripts/slave-agent308
1 files changed, 308 insertions, 0 deletions
diff --git a/testscripts/slave-agent b/testscripts/slave-agent
new file mode 100755
index 000000000..e3ce220f2
--- /dev/null
+++ b/testscripts/slave-agent
@@ -0,0 +1,308 @@
+#!/usr/bin/perl -w
+#/**************************************************************************/
+#/* */
+#/* Copyright (c) 2015-2016 Qindel Group (http://www.qindel.com) */
+#/* */
+#/* NXSCRIPTS, NX protocol compression and NX extensions to this software */
+#/* are copyright of NoMachine. Redistribution and use of the present */
+#/* software is allowed according to terms specified in the file LICENSE */
+#/* which comes in the source distribution. */
+#/* */
+#/* Check http://www.nomachine.com/licensing.html for applicability. */
+#/* */
+#/* NX and NoMachine are trademarks of Medialogic S.p.A. */
+#/* */
+#/* All rights reserved. */
+#/* */
+#/**************************************************************************/
+
+# This is a test script for the slave channel feature. While there are no
+# particular requirements for the slave channel command, what makes the most
+# sense is to use the feature to run some sort of multiplexer.
+#
+# This script contains functionality intended to test the channel's bandwidth,
+# latency and integrity.
+#
+# Usage:
+# Set NX_SLAVE_CMD to this script and enable the slave channel
+#
+# Run:
+# nxproxy [...] slave=12000
+# nxagent -display nx/nx,options=nxagent.conf # slave=22000 in nxagent.conf
+#
+# Where 12000 and 22000 are example TCP ports the program will listen on.
+#
+# For ease of debugging and running both sides on a single machine, the script
+# reacts to its own name and changes the prompt to "Proxy" if $0 contains
+# "proxy", or "Agent" if it contains "agent". This has no other effect.
+#
+#
+
+use strict;
+use POSIX ":sys_wait_h";
+
+my $me = "?";
+my $EXIT;
+
+$| = 1;
+
+if ( $0 =~ /proxy/i ) {
+ $me = "Proxy";
+} elsif ( $0 =~ /agent/i ) {
+ $me = "Agent";
+} else {
+ $me = $0;
+}
+
+
+print "$me slave. ";
+if ( scalar @ARGV ) {
+ print "Called with arguments: " . join(' ', @ARGV) . "\n\n";
+} else {
+ print "Called without arguments.\n\n";
+}
+
+
+my %commands;
+register('quit' , \&cmd_quit , "Exit.");
+register('fork' , \&cmd_fork , "Test forking a child process.");
+register('exec' , \&cmd_exec , "Test calling another process via exec.");
+register('system' , \&cmd_system , "Test calling another process via system.");
+register('echo' , \&cmd_echo , "Echo text after the command. Tests channel latency.");
+register('blkecho' , \&cmd_blkecho, "Echo data by 1k blocks. Tests channel integrity.");
+register('reexec' , \&cmd_reexec , "Reexecute slave handler.");
+register('chargen' , \&cmd_chargen, "Output characters forever. Tests channel throughput.");
+register('randgen' , \&cmd_randgen, "Output random characters forever. Tests channel throughput.");
+register('discard' , \&cmd_discard, "Accept characters forever. Tests channel throughput.");
+register('fastgen' , \&cmd_fastgen, "Output a single character forever. Tests channel throughput.");
+register('env' , \&cmd_env , "Dump the environment.");
+register('help' , \&cmd_help , "Shows this help.");
+register('pwd' , \&cmd_pwd , "Print working directory.");
+cmd_help();
+
+
+
+#print "$me> ";
+my $line;
+while(!$EXIT) {
+
+ print "$me> ";
+
+ # Buffered IO screws things up
+ my $c="";
+ $line = "";
+ while($c ne "\n") {
+ my $ret = sysread(STDIN, $c, 1);
+ if (!defined $ret) {
+ die "Read failed: $!";
+ }
+
+ if (!$ret) {
+ last;
+ }
+
+ $line .= $c;
+ }
+
+ chomp $line;
+ $line =~ s/\r+$//;
+ $line =~ s/\n+$//;
+
+ next unless ( $line );
+
+ my ($cmd, @args) = split(/\s+/, $line);
+ if ( exists $commands{$cmd} ) {
+ $commands{$cmd}->{handler}->( @args );
+ } else {
+ print "Unknown command: '$cmd'\n";
+ }
+
+}
+
+print "$me slave terminated.\n";
+
+sub register {
+ my ($name, $handler, $desc) = @_;
+ $commands{$name} = { handler => $handler, desc => $desc };
+}
+
+
+sub cmd_quit {
+ $EXIT = 1;
+}
+
+sub cmd_echo {
+ my (@args) = @_;
+ print "You said: '" . join(' ', @args) . "'\n\n";
+}
+
+sub cmd_blkecho {
+ my $size = shift // 1024;
+ unless ($size =~ /^\d+/ ) {
+ print "The argument must be a number\n\n";
+ return;
+ }
+
+ my $buf;
+ while(1) {
+ my ($tmp, $ret);
+ $buf = "";
+
+ while(length($buf) < $size) {
+ $ret = sysread(STDIN, $tmp, $size - length($buf));
+ if ( !defined $ret ) {
+ die "Error reading from socket: $!";
+ }
+
+ last if ( $ret == 0 );
+ $buf .= $tmp;
+ }
+
+ my $written =0;
+ while($written < $size) {
+ my $ret = syswrite(STDOUT, $buf, $size, $written);
+ if (!defined $ret) {
+ die "Error writing to socket: $!";
+ }
+
+ last if ( $ret == 0);
+ $written += $ret;
+ }
+ }
+}
+
+sub cmd_reexec {
+ print "Will now re-execute: $0 " . join(' ', @ARGV) . "\n";
+ exec($0, @ARGV);
+}
+
+sub cmd_exec {
+ print "Will now exec: uname -a\n";
+ exec("uname", "-a");
+}
+
+sub cmd_system {
+ print "Will now call: uptime\n";
+ system("uptime");
+ print "\n";
+}
+
+# Forks off a short lived process
+
+sub cmd_fork {
+ my $pid = fork();
+ if ( $pid == 0 ) {
+ print "I am the child, with pid $$. Waiting 10 seconds.\n";
+ sleep(10);
+ print "Child exiting with code 123\n";
+ exit(123);
+ } else {
+ print "I am the parent, my child is $pid\n";
+ my $dead = waitpid($pid, 0);
+ print "Reaped child $pid, return $dead\n";
+ }
+
+ print "\n";
+}
+
+sub cmd_help {
+ print "Commands:\n";
+ for my $cmd ( sort keys %commands ) {
+ print "\t$cmd" . ( " " x (10 - length($cmd))) . ": " . $commands{$cmd}->{desc} . "\n";
+ }
+ print "\n";
+}
+
+# Output a single character really fast.
+# Used to test bandwidth and integrity
+sub cmd_fastgen {
+ my $char = chr(shift // ord("x"));
+ my $buf = ($char x 72) . "\n";
+ while( syswrite(STDOUT, $buf) ) {
+ 1;
+ }
+}
+
+# Output RFC 864 chargen.
+# Used to test bandwidth
+sub cmd_chargen {
+ my $text = "";
+
+ for(my $i=33;$i<33+95;$i++) {
+ $text .= chr($i);
+ }
+
+
+ my $pos = 0;
+ my $strlen = 72;
+ while( 1 ) {
+ my $out = substr($text, $pos, $strlen);
+
+ if ( $pos + $strlen > length($text) ) {
+ $out .= substr($text, 0, $pos + $strlen - length($text) + 1);
+ }
+
+ $out .= "\n";
+
+ syswrite(STDOUT, $out) or return;
+
+ if ( ++$pos >= length($text) ) {
+ $pos=0;
+ }
+ }
+
+}
+
+# Output random data
+# Used to test channel integrity and bandwidth with incompressible content.
+# Typically slower than chargen/fastgen.
+
+sub cmd_randgen {
+ if ( open(my $fh, '<', '/dev/urandom') ) {
+ my $buf;
+ while(1) {
+ sysread($fh, $buf, 1024);
+ syswrite(STDOUT, $buf) or return;
+ }
+ } else {
+ print "Failed to open /dev/urandom: $!. May not be available on this architecture.\n\n";
+ }
+}
+
+# Accept arbitrary data
+# Used to test bandwidth
+
+sub cmd_discard {
+ my $buf = "";
+
+ while( sysread(STDIN, $buf, 1024) ) {
+ 1;
+ }
+
+}
+
+# Dump the environment
+
+sub cmd_env {
+ my $longest = 0;
+
+ foreach my $var (keys %ENV) {
+ if ( $longest < length($var) ) {
+ $longest = length($var);
+ }
+ }
+
+ foreach my $var (sort keys %ENV) {
+ print "$var" . (" " x ($longest - length($var))) . ": $ENV{$var}\n";
+ }
+
+ print "\n";
+}
+
+# Show the current directory
+
+sub cmd_pwd {
+ require Cwd;
+ import Cwd;
+ print "Current directory: " . getcwd() . "\n\n";
+}