git.zerfleddert.de Git - rsbs2/blob - supermicro-kvm.pl

   1 #!/usr/bin/perl -w
   2
   3 use LWP::UserAgent;
   4 use LWP::ConnCache;
   5 use XML::Simple;
   6 use Data::Dumper;
   7 use File::Temp;
   8
   9 my $ua = LWP::UserAgent->new(cookie_jar => {});
  10 $ua->default_header('Referer' => 'http://localhost');
  11
  12 sub login {
  13         my $url = shift;
  14         my $user = shift;
  15         my $pass = shift;
  16
  17         my $login = { 'name' => $user, 'pwd' => $pass };
  18         my $response = $ua->post("${url}/cgi/login.cgi", $login);
  19         die $response->status_line if (!($response->is_success));
  20 }
  21
  22 sub read_inifile {
  23         my $filename = shift;
  24
  25         open(INIFILE,"<${filename}") || die("can't open config: ${filename}: $!");
  26         my %Ini = ();
  27         my @sections = ();
  28         while(<INIFILE>) {
  29                 chomp;
  30
  31                 next if (m/^#/);
  32
  33                 if (m/^\s*\[(.*)\]\s*$/) {
  34                         push @sections, $1;
  35                         next;
  36                 }
  37
  38                 if (@sections) {
  39                         if (m/^\s*([^=]+)\s*=\s*(.*)\s*$/) {
  40                                 ${$Ini{$sections[$#sections]}}{$1} = $2;
  41                         }
  42                 }
  43         }
  44         close(INIFILE);
  45
  46         %Ini;
  47 }
  48
  49 my %Config = read_inifile("$ENV{HOME}/.rsbs2rc");
  50
  51 my $hostalias = $ARGV[0];
  52
  53 if (!defined($hostalias) || !defined($Config{$hostalias})) {
  54         print STDERR "Usage: $0 card-alias\n\n";
  55         print STDERR "card-alias\tone of:\n";
  56         foreach my $alias (sort keys(%Config)) {
  57                 print STDERR "\"${alias}\"\n";
  58         }
  59         print STDERR "(see ~/.rsbs2rc)\n";
  60         exit(1);
  61 }
  62
  63 my $url = "http://" . ${$Config{$hostalias}}{"host"};
  64 login($url, ${$Config{$hostalias}}{"user"}, ${$Config{$hostalias}}{"pass"});
  65
  66 my $response = $ua->get("${url}/cgi/url_redirect.cgi?url_name=ikvm&url_type=jwsk");
  67 die $response->status_line if (!($response->is_success));
  68
  69 my $jnlp = $response->decoded_content;
  70
  71 $jnlp =~ s/(<resources os=\"Linux\" arch=\"amd64\">)/$1<property name=\"jnlp.packEnabled\" value=\"true\"\/><property name=\"jnlp.versionEnabled\" value=\"true\"\/>/;
  72
  73 my $fh = File::Temp->new(SUFFIX => '.jnlp');
  74 $fh->unlink_on_destroy(1);
  75
  76 print $fh $jnlp;
  77
  78 $ENV{'AWT_TOOLKIT'} = 'MToolkit';
  79 system("javaws", $fh->filename);
  80 sleep(1);