From a154a83fe4695eca4bb8aeebe7fb5380561a94df Mon Sep 17 00:00:00 2001
From: Michael Gernoth <michael@gernoth.net>
Date: Mon, 20 Mar 2017 16:27:28 +0100
Subject: [PATCH 1/1] supermicro-kvm.pl: add script to connect to supermicro
 iKVM

---
 supermicro-kvm.pl | 81 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 81 insertions(+)
 create mode 100755 supermicro-kvm.pl

diff --git a/supermicro-kvm.pl b/supermicro-kvm.pl
new file mode 100755
index 0000000..afe0523
--- /dev/null
+++ b/supermicro-kvm.pl
@@ -0,0 +1,81 @@
+#!/usr/bin/perl -w
+
+use LWP::UserAgent;
+use LWP::ConnCache;
+use XML::Simple;
+use Data::Dumper;
+use File::Temp;
+
+my $ua = LWP::UserAgent->new(cookie_jar => {});
+$ua->default_header('Referer' => 'http://localhost');
+
+sub login {
+	my $url = shift;
+	my $user = shift;
+	my $pass = shift;
+
+	my $login = { 'name' => $user, 'pwd' => $pass };
+	my $response = $ua->post("${url}/cgi/login.cgi", $login);
+	die $response->status_line if (!($response->is_success));
+}
+
+sub read_inifile {
+	my $filename = shift;
+
+	open(INIFILE,"<${filename}") || die("can't open config: ${filename}: $!");
+	my %Ini = ();
+	my @sections = ();
+	while(<INIFILE>) {
+		chomp;
+	
+		next if (m/^#/);
+	
+		if (m/^\s*\[(.*)\]\s*$/) {
+			push @sections, $1;
+			next;
+		}
+	
+		if (@sections) {
+			if (m/^\s*([^=]+)\s*=\s*(.*)\s*$/) {
+				${$Ini{$sections[$#sections]}}{$1} = $2;
+			}
+		}
+	}
+	close(INIFILE);
+
+	%Ini;
+}
+
+my %Config = read_inifile("$ENV{HOME}/.rsbs2rc");
+
+my $hostalias;
+
+if (defined($ARGV[0])) {
+	$hostalias = $ARGV[0];
+} else {
+	print STDERR "Usage: $0 card-alias\n\n";
+	print STDERR "card-alias\tone of: ";
+	foreach my $alias (keys(%Config)) {
+		print STDERR "\"${alias}\" ";
+	}
+	print STDERR "(see ~/.rsbs2rc)\n";
+	exit(1);
+}
+
+my $url = "http://" . ${$Config{$hostalias}}{"host"};
+login($url, ${$Config{$hostalias}}{"user"}, ${$Config{$hostalias}}{"pass"});
+
+my $response = $ua->get("${url}/cgi/url_redirect.cgi?url_name=ikvm&url_type=jwsk");
+die $response->status_line if (!($response->is_success));
+
+my $jnlp = $response->decoded_content;
+
+$jnlp =~ s/(<resources os=\"Linux\" arch=\"amd64\">)/$1<property name=\"jnlp.packEnabled\" value=\"true\"\/><property name=\"jnlp.versionEnabled\" value=\"true\"\/>/;
+
+my $fh = File::Temp->new(SUFFIX => '.jnlp');
+$fh->unlink_on_destroy(1);
+
+print $fh $jnlp;
+
+system("javaws", $fh->filename);
+sleep(1);
-- 
2.39.5