X-Git-Url: http://git.zerfleddert.de/cgi-bin/gitweb.cgi/rsbs2/blobdiff_plain/06873593de347f3e740d37a9f5416697df662847..3f4d6039fcf53e15e439597d6115b97ccd576457:/rsbs2.pl diff --git a/rsbs2.pl b/rsbs2.pl index 51d9c64..6ce2321 100755 --- a/rsbs2.pl +++ b/rsbs2.pl @@ -8,7 +8,7 @@ use Digest::MD5 qw(md5); my $ua = LWP::UserAgent->new; my $sid; -my $host; +my $url; my $poweronms=200; my $poweroffms=5000; my $verbose = 0; @@ -145,13 +145,13 @@ sub _hash { sub _req { my $xml = shift; - $request = HTTP::Request->new(POST => "http://${host}/cgi/bin"); + $request = HTTP::Request->new(POST => "${url}/cgi/bin"); $request->header(Cookie => "sid=$sid"); $request->content_type('application/x-www-form-urlencoded'); $request->content(''.$xml.''); $response = $ua->request($request); die("Error in request: " . $response->status_line . "\n") unless ($response->is_success); - XMLin($response->content, SuppressEmpty => ''); + XMLin($response->content, SuppressEmpty => '')->{RESP}; } sub _cmd { @@ -159,12 +159,12 @@ sub _cmd { my $reqstr=''; my $res = _req($reqstr); - if ($res->{RESP}->{RC} ne '0x0') { - print "${cmd} failed: ".$res->{RESP}->{RC}."\n"; + if ($res->{RC} ne '0x0') { + print "${cmd} failed: ".$res->{RC}."\n"; undef; } - $res->{RESP}; + $res; } sub _getprop { @@ -175,8 +175,8 @@ sub _getprop { print "get: ${property}\n" if ($verbose); - if ($resp->{RESP}->{RC} ne '0x0') { - $resp->{RESP}->{RC}; + if ($resp->{RC} ne '0x0') { + $resp->{RC}; } else { $resp; } @@ -184,7 +184,7 @@ sub _getprop { sub logout { print "Logout\n" if ($verbose); - my $request = HTTP::Request->new(GET => "http://${host}/cgi/logout"); + my $request = HTTP::Request->new(GET => "${url}/cgi/logout"); $request->header(Cookie => "sid=$sid"); my $response = $ua->request($request); die("While trying to logout: " . $response->status_line . "\n") unless ($response->is_success); @@ -197,7 +197,7 @@ sub setprop { my $property = shift; my $value = shift; - my $oldval = _getprop($property)->{RESP}->{PROPLIST}->{PROP}->{VAL}; + my $oldval = _getprop($property)->{PROPLIST}->{PROP}->{VAL}; if ($value eq $oldval) { print "${property} is already ${value}\n" if ($verbose); @@ -207,8 +207,8 @@ sub setprop { my $reqstr=''.$value.''; my $res = _req($reqstr); - if ($res->{RESP}->{RC} ne '0x0') { - print "Error setting ${property} to ${value}: ".$res->{RESP}->{RC}."\n"; + if ($res->{RC} ne '0x0') { + print "Error setting ${property} to ${value}: ".$res->{RC}."\n"; undef; } else { print "${property}: ${oldval} -> ${value}\n" if ($verbose); @@ -231,8 +231,8 @@ sub serveraction { my $reqstr=''.$action.''; my $res = _req($reqstr); - if ($res->{RESP}->{RC} ne '0x0') { - print "FAILED:".$res->{RESP}->{RC}."\n"; + if ($res->{RC} ne '0x0') { + print "FAILED:".$res->{RC}."\n"; } } @@ -260,7 +260,7 @@ sub powercycle { sub showprop { my $property = shift; - my $phash = _getprop($property)->{RESP}->{PROPLIST}->{PROP}; + my $phash = _getprop($property)->{PROPLIST}->{PROP}; print "${property}: " . ${phash}->{VAL} . " (" . ${phash}->{PERMS} . ")\n"; } @@ -270,14 +270,14 @@ sub board_properties { my $resp = _req($reqstr); print " * Board Properties:\n"; - foreach my $bprop (@{$resp->{RESP}->{BPROPLIST}->{BPROP}}) { + foreach my $bprop (@{$resp->{BPROPLIST}->{BPROP}}) { print " * " . ${bprop}->{NAME} . ": " . ${bprop}->{VAL} . "\n"; } } sub show_boarddesc { my $reqstr=''; - my $boarddesc64 = _req($reqstr)->{RESP}->{BPROPLIST}->{BPROP}->{VAL}; + my $boarddesc64 = _req($reqstr)->{BPROPLIST}->{BPROP}->{VAL}; my $boarddesc = decode_base64($boarddesc64); my @board = split(//, $boarddesc); foreach my $byte (@board) { @@ -315,7 +315,7 @@ sub getusrprops { my $usr = shift; my $reqstr = ''; - my $res = _req($reqstr)->{RESP}->{USER}->{PROP}; + my $res = _req($reqstr)->{USER}->{PROP}; $res; } @@ -325,8 +325,8 @@ sub usradd { my $reqstr=''; my $res = _req($reqstr); - if ($res->{RESP}->{RC} ne '0x0') { - print "FAILED:".$res->{RESP}->{RC}."\n"; + if ($res->{RC} ne '0x0') { + print "FAILED:".$res->{RC}."\n"; } } @@ -338,7 +338,7 @@ sub setusrprop { my $reqstr=''; my $res = _req($reqstr); - my $oldval = ${res}->{RESP}->{USER}->{PROP}->{VAL}; + my $oldval = ${res}->{USER}->{PROP}->{VAL}; if ($value eq $oldval) { print "${property} is already ${value}\n" if ($verbose); @@ -348,8 +348,8 @@ sub setusrprop { $reqstr=''.$value.''; $res = _req($reqstr); - if ($res->{RESP}->{RC} ne '0x0') { - print "Error setting ${property} to ${value}: ".$res->{RESP}->{RC}."\n"; + if ($res->{RC} ne '0x0') { + print "Error setting ${property} to ${value}: ".$res->{RC}."\n"; undef; } else { print "${property}: ${oldval} -> ${value}\n" if ($verbose); @@ -363,15 +363,15 @@ sub syslog_debug { my $reqstr=''.${destination_ip}.''.${bcast}.'FALSE'; my $res = _req($reqstr); - if ($res->{RESP}->{RC} ne '0x0') { - print "FAILED:".$res->{RESP}->{RC}."\n"; + if ($res->{RC} ne '0x0') { + print "FAILED:".$res->{RC}."\n"; return; } $reqstr='TRUE0x10x1FALSE'; $res = _req($reqstr); - if ($res->{RESP}->{RC} ne '0x0') { - print "FAILED:".$res->{RESP}->{RC}."\n"; + if ($res->{RC} ne '0x0') { + print "FAILED:".$res->{RC}."\n"; return; } @@ -394,7 +394,7 @@ sub get_sensors { $req .= ''; my $sprop = _req($req); - foreach my $s (@{$sprop->{RESP}->{SENSORLIST}->{SENSOR}}) { + foreach my $s (@{$sprop->{SENSORLIST}->{SENSOR}}) { my $sensor = {}; foreach my $sp (@{$s->{PROP}}) { $sensor->{$sp->{NAME}} = $sp->{VAL}; @@ -477,11 +477,25 @@ sub status { show_sensors(); } +sub spawn_gui { + my $base = shift; + open(APPLET,"|appletviewer /dev/stdin"); + print APPLET 'RSB S2 User Interface'; + print APPLET ''; + print APPLET ''; + print APPLET ''; + print APPLET ''; + print APPLET ''; + print APPLET ''; + print APPLET ''; + close(APPLET); +} + sub login { my $user = shift; my $pass = shift; - my $response = $ua->get("http://${host}/cgi/challenge"); + my $response = $ua->get("${url}/cgi/challenge"); die $response->status_line if (!($response->is_success)); my $xmlin = XMLin($response->decoded_content); @@ -498,7 +512,7 @@ sub login { my $login_hash = _hash($pass, $challenge); print "Hash: ${login_hash}\n" if ($verbose); - my $request = HTTP::Request->new(GET => "http://${host}/cgi/login?user=${user}&hash=${login_hash}"); + my $request = HTTP::Request->new(GET => "${url}/cgi/login?user=${user}&hash=${login_hash}"); $request->header(Cookie => "sid=$sid"); $response = $ua->request($request); die("While trying to login: " . $response->status_line . "\n") unless ($response->is_success); @@ -552,6 +566,7 @@ my $enable_debug = ""; my $save = ""; my $load = ""; my $showstat = 0; +my $gui = 0; my $hostalias; while (defined($ARGV[0])) { @@ -616,6 +631,11 @@ while (defined($ARGV[0])) { shift @ARGV; last SWITCH; }; + /^-G$/ && do { + $gui = 1; + shift @ARGV; + last SWITCH; + }; /^-save$/ && do { shift @ARGV; $save = shift @ARGV; @@ -650,11 +670,12 @@ if (!$valid_arg) { print STDERR "\t-d\t\tpowerdown\n"; print STDERR "\t-c\t\tpowercycle\n"; print STDERR "\t-r\t\treset\n"; - print STDERR "\t-R\t\treset RSB S2 borad\n"; + print STDERR "\t-R\t\treset RSB S2 board\n"; print STDERR "\t-x\t\tshow all properties, variables and settings\n"; print STDERR "\t-l IP\t\tsend SYSLOG debug messages to IP\n"; print STDERR "\t-b\t\tshow board/server status\n"; print STDERR "\t-X\t\tsend raw XML string (start with REQ tag)\n"; + print STDERR "\t-G\t\tstart GUI in appletviewer\n"; print STDERR "\t-v\t\tverbose\n"; print STDERR "\t-save file\tsave configuration to 'file'\n"; print STDERR "\t-load file\tload configuration from 'file'\n"; @@ -667,10 +688,16 @@ if (!$valid_arg) { exit(1); } -$host = ${$Config{$hostalias}}{"host"}; +my $host = ${$Config{$hostalias}}{"host"}; $poweronms = ${$Config{$hostalias}}{"poweronms"} if (defined(${$Config{$hostalias}}{"poweronms"})); $poweroffms = ${$Config{$hostalias}}{"poweroffms"} if (defined(${$Config{$hostalias}}{"poweroffms"})); +$url = "http://${host}"; + +if ($gui) { + spawn_gui($url); +} + $sid = login(${$Config{$hostalias}}{"user"}, ${$Config{$hostalias}}{"pass"}); if ($show) { @@ -697,6 +724,7 @@ if (@sprop) { if (@xmlsend) { foreach my $x (@xmlsend) { + $Data::Dumper::Terse = 1; print Dumper(_req($x)); } } @@ -713,7 +741,7 @@ if ($save ne '') { foreach my $ts (@fw_vars) { next if (grep(/^${ts}$/, @dontsave)); - my $phash = _getprop($ts)->{RESP}->{PROPLIST}->{PROP}; + my $phash = _getprop($ts)->{PROPLIST}->{PROP}; next if ($phash->{PERMS} ne 'RW'); print SAVEFILE "${ts}=".$phash->{VAL}."\n";