supermicro-kvm.pl: add script to connect to supermicro iKVM

diff --git a/supermicro-kvm.pl b/supermicro-kvm.pl
new file mode 100755 (executable)
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);