X-Git-Url: https://git.zerfleddert.de/cgi-bin/gitweb.cgi/rsbs2/blobdiff_plain/26d316a4420ace66c761458a99f1dc193ac191db..62b8ccf01ff22fb623731a04949c5f174dbcd0e6:/rsbs2.pl diff --git a/rsbs2.pl b/rsbs2.pl index 0d2a682..022a949 100755 --- a/rsbs2.pl +++ b/rsbs2.pl @@ -1,14 +1,14 @@ #!/usr/bin/perl -w use LWP::UserAgent; +use LWP::ConnCache; use XML::Simple; use Data::Dumper; use MIME::Base64; use Digest::MD5 qw(md5); -my $ua = LWP::UserAgent->new; -my $sid; -my $host; +my $ua = LWP::UserAgent->new(cookie_jar => {}); +my $url; my $poweronms=200; my $poweroffms=5000; my $verbose = 0; @@ -132,7 +132,7 @@ sub _crc16 { sub _hash { my ($password, $challenge) = @_; my @challenge_bytes = unpack 'c16', decode_base64($challenge); - my @pwd_hash = unpack 'c16', md5($password); + my @pwd_hash = unpack 'c16', md5($password); my @xor_bytes; for my $i (0..15) { $xor_bytes[$i] = $challenge_bytes[$i] ^ $pwd_hash[$i]; @@ -145,38 +145,37 @@ sub _hash { sub _req { my $xml = shift; - $request = HTTP::Request->new(POST => "http://${host}/cgi/bin"); - $request->header(Cookie => "sid=$sid"); + $request = HTTP::Request->new(POST => "${url}/cgi/bin"); $request->content_type('application/x-www-form-urlencoded'); - $request->content($xml); + $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 { my $cmd = shift; - my $reqstr=''; + 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 { my $property = shift; - my $reqstr=''; + my $reqstr=''; my $resp = _req($reqstr); 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,8 +183,7 @@ sub _getprop { sub logout { print "Logout\n" if ($verbose); - my $request = HTTP::Request->new(GET => "http://${host}/cgi/logout"); - $request->header(Cookie => "sid=$sid"); + my $request = HTTP::Request->new(GET => "${url}/cgi/logout"); my $response = $ua->request($request); die("While trying to logout: " . $response->status_line . "\n") unless ($response->is_success); @@ -197,18 +195,18 @@ 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); return; } - my $reqstr=''.$value.''; + 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); @@ -228,11 +226,11 @@ sub serveraction { setprop("SERVER_POWER_OFF_MODE", sprintf("0x%x", $pmode)); print "${action}...\n" if ($verbose); - my $reqstr=''.$action.''; + 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,30 +258,30 @@ 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"; } sub board_properties { - my $reqstr=''; + my $reqstr=''; 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 $reqstr=''; + my $boarddesc64 = _req($reqstr)->{BPROPLIST}->{BPROP}->{VAL}; my $boarddesc = decode_base64($boarddesc64); my @board = split(//, $boarddesc); foreach my $byte (@board) { printf ("0x%02x ", ord($byte)); -} -print "\n"; + } + print "\n"; } sub show_all_vars { @@ -293,20 +291,19 @@ sub show_all_vars { } sub usrlist { - my $reqstr = ''; - my $res = _req($reqstr); + my $res = _cmd("usrlist"); my @users = (); - if ($res->{RESP}->{RC} ne '0x0') { - print "FAILED:".$res->{RESP}->{RC}."\n"; + if ($res->{RC} ne '0x0') { + print "FAILED:".$res->{RC}."\n"; (); } else { - if (ref($res->{RESP}->{USRLIST}->{USER}) eq 'ARRAY') { - foreach my $usr (@{$res->{RESP}->{USRLIST}->{USER}}) { + if (ref($res->{USRLIST}->{USER}) eq 'ARRAY') { + foreach my $usr (@{$res->{USRLIST}->{USER}}) { push @users, $usr->{NAME}; } } else { - push @users, $res->{RESP}->{USRLIST}->{USER}->{NAME}; + push @users, $res->{USRLIST}->{USER}->{NAME}; } } @users; @@ -315,8 +312,8 @@ sub usrlist { sub getusrprops { my $usr = shift; - my $reqstr = ''; - my $res = _req($reqstr)->{RESP}->{USER}->{PROP}; + my $reqstr = ''; + my $res = _req($reqstr)->{USER}->{PROP}; $res; } @@ -324,10 +321,10 @@ sub getusrprops { sub usradd { my $usr = shift; - my $reqstr=''; + 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"; } } @@ -336,21 +333,21 @@ sub setusrprop { my $property = shift; my $value = shift; - my $reqstr=''; + 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); return; } - $reqstr=''.$value.''; + $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); @@ -362,23 +359,71 @@ sub syslog_debug { my $destination_ip = shift; my $bcast = shift; - my $reqstr=''.${destination_ip}.''.${bcast}.'FALSE'; + 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'; + $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; } print "Debug messages will be sent to ${destination_ip} (broadcast: ${bcast})\n"; } +sub get_sensors { + my $slist= _cmd("sensorlist"); + my @sensors; + + if ($slist->{RC} ne '0x0') { + print "Error getting sensorlist: ".$slist->{RC}."\n"; + return; + } + + my $req = ''.$slist->{HANDLE}.''; + foreach my $s (@{$slist->{SENSORLIST}->{SENSOR}}) { + $req .= ''; + } + $req .= ''; + + my $sprop = _req($req); + foreach my $s (@{$sprop->{SENSORLIST}->{SENSOR}}) { + my $sensor = {}; + foreach my $sp (@{$s->{PROP}}) { + $sensor->{$sp->{NAME}} = $sp->{VAL}; + } + + next if (!defined($sensor->{NAME})); + $sensor->{VAL} = '0' if ($sensor->{VAL} eq ''); + push @sensors, $sensor; + } + @sensors; +} + +sub show_sensors { + my @sensors = get_sensors(); + + foreach my $sensor (@sensors) { + print $sensor->{NAME}.": ".$sensor->{VAL}.$sensor->{UNITS}; + + my @info = (); + foreach my $field qw(MIN MAX LOW_NON_CRITICAL UPPER_NON_CRITICAL LOW_CRITICAL UPPER_CRITICAL) { + if ($sensor->{$field} ne '') { + push @info, "${field}: ".$sensor->{$field}.$sensor->{UNITS}; + } + } + + print "\t(".join(", ",@info).")" if (@info); + + print "\n"; + } +} + sub status { my $boardstatus = _cmd("boardstatus")->{STATUS}; my $fw = _cmd("boardfwstatus"); @@ -411,26 +456,44 @@ sub status { print "COM redirection:\t" . (($bs & 0x100000) ? "ON" : "OFF") . "\n"; print "UART redirect:\t\t" . (($bs & 0x200000) ? "ON" : "OFF") . "\n"; print "UART redirect pending:\t" . (($bs & 0x400000) ? "TRUE" : "FALSE") . "\n"; + print "Hex BoardStatus:\t${boardstatus}\n"; my $fws = hex ($boardfwstatus); print "FW status:\t\t"; if ($fws == 3 || $fws == 32771) { - print "WAITING\n"; + print "WAITING"; } else { - print "DONE\n"; + print "DONE"; } + print " (${boardfwstatus})\n"; if (($fws & 0x8080) || ($fws & 0x80)) { printf("FW error:\t\t0x%02x\n", ($fws & 0xff)); } - print "boardstatus:\t\t${boardstatus}\n"; - print "boardfwstatus:\t\t${boardfwstatus}\n"; - print "fw upgrade progress:\t${boardfwprogress}\n"; + if ($fws != 0) { + print "FW upgrade progress:\t${boardfwprogress}\n"; + } + print "\nSensors:\n"; + 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); @@ -438,7 +501,7 @@ sub login { my $challenge = $xmlin->{CHALLENGE}; print "Challenge: ${challenge}\n" if ($verbose); - $sid = $response->headers->header('Set-Cookie'); + my $sid = $response->headers->header('Set-Cookie'); die "No SessionID!" if (!defined($sid)); chomp($sid); $sid =~ s/.*sid=(.*);.*/$1/; @@ -447,15 +510,14 @@ 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}"); - $request->header(Cookie => "sid=$sid"); + my $request = HTTP::Request->new(GET => "${url}/cgi/login?user=${user}&hash=${login_hash}"); $response = $ua->request($request); die("While trying to login: " . $response->status_line . "\n") unless ($response->is_success); $xmlin = XMLin($response->decoded_content); die "Error logging in: ".$xmlin->{RC} if ($xmlin->{RC} ne '0x0'); - $sid; + print "Logged in\n" if ($verbose); } sub read_inifile { @@ -492,13 +554,16 @@ my $powup = 0; my $powdown = 0; my $powcyc = 0; my $reset = 0; +my $resetrsbs2 = 0; my @sprop = (); my @gprop = (); +my @xmlsend = (); my $show = 0; my $enable_debug = ""; my $save = ""; my $load = ""; my $showstat = 0; +my $gui = 0; my $hostalias; while (defined($ARGV[0])) { @@ -538,6 +603,11 @@ while (defined($ARGV[0])) { shift @ARGV; last SWITCH; }; + /^-R$/ && do { + $resetrsbs2 = 1; + shift @ARGV; + last SWITCH; + }; /^-l$/ && do { shift @ARGV; $enable_debug = shift @ARGV; @@ -548,11 +618,21 @@ while (defined($ARGV[0])) { shift @ARGV; last SWITCH; }; + /^-X$/ && do { + shift @ARGV; + push @xmlsend, shift @ARGV; + last SWITCH; + }; /^-b$/ && do { $showstat = 1; shift @ARGV; last SWITCH; }; + /^-G$/ && do { + $gui = 1; + shift @ARGV; + last SWITCH; + }; /^-save$/ && do { shift @ARGV; $save = shift @ARGV; @@ -587,9 +667,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 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"; @@ -602,11 +685,28 @@ 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"})); -$sid = login(${$Config{$hostalias}}{"user"}, ${$Config{$hostalias}}{"pass"}); +my $ssl = ${$Config{$hostalias}}{"ssl"}; +my $port = ${$Config{$hostalias}}{"port"}; + +if (defined($ssl) && (lc($ssl) eq 'yes')) { + $ENV{HTTPS_DEBUG} = 1; + $ENV{HTTPS_VERSION} = 3; + $port = 443 if (!defined($port)); + $url = "https://${host}:${port}"; +} else { + $port = 80 if (!defined($port)); + $url = "http://${host}:${port}"; +} + +if ($gui) { + spawn_gui($url); +} + +login(${$Config{$hostalias}}{"user"}, ${$Config{$hostalias}}{"pass"}); if ($show) { show_boarddesc(); @@ -630,6 +730,13 @@ if (@sprop) { } } +if (@xmlsend) { + foreach my $x (@xmlsend) { + $Data::Dumper::Terse = 1; + print Dumper(_req($x)); + } +} + if ($save ne '') { my @dontsave = qw(ENABLE_LAN_AUTONEG ENABLE_LAN_100 ENABLE_LAN_FDUPLEX GATEWAY IP_ADDRESS NETMASK TFTP_FIRMWARE_FILE TFTP_ADDR_FIRMWARE @@ -642,7 +749,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"; @@ -713,4 +820,10 @@ if ($showstat) { status(); } +if ($resetrsbs2) { + print "Resetting board...\n"; + _cmd("boardreset"); + exit(0); +} + logout();