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;
  52
  53 if (defined($ARGV[0])) {
  54         $hostalias = $ARGV[0];
  55 } else {
  56         print STDERR "Usage: $0 card-alias\n\n";
  57         print STDERR "card-alias\tone of: ";
  58         foreach my $alias (keys(%Config)) {
  59                 print STDERR "\"${alias}\" ";
  60         }
  61         print STDERR "(see ~/.rsbs2rc)\n";
  62         exit(1);
  63 }
  64
  65 my $url = "http://" . ${$Config{$hostalias}}{"host"};
  66 login($url, ${$Config{$hostalias}}{"user"}, ${$Config{$hostalias}}{"pass"});
  67
  68 my $response = $ua->get("${url}/cgi/url_redirect.cgi?url_name=ikvm&url_type=jwsk");
  69 die $response->status_line if (!($response->is_success));
  70
  71 my $jnlp = $response->decoded_content;
  72
  73 $jnlp =~ s/(<resources os=\"Linux\" arch=\"amd64\">)/$1<property name=\"jnlp.packEnabled\" value=\"true\"\/><property name=\"jnlp.versionEnabled\" value=\"true\"\/>/;
  74
  75 my $fh = File::Temp->new(SUFFIX => '.jnlp');
  76 $fh->unlink_on_destroy(1);
  77
  78 print $fh $jnlp;
  79
  80 system("javaws", $fh->filename);
  81 sleep(1);