cvs.zerfleddert.de Git - rsbs2/blob - rsbs2.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 MIME::Base64;
   8 use Digest::MD5 qw(md5);
   9
  10 my $ua = LWP::UserAgent->new(cookie_jar => {});
  11 my $url;
  12 my $poweronms=200;
  13 my $poweroffms=5000;
  14 my $verbose = 0;
  15
  16 my @fw_vars = qw(ENABLE_LAN_AUTONEG ENABLE_LAN_100 ENABLE_LAN_FDUPLEX GATEWAY
  17         IP_ADDRESS NETMASK TFTP_FIRMWARE_FILE TFTP_ADDR_FIRMWARE ENABLE_DHCP
  18         ENABLE_DNS DNS_SERVER DNS_DOMAIN_NAME
  19         ACCESS_CONTROL_SERVER_1 ACCESS_CONTROL_SERVER_2 ACCESS_CONTROL_SERVERS
  20         ACPI_DISABLE_BIOS_SCAN ACPI_FORCE_RSDP_ADDRESS ACPI_FORCE_RSDT_ADDRESS
  21         ACPI_RSDP_BIOS_ROM_ADDRESS ACPI_SCAN_DELAY_SECONDS AMR_AUTH_METHOD
  22         AMR_DISABLE_PCI AMR_ENABLE_ISCSI_TIMEOUT AMR_ENABLED AMR_HOST_INTERFACE
  23         AMR_SERVER_LIST AMR_USB_FDD_CBI_UFI_TRANSPORT AMR_USB_R2T_TIMEOUT_MSEC
  24         AVR_4BIT_ACTION AVR_4BIT_SAMPLE_TIME AVR_ARCHITECTURE AVR_CHIP_TYPE
  25         AVR_CLIENT_LANGUAGE AVR_DISABLE_SVR_MOUSE_ON_SESSION_START
  26         AVR_KB_VERSION AVR_MAX_SESSION_COUNT AVR_MOUSE_ACCELERATION
  27         AVR_MOUSE_MAX_STEP_SIZE AVR_NUMB_MOUSE_PACKETS
  28         AVR_PCI_PATTERN_HANDS_OFF_ENABLED AVR_PREF_KB_STICKY_KEY_MODE_ON
  29         AVR_PREF_KB_TYPING_MODE_ON AVR_PREF_KB_WARN_UNID_EV
  30         AVR_REGISTERS_BASE_ADDR AVR_RESET_PAUSE AVR_SCREEN_REFRESH
  31         AVR_SUPPORTED_CHIP AVR_TILE_TIMEOUT AVR_VIDEO_MEM_BASE_ADDR BAUDRATE
  32         BAUDRATE_MODEM BAUDRATE_PPP BMC_SUPPORTS_GRACEFULL
  33         BMC_TIMESYNC_INTERVAL CARD_NAME CONSOLE_IPMI_MOUSE_BYTE_TIME
  34         CONSOLE_KEYBOARD_ACCESS_MODE CONSOLE_MOUSE_ACCESS_MODE
  35         CONSOLE_VIDEO_PARAM_MODE CONTACT CONTACT_PHONE CRIT_TEMP_SHUTDOWN
  36         CRIT_VOLT_SHUTDOWN DHCP_ADD_EXTENSION DHCP_ADD_SERIAL
  37         DHCP_CONFIGURE_DNS DHCP_HOSTNAME_EXT DHCP_SERVER DHCP_USE_CARDNAME
  38         DIAG_URL ENABLE_ANON_IPMI ENABLE_ANON_PCI
  39         ENABLE_ANON_WEB ENABLE_AVR_CHIP_DETECT ENABLE_BMC_AUTODETECT
  40         ENABLE_BMC_TIMESYNC ENABLE_CRTC_FETCH ENABLE_DHCP ENABLE_DHCP_HOSTNAME
  41         ENABLE_DS_CONNECTIVITY ENABLE_IO_UART_DECODER ENABLE_LAN_100
  42         ENABLE_LAN_AUTONEG ENABLE_LAN_FDUPLEX ENABLE_MEM_UART_DECODER
  43         ENABLE_PPP ENABLE_REMOTE_FLOPPY_BOOT ENABLE_SELF_DELETE
  44         ENABLE_SERIAL_DBG ETHDRIVER_SID EXPROM_BANNER EXPROM_EBDA_COMPATIBILITY
  45         EXPROM_ENTRY EXPROM_EXIT_DELAY_SEC EXPROM_F3_DELAY_SEC
  46         EXPROM_INT13_COMPATIBILITY EXPROM_SETUP_BANNER FIRMWARE_REVISION
  47         FP_ACDC FP_AMR FP_AVR_ASR FP_AVR_GRAPHIC_CONSOLE FP_AVR_TEXT_CONSOLE
  48         FP_AVRMANCONF_4BIT_SAMPLE FP_AVRMANCONF_ACCESS_MODES FP_AVRMANCONF_CHIP
  49         FP_AVRMANCONF_MOUSE_ACCELERATION FP_AVRMANCONF_MOUSE_TYPE
  50         FP_AVRMANCONF_RESET_PAUSE FP_AVRMANCONF_SCREEN_REFRESH FP_BATTERY
  51         FP_BOARDRESET_BUTTON FP_COMREDIRECT FP_F3_PPP FP_I2C FP_ICMB FP_INSTR
  52         FP_INTERNAL_LAN FP_KEY_CONSOLE FP_LAN_SPEED
  53         FP_LAST_BOARD_POWER_WARNING_ENABLED FP_NO_BLADE_PANEL
  54         FP_NO_CARDCONF_PANEL FP_NO_DIAG_PANEL FP_NO_DSAUTHCONF_PANEL
  55         FP_NO_MANAGE_PANEL FP_NO_MEMORY_PANEL FP_NO_SENSOR_PANEL
  56         FP_NO_SERVERCONF_PANEL FP_NO_SSL_PANEL FP_NO_SYSLOG_PANEL
  57         FP_NO_USERCONF_PANEL FP_PAGING_EMAIL FP_PAGING_SERIAL FP_PAGING_SNMP
  58         FP_PCI_CONFIG FP_PPP FP_PROP_BAUDRATE_REQBOOT FP_PROP_PPP_INIT_REQBOOT
  59         FP_PROP_PS_REQBOOT FP_PROP_TERM_DIRECT_CONNECT_REQBOOT FP_REMOTE_BOOT
  60         FP_REMOTE_DISK FP_REMOTE_POWER FP_SAC_CONSOLE FP_SEL FP_SENSOR_HISTORY
  61         FP_SEQ_SEL FP_SERVER_POWER FP_SERVER_REBOOT FP_SERVER_RESET
  62         FP_SERVER_SHUTDOWN FP_SMM FP_SSL FP_STATUS_DIAG_PANEL
  63         FP_STATUS_MEMORY_PANEL FP_STATUS_PCI_CONFIG FP_STATUS_SAC_CONSOLE
  64         FP_SYSTEM_LAN FP_TEXT_ASR FP_TEXT_CONSOLE FP_TUI FP_VERSION FP_VGA_ASR
  65         FP_VGA_CONSOLE FP_VT100_CONSOLE GATEWAY GATEWAY_MAC
  66         GRATUITOUS_ARP_INTERVAL HELP_LOCATION HIST0_SAMPLE_TIME HIST0_SENSOR_ID
  67         HIST1_SAMPLE_TIME HIST1_SENSOR_ID HIST2_SAMPLE_TIME HIST2_SENSOR_ID
  68         HIST3_SAMPLE_TIME HIST3_SENSOR_ID HTTP_PORT_NUM HTTP_SSL_PORT_NUM
  69         I2C_ADDR_8BIT_CHASSIS_BMC I2C_ADDR_8BIT_MY_BMC I2C_ADDR_8BIT_THIS_CARD
  70         INFOTXT_BPROP_ACCESS INFOTXT_DB_ACCESS IP_ADDRESS IP_ADDRESS_SOURCE
  71         IPMB_RETRY_TIMEOUT IPMB_SEQ_NUM_TIMEOUT IPMB_TX_RETRIES
  72         IPMI_COUNTRY_SELECT IPV4_HEADER_PARAMETERS ISCSI_DEVICE_VENDOR
  73         ISCSI_PRODUCT_EMUL_BD ISCSI_PRODUCT_EMUL_CD ISCSI_PRODUCT_EMUL_FD
  74         LAST_CARD_NAME LAST_ENABLE_DHCP LAST_GATEWAY LAST_IP_ADDRESS
  75         LAST_NETMASK LOCATION MAC_ADDRESS MODEM_CONNECT MODEM_CONNECT2
  76         MODEM_SEPARATOR NETMASK PAGE_RETRIES PAGE_RETRY_DELAY_SEC POST_ERRCODE
  77         POST_PROP PPP_AVAILABLE PPP_INIT PPP_IP_ADDR PPP_NETMASK PPP_PORT
  78         PPP_STATUS PPP_STAY_ALIVE_SECS PPP_WELCOME PPP2_BAUDRATE PPP2_INIT
  79         PPP2_IP_ADDR PPP2_NETMASK PPP2_PORT PPP2_STAY_ALIVE_SECS PRODUCT
  80         PRODUCT_ABBR PS_ASR PS_DISK PS_FAN PS_HARDWARE PS_MEMORY PS_NETWORK
  81         PS_OTHER PS_POST PS_RMC PS_SECURITY PS_SYS_POWER PS_SYS_STATUS
  82         PS_TEMPERATURE PS2_ADAPTER_POWER_UP_MODE PS2_FW_UPDATE_CMD
  83         PS2_FW_UPDATE_IMG_NAME PS2_FW_UPDATE_STATUS RMC_DS_GROUP SAC_PORT
  84         SERVER_CODEPAGE SERVER_HARD_RESET_PULSE_MS SERVER_HARD_RESET_VIA_IPMI
  85         SERVER_ID SERVER_IP SERVER_KEYBOARD SERVER_KEYBOARD_LANGUAGES_LIST
  86         SERVER_MEMORY SERVER_NAME SERVER_POWER_CHANGE_VIA_IPMI
  87         SERVER_POWER_OFF_MODE SERVER_POWER_OFF_PULSE_MS SERVER_POWER_ON_MODE
  88         SERVER_POWER_ON_PULSE_MS SERVER_TIMEZONE SERVER_URL
  89         SESSION_MANAGER_SESSION_TIMEOUT SI_DEF_POLL_INTERVAL_MS
  90         SI_DEF_POLL_OFFSET_MS SMTP_RESP_TIME_SEC SMTP_RETRIES
  91         SMTP_RETRY_DELAY_SEC SMTP_REVERSE_PATH SMTP_SERVER SNMP_AGENT_ENABLED
  92         SNMP_COMMUNITY SNMP_ENTERPRISE_ID SNMP_SERVER SNMP_SERVER_1
  93         SNMP_SERVER_2 SNMP_SERVER_3 SNMP_SERVER_4 SNMP_SERVER_5 SNMP_SERVER_6
  94         SNMP_SERVER_7 SNMP_SERVER_MAC SNMP_SYSOID SNMP_TRAP_MASK
  95         SNMP_TRAP_VERSION SSL_40_OR_128_ENCRYPTION SSL_CAPABLE_FIRMWARE
  96         SSL_ENABLE_ALOG SSL_ENABLE_ALOG_FALLBACK SSL_ENABLE_CLIENT_CERT
  97         SSL_ENABLE_HTTP SSL_ENABLE_HTTPS SSL_ENABLE_NOTIFY
  98         SSL_NOTIFICATION_TIME TELNET_ENABLE TELNET_PORT_NUM
  99         TERMINAL_DIRECT_CONNECT TERMINAL_ENCODING TEXT_CONSOLE_TIMEOUT
 100         TFTP_ADDR_FIRMWARE TFTP_ADDR_REBOOT TFTP_FIRMWARE_FILE TFTP_REBOOT_FILE
 101         TXT_REMOTE_CONSOLE_COLOR_MAP TXT_REMOTE_CONSOLE_FREQ
 102         USB_DEVICE_SETTINGS USE_SERVER_IP_ADDRESS USER_TIMEOUT VENDOR
 103         RMC_AUTODETECT RMC_FUNCTIONS RMC_MODULES AGENT_VERSION BIOS_VER
 104         BOARD_MFT BOARD_MODEL BOARD_PART_NUM BOARD_SERIAL BOARD_VER CAB_MFT
 105         CAB_MODEL CAB_PROD_NUM CAB_PROD_VER CAB_SERIAL CHA_MODEL
 106         CSV_ConfAlarmMailFrom CSV_ConfAlarmMailMessage CSV_ConfAlarmMailSubject
 107         CSV_ConfAlarmMailType CSV_ConfAlarmMailUserInfo0
 108         CSV_ConfAlarmMailUserInfo1 PER_USER_PAGING RMC_SEL_FILTER
 109         SERVER_AD_NAME SERVER_AD_NAME2 SERVER_AD_NAME3 SERVER_AD_NAME4
 110         SERVER_CONTACT SERVER_DESCRIPTION SERVER_IP_ADDRESS SERVER_IP_ADDRESS2
 111         SERVER_IP_ADDRESS3 SERVER_IP_ADDRESS4 SERVER_IP_DHCP SERVER_IP_DHCP2
 112         SERVER_IP_DHCP3 SERVER_IP_DHCP4 SERVER_IP_GATEWAY SERVER_IP_GATEWAY2
 113         SERVER_IP_GATEWAY3 SERVER_IP_GATEWAY4 SERVER_IP_NETMASK
 114         SERVER_IP_NETMASK2 SERVER_IP_NETMASK3 SERVER_IP_NETMASK4
 115         SERVER_LOCATION SERVER_MAC_ADDRESS SERVER_MAC_ADDRESS2
 116         SERVER_MAC_ADDRESS3 SERVER_MAC_ADDRESS4 SERVER_MAX_LAN_ADAPTER
 117         SERVER_OS SERVER_OS_VENDOR);
 118
 119 sub _crc16 {
 120         my $str = shift;
 121         my $crc = 0;
 122         for my $k (0..length($str)-1) {
 123                 $crc ^= ord(substr($str, $k, 1)) << 8;
 124                 for (0..7) {
 125                         $crc = (($crc & 0x8000) == 32768 ? ($crc<<1) ^ 0x1021 : $crc<<1);
 126                 }
 127         }
 128         $crc = $crc & 0xFFFF;
 129         return $crc;
 130 }
 131
 132 sub _hash {
 133         my ($password, $challenge) = @_;
 134         my @challenge_bytes = unpack 'c16', decode_base64($challenge);
 135         my @pwd_hash = unpack 'c16', md5($password);
 136         my @xor_bytes;
 137         for my $i (0..15) {
 138                 $xor_bytes[$i] = $challenge_bytes[$i] ^ $pwd_hash[$i];
 139         };
 140         my $hash = md5(pack 'c16', @xor_bytes);
 141         my $crc = _crc16($hash);
 142         $hash .= chr($crc & 0xff) . chr($crc >> 8 & 0xff);
 143         return encode_base64($hash, "");
 144 }
 145
 146 sub _req {
 147         my $xml = shift;
 148         $request = HTTP::Request->new(POST => "${url}/cgi/bin");
 149         $request->content_type('application/x-www-form-urlencoded');
 150         $request->content('<?XML version="1.0"?><?RMCXML version="1.0"?><RMCSEQ>'.$xml.'</RMCSEQ>');
 151         $response = $ua->request($request);
 152         die("Error in request: " . $response->status_line . "\n") unless ($response->is_success);
 153         XMLin($response->content, SuppressEmpty => '')->{RESP};
 154 }
 155
 156 sub _cmd {
 157         my $cmd = shift;
 158
 159         my $reqstr='<REQ CMD="'.$cmd.'"></REQ>';
 160         my $res = _req($reqstr);
 161         if ($res->{RC} ne '0x0') {
 162                 print "${cmd} failed: ".$res->{RC}."\n";
 163                 undef;
 164         }
 165
 166         $res;
 167 }
 168
 169 sub _getprop {
 170         my $property = shift;
 171
 172         my $reqstr='<REQ CMD="propget"><PROPLIST><PROP NAME="'.$property.'"/></PROPLIST></REQ>';
 173         my $resp = _req($reqstr);
 174
 175         print "get: ${property}\n" if ($verbose);
 176
 177         if ($resp->{RC} ne '0x0') {
 178                 $resp->{RC};
 179         } else {
 180                 $resp;
 181         }
 182 }
 183
 184 sub logout {
 185         print "Logout\n" if ($verbose);
 186         my $request = HTTP::Request->new(GET => "${url}/cgi/logout");
 187         my $response = $ua->request($request);
 188         die("While trying to logout: " . $response->status_line . "\n") unless ($response->is_success);
 189
 190         my $xmlin = XMLin($response->decoded_content);
 191         die "Error logging out: ".$xmlin->{RC} if ($xmlin->{RC} ne '0x0');
 192 }
 193
 194 sub setprop {
 195         my $property = shift;
 196         my $value = shift;
 197
 198         my $oldval = _getprop($property)->{PROPLIST}->{PROP}->{VAL};
 199
 200         if ($value eq $oldval) {
 201                 print "${property} is already ${value}\n" if ($verbose);
 202                 return;
 203         }
 204
 205         my $reqstr='<REQ CMD="propset"><PROP NAME="'.$property.'"><VAL>'.$value.'</VAL></PROP></REQ>';
 206         my $res = _req($reqstr);
 207
 208         if ($res->{RC} ne '0x0') {
 209                 print "Error setting ${property} to ${value}: ".$res->{RC}."\n";
 210                 undef;
 211         } else {
 212                 print "${property}: ${oldval} -> ${value}\n" if ($verbose);
 213                 $oldval;
 214         }
 215 }
 216
 217 sub serveraction {
 218         my $action = shift;
 219
 220         my $pmode = 2;
 221
 222         #setprop("SERVER_HARD_RESET_VIA_IPMI", "FALSE");
 223         #setprop("SERVER_POWER_CHANGE_VIA_IPMI", "FALSE");
 224
 225         #PM Mode
 226         setprop("SERVER_POWER_ON_MODE", sprintf("0x%x", $pmode));
 227         setprop("SERVER_POWER_OFF_MODE", sprintf("0x%x", $pmode));
 228
 229         print "${action}...\n" if ($verbose);
 230         my $reqstr='<REQ CMD="serveraction"><ACT>'.$action.'</ACT></REQ>';
 231         my $res = _req($reqstr);
 232
 233         if ($res->{RC} ne '0x0') {
 234                 print "FAILED:".$res->{RC}."\n";
 235         }
 236 }
 237
 238 sub powerup {
 239         if (_getprop("SERVER_POWER_CHANGE_VIA_IPMI")->{PROPLIST}->{PROP}->{VAL} eq "TRUE") {
 240                 print "powerup via IPMI\n" if ($verbose);
 241                 serveraction("powerup");
 242         } else {
 243                 print "powerup via relay (hack)\n" if ($verbose);
 244                 setprop("SERVER_POWER_ON_PULSE_MS", sprintf("0x%x", $poweronms));
 245                 setprop("SERVER_POWER_OFF_PULSE_MS", "0x0");
 246                 serveraction("powercycle");
 247         }
 248 }
 249
 250 sub powerdown {
 251         if (_getprop("SERVER_POWER_CHANGE_VIA_IPMI")->{PROPLIST}->{PROP}->{VAL} eq "TRUE") {
 252                 print "powerdown via IPMI\n" if ($verbose);
 253                 serveraction("powerdown");
 254         } else {
 255                 print "powerdown via relay (hack)\n" if ($verbose);
 256                 setprop("SERVER_POWER_ON_PULSE_MS", "0x0");
 257                 setprop("SERVER_POWER_OFF_PULSE_MS", sprintf("0x%x", $poweroffms));
 258                 serveraction("powercycle");
 259         }
 260 }
 261
 262 sub powercycle {
 263         if (_getprop("SERVER_POWER_CHANGE_VIA_IPMI")->{PROPLIST}->{PROP}->{VAL} eq "TRUE") {
 264                 print "powercycle via IPMI\n" if ($verbose);
 265         } else {
 266                 print "powercycle via relay\n" if ($verbose);
 267                 setprop("SERVER_POWER_ON_PULSE_MS", sprintf("0x%x", $poweronms));
 268                 setprop("SERVER_POWER_OFF_PULSE_MS", sprintf("0x%x", $poweroffms));
 269         }
 270         serveraction("powercycle");
 271 }
 272
 273 sub showprop {
 274         my $property = shift;
 275
 276         my $phash = _getprop($property)->{PROPLIST}->{PROP};
 277
 278         print "${property}: " . ${phash}->{VAL} . " (" . ${phash}->{PERMS} . ")\n";
 279 }
 280
 281 sub board_properties {
 282         my $reqstr='<REQ CMD="boardpropget"><PROPLIST><PROP NAME=""/></PROPLIST></REQ>';
 283         my $resp = _req($reqstr);
 284
 285         print " * Board Properties:\n";
 286         foreach my $bprop (@{$resp->{BPROPLIST}->{BPROP}}) {
 287                 print " * " . ${bprop}->{NAME} . ": " . ${bprop}->{VAL} . "\n";
 288         }
 289 }
 290
 291 sub show_boarddesc {
 292         my $reqstr='<REQ CMD="boardpropget"><BPROPLIST><BPROP NAME="BOARD_DESCRIPTION"/></BPROPLIST></REQ>';
 293         my $boarddesc64 = _req($reqstr)->{BPROPLIST}->{BPROP}->{VAL};
 294         my $boarddesc = decode_base64($boarddesc64);
 295         my @board = split(//, $boarddesc);
 296         foreach my $byte (@board) {
 297                 printf ("0x%02x ", ord($byte));
 298         }
 299         print "\n";
 300 }
 301
 302 sub show_all_vars {
 303         foreach my $fwvar (@fw_vars) {
 304                 showprop($fwvar);
 305         }
 306 }
 307
 308 sub usrlist {
 309         my $res = _cmd("usrlist");
 310         my @users = ();
 311
 312         if ($res->{RC} ne '0x0') {
 313                 print "FAILED:".$res->{RC}."\n";
 314                 ();
 315         } else {
 316                 if (ref($res->{USRLIST}->{USER}) eq 'ARRAY') {
 317                         foreach my $usr (@{$res->{USRLIST}->{USER}}) {
 318                                 push @users, $usr->{NAME};
 319                         }
 320                 } else {
 321                         push @users, $res->{USRLIST}->{USER}->{NAME};
 322                 }
 323         }
 324         @users;
 325 }
 326
 327 sub getusrprops {
 328         my $usr = shift;
 329
 330         my $reqstr = '<REQ CMD="usrpropget"><USER NAME="'.$usr.'"></USER></REQ>';
 331         my $res = _req($reqstr)->{USER}->{PROP};
 332
 333         $res;
 334 }
 335
 336 sub usradd {
 337         my $usr = shift;
 338
 339         my $reqstr='<REQ CMD="usradd"><USER NAME="'.$usr.'"/></REQ>';
 340         my $res = _req($reqstr);
 341         if ($res->{RC} ne '0x0') {
 342                 print "FAILED:".$res->{RC}."\n";
 343         }
 344 }
 345
 346 sub setusrprop {
 347         my $usr = shift;
 348         my $property = shift;
 349         my $value = shift;
 350
 351         my $reqstr='<REQ CMD="usrpropget"><USER NAME="'.$usr.'"><PROP NAME="'.$property.'"></PROP></USER></REQ>';
 352         my $res = _req($reqstr);
 353
 354         my $oldval = ${res}->{USER}->{PROP}->{VAL};
 355
 356         if ($value eq $oldval) {
 357                 print "${property} is already ${value}\n" if ($verbose);
 358                 return;
 359         }
 360
 361         $reqstr='<REQ CMD="usrpropset"><USER NAME="'.$usr.'"><PROP NAME="'.$property.'"><VAL>'.$value.'</VAL></PROP></USER></REQ>';
 362         $res = _req($reqstr);
 363
 364         if ($res->{RC} ne '0x0') {
 365                 print "Error setting ${property} to ${value}: ".$res->{RC}."\n";
 366                 undef;
 367         } else {
 368                 print "${property}: ${oldval} -> ${value}\n" if ($verbose);
 369                 $oldval;
 370         }
 371 }
 372
 373 sub syslog_debug {
 374         my $destination_ip = shift;
 375         my $bcast = shift;
 376
 377         my $reqstr='<REQ CMD="dbgmsglancfg"><IP>'.${destination_ip}.'</IP><BCAST>'.${bcast}.'</BCAST><STORE>FALSE</STORE></REQ>';
 378         my $res = _req($reqstr);
 379         if ($res->{RC} ne '0x0') {
 380                 print "FAILED:".$res->{RC}."\n";
 381                 return;
 382         }
 383
 384         $reqstr='<REQ CMD="dbgmsgcfg"><ON>TRUE</ON><CHANNELMASK>0x1</CHANNELMASK><MMASK>0x1</MMASK><STORE>FALSE</STORE></REQ>';
 385         $res = _req($reqstr);
 386         if ($res->{RC} ne '0x0') {
 387                 print "FAILED:".$res->{RC}."\n";
 388                 return;
 389         }
 390
 391         print "Debug messages will be sent to ${destination_ip} (broadcast: ${bcast})\n";
 392 }
 393
 394 sub get_sensors {
 395         my $slist= _cmd("sensorlist");
 396         my @sensors;
 397
 398         if ($slist->{RC} ne '0x0') {
 399                 print "Error getting sensorlist: ".$slist->{RC}."\n";
 400                 return;
 401         }
 402
 403         my $req = '<REQ CMD="sensorpropget"><HANDLE>'.$slist->{HANDLE}.'</HANDLE><SENSORLIST>';
 404         foreach my $s (@{$slist->{SENSORLIST}->{SENSOR}}) {
 405                 $req .= '<SENSOR KEY="'.$s->{KEY}.'"/>';
 406         }
 407         $req .= '</SENSORLIST></REQ>';
 408
 409         my $sprop = _req($req);
 410         foreach my $s (@{$sprop->{SENSORLIST}->{SENSOR}}) {
 411                 my $sensor = {};
 412                 foreach my $sp (@{$s->{PROP}}) {
 413                         $sensor->{$sp->{NAME}} = $sp->{VAL};
 414                 }
 415
 416                 next if (!defined($sensor->{NAME}));
 417                 $sensor->{VAL} = '0' if ($sensor->{VAL} eq '');
 418                 push @sensors, $sensor;
 419         }
 420         @sensors;
 421 }
 422
 423 sub show_sensors {
 424         my @sensors = get_sensors();
 425
 426         foreach my $sensor (@sensors) {
 427                 print $sensor->{NAME}.": ".$sensor->{VAL}.$sensor->{UNITS};
 428
 429                 my @info = ();
 430                 foreach my $field (qw(MIN MAX LOW_NON_CRITICAL UPPER_NON_CRITICAL LOW_CRITICAL UPPER_CRITICAL)) {
 431                         if ($sensor->{$field} ne '') {
 432                                 push @info, "${field}: ".$sensor->{$field}.$sensor->{UNITS};
 433                         }
 434                 }
 435
 436                 print "\t(".join(", ",@info).")" if (@info);
 437
 438                 print "\n";
 439         }
 440 }
 441
 442 sub status {
 443         my $boardstatus = _cmd("boardstatus")->{STATUS};
 444         my $fw = _cmd("boardfwstatus");
 445         my $boardfwstatus = $fw->{STATUS};
 446         my $boardfwprogress = $fw->{PROGRESS};
 447         $bs = hex($boardstatus);
 448
 449         print "Server Power:\t\t" . (($bs & 0x01) ? "ON" : "OFF") . "\n";
 450         print "External PSU:\t\t" . (($bs & 0x02) ? "ON" : "OFF") . "\n";
 451         print "Battery:\t\t";
 452         if ($bs & 0x04) {
 453                 if ($bs & 0x08) {
 454                         print "LOW\n";
 455                 } elsif ($bs & 0x800) {
 456                         print "ON\n";
 457                 } else {
 458                         print "UNKNOWN\n";
 459                 }
 460         } else {
 461                 print "OFF\n";
 462         }
 463         print "Standby Power:\t\t" . (($bs & 0x08) ? "ON" : "OFF") . "\n";
 464         print "LAN:\t\t\t" . (($bs & 0x10) ? "CONNECTED" : "NC") . "\n";
 465         print "I2C:\t\t\t" . (($bs & 0x20) ? "CONNECTED" : "NC") . "\n";
 466         print "SMM:\t\t\t" . (($bs & 0x40) ? "CONNECTED" : "NC") . "\n";
 467         print "Instrumentation:\t" . (($bs & 0x200) ? "CONNECTED" : "NC") . "\n";
 468         print "ICMB:\t\t\t" . (($bs & 0x400) ? "CONNECTED" : "NC") . "\n";
 469         print "PPP:\t\t\t" . (($bs & 0x10000) ? "ON" : "OFF") . "\n";
 470         print "Paging:\t\t\t" . (($bs & 0x20000) ? "ON" : "OFF") . "\n";
 471         print "COM redirection:\t" . (($bs & 0x100000) ? "ON" : "OFF") . "\n";
 472         print "UART redirect:\t\t" . (($bs & 0x200000) ? "ON" : "OFF") . "\n";
 473         print "UART redirect pending:\t" . (($bs & 0x400000) ? "TRUE" : "FALSE") . "\n";
 474         print "Hex BoardStatus:\t${boardstatus}\n";
 475         my $fws = hex ($boardfwstatus);
 476         print "FW status:\t\t";
 477         if ($fws == 3 || $fws == 32771) {
 478                 print "WAITING";
 479         } else {
 480                 print "DONE";
 481         }
 482         print " (${boardfwstatus})\n";
 483         if (($fws & 0x8080) || ($fws & 0x80)) {
 484                 printf("FW error:\t\t0x%02x\n", ($fws & 0xff));
 485         }
 486         if ($fws != 0) {
 487                 print "FW upgrade progress:\t${boardfwprogress}\n";
 488         }
 489         print "\nSensors:\n";
 490         show_sensors();
 491 }
 492
 493 sub spawn_gui {
 494         my $base = shift;
 495         $ENV{'AWT_TOOLKIT'} = 'MToolkit';
 496         open(APPLET,"|appletviewer -J-Djava.security.policy=applet.policy -J-Djava.net.preferIPv4Stack=true /dev/stdin");
 497         print APPLET '<HTML><HEAD><TITLE>RSB S2 User Interface</TITLE></HEAD>';
 498         print APPLET '<BODY>';
 499         print APPLET '<object width="640" height="480">';
 500         print APPLET '<param name="code" value="com/agilent/rmc/mgui/RmcUI.class">';
 501         print APPLET '<param name="codebase" value="'.$base.'/">';
 502         print APPLET '<param name="archive" value="gui.jar, msa_shared.jar, msa_shared_comm.jar, msa_shared_oem.jar">';
 503         print APPLET '</object>';
 504         print APPLET '</BODY></HTML>';
 505         close(APPLET);
 506 }
 507
 508 sub login {
 509         my $user = shift;
 510         my $pass = shift;
 511
 512         my $response = $ua->get("${url}/cgi/challenge");
 513         die $response->status_line if (!($response->is_success));
 514
 515         my $xmlin = XMLin($response->decoded_content);
 516         die "Error getting Challenge: ".$xmlin->{RC} if ($xmlin->{RC} ne '0x0');
 517         my $challenge = $xmlin->{CHALLENGE};
 518         print "Challenge: ${challenge}\n" if ($verbose);
 519
 520         my $sid = $response->headers->header('Set-Cookie');
 521         die "No SessionID!" if (!defined($sid));
 522         chomp($sid);
 523         $sid =~ s/.*sid=(.*);.*/$1/;
 524         print "SID: ${sid}\n" if ($verbose);
 525
 526         my $login_hash = _hash($pass, $challenge);
 527         print "Hash: ${login_hash}\n" if ($verbose);
 528
 529         my $request = HTTP::Request->new(GET => "${url}/cgi/login?user=${user}&hash=${login_hash}");
 530         $response = $ua->request($request);
 531         die("While trying to login: " . $response->status_line . "\n") unless ($response->is_success);
 532
 533         $xmlin = XMLin($response->decoded_content);
 534         die "Error logging in: ".$xmlin->{RC} if ($xmlin->{RC} ne '0x0');
 535
 536         print "Logged in\n" if ($verbose);
 537 }
 538
 539 sub read_inifile {
 540         my $filename = shift;
 541
 542         open(INIFILE,"<${filename}") || die("can't open config: ${filename}: $!");
 543         my %Ini = ();
 544         my @sections = ();
 545         while(<INIFILE>) {
 546                 chomp;
 547
 548                 next if (m/^#/);
 549
 550                 if (m/^\s*\[(.*)\]\s*$/) {
 551                         push @sections, $1;
 552                         next;
 553                 }
 554
 555                 if (@sections) {
 556                         if (m/^\s*([^=]+)\s*=\s*(.*)\s*$/) {
 557                                 ${$Ini{$sections[$#sections]}}{$1} = $2;
 558                         }
 559                 }
 560         }
 561         close(INIFILE);
 562
 563         %Ini;
 564 }
 565
 566 my %Config = read_inifile("$ENV{HOME}/.rsbs2rc");
 567
 568 my $valid_arg = 0;
 569 my $powup = 0;
 570 my $powdown = 0;
 571 my $powcyc = 0;
 572 my $reset = 0;
 573 my $resetrsbs2 = 0;
 574 my @sprop = ();
 575 my @gprop = ();
 576 my @xmlsend = ();
 577 my $show = 0;
 578 my $enable_debug = "";
 579 my $save = "";
 580 my $load = "";
 581 my $showstat = 0;
 582 my $gui = 0;
 583 my $hostalias;
 584
 585 while (defined($ARGV[0])) {
 586         SWITCH: for ($ARGV[0]) {
 587                 /^-v$/  && do {
 588                                 $verbose = 1;
 589                                 shift @ARGV;
 590                                 last SWITCH;
 591                         };
 592                 /^-g$/ && do {
 593                                 shift @ARGV;
 594                                 push @gprop, shift @ARGV;
 595                                 last SWITCH;
 596                         };
 597                 /^-s$/ && do {
 598                                 shift @ARGV;
 599                                 push @sprop, shift @ARGV;
 600                                 last SWITCH;
 601                         };
 602                 /^-u$/ && do {
 603                                 $powup = 1;
 604                                 shift @ARGV;
 605                                 last SWITCH;
 606                         };
 607                 /^-d$/ && do {
 608                                 $powdown = 1;
 609                                 shift @ARGV;
 610                                 last SWITCH;
 611                         };
 612                 /^-c$/ && do {
 613                                 $powcyc = 1;
 614                                 shift @ARGV;
 615                                 last SWITCH;
 616                         };
 617                 /^-r$/ && do {
 618                                 $reset = 1;
 619                                 shift @ARGV;
 620                                 last SWITCH;
 621                         };
 622                 /^-R$/ && do {
 623                                 $resetrsbs2 = 1;
 624                                 shift @ARGV;
 625                                 last SWITCH;
 626                         };
 627                 /^-l$/ && do {
 628                                 shift @ARGV;
 629                                 $enable_debug = shift @ARGV;
 630                                 last SWITCH;
 631                         };
 632                 /^-x$/ && do {
 633                                 $show = 1;
 634                                 shift @ARGV;
 635                                 last SWITCH;
 636                         };
 637                 /^-X$/ && do {
 638                                 shift @ARGV;
 639                                 push @xmlsend, shift @ARGV;
 640                                 last SWITCH;
 641                         };
 642                 /^-b$/ && do {
 643                                 $showstat = 1;
 644                                 shift @ARGV;
 645                                 last SWITCH;
 646                         };
 647                 /^-G$/ && do {
 648                                 $gui = 1;
 649                                 shift @ARGV;
 650                                 last SWITCH;
 651                         };
 652                 /^-save$/ && do {
 653                                 shift @ARGV;
 654                                 $save = shift @ARGV;
 655                                 last SWITCH;
 656                         };
 657                 /^-load$/ && do {
 658                                 shift @ARGV;
 659                                 $load = shift @ARGV;
 660                                 last SWITCH;
 661                         };
 662
 663                 if (defined($ARGV[0])) {
 664                         $hostalias = $ARGV[0];
 665                         shift(@ARGV);
 666                         $valid_arg = 1;
 667                 }
 668
 669                 while ( defined($ARGV[0]) ) { $valid_arg = 0; shift(@ARGV); }
 670         }
 671 }
 672
 673 if ($valid_arg && (!defined($Config{$hostalias}))) {
 674         $valid_arg = 0;
 675 }
 676
 677 if (!$valid_arg) {
 678         print STDERR "Usage: $0 options card-alias\n";
 679         print STDERR "Options:\n";
 680         print STDERR "\t-g property\tget property value\n";
 681         print STDERR "\t-s property=val\tset property value\n";
 682         print STDERR "\t-u\t\tpowerup\n";
 683         print STDERR "\t-d\t\tpowerdown\n";
 684         print STDERR "\t-c\t\tpowercycle\n";
 685         print STDERR "\t-r\t\treset\n";
 686         print STDERR "\t-R\t\treset RSB S2 board\n";
 687         print STDERR "\t-x\t\tshow all properties, variables and settings\n";
 688         print STDERR "\t-l IP\t\tsend SYSLOG debug messages to IP\n";
 689         print STDERR "\t-b\t\tshow board/server status\n";
 690         print STDERR "\t-X\t\tsend raw XML string (start with REQ tag)\n";
 691         print STDERR "\t-G\t\tstart GUI in appletviewer\n";
 692         print STDERR "\t-v\t\tverbose\n";
 693         print STDERR "\t-save file\tsave configuration to 'file'\n";
 694         print STDERR "\t-load file\tload configuration from 'file'\n";
 695         print STDERR "\n";
 696         print STDERR "card-alias\tone of: ";
 697         foreach my $alias (keys(%Config)) {
 698                 print STDERR "\"${alias}\" ";
 699         }
 700         print STDERR "(see ~/.rsbs2rc)\n";
 701         exit(1);
 702 }
 703
 704 my $host = ${$Config{$hostalias}}{"host"};
 705 $poweronms = ${$Config{$hostalias}}{"poweronms"} if (defined(${$Config{$hostalias}}{"poweronms"}));
 706 $poweroffms = ${$Config{$hostalias}}{"poweroffms"} if (defined(${$Config{$hostalias}}{"poweroffms"}));
 707
 708 my $ssl = ${$Config{$hostalias}}{"ssl"};
 709 my $port = ${$Config{$hostalias}}{"port"};
 710
 711 if (defined($ssl) && (lc($ssl) eq 'yes')) {
 712         $ENV{HTTPS_DEBUG} = 1;
 713         $ENV{HTTPS_VERSION} = 3;
 714         $port = 443 if (!defined($port));
 715         $url = "https://${host}:${port}";
 716 } else {
 717         $port = 80 if (!defined($port));
 718         $url = "http://${host}:${port}";
 719 }
 720
 721 if ($gui) {
 722         spawn_gui($url);
 723         exit 0;
 724 }
 725
 726 login(${$Config{$hostalias}}{"user"}, ${$Config{$hostalias}}{"pass"});
 727
 728 if ($show) {
 729         show_boarddesc();
 730         board_properties();
 731         show_all_vars();
 732 }
 733
 734 if (@gprop) {
 735         foreach my $p (@gprop) {
 736                 showprop($p);
 737         }
 738 }
 739
 740 if (@sprop) {
 741         foreach my $p (@sprop) {
 742                 (my $pr, $v) = split(/=/,$p,2);
 743                 my $oldval = setprop($pr, $v);
 744                 if (defined($oldval)) {
 745                         print "${pr}: ${oldval} -> ${v}\n" if (!$verbose);
 746                 }
 747         }
 748 }
 749
 750 if (@xmlsend) {
 751         foreach my $x (@xmlsend) {
 752                 $Data::Dumper::Terse = 1;
 753                 print Dumper(_req($x));
 754         }
 755 }
 756
 757 if ($save ne '') {
 758         my @dontsave = qw(ENABLE_LAN_AUTONEG ENABLE_LAN_100 ENABLE_LAN_FDUPLEX
 759         GATEWAY IP_ADDRESS NETMASK TFTP_FIRMWARE_FILE TFTP_ADDR_FIRMWARE
 760         ENABLE_DHCP MAC_ADDRESS LAST_CARD_NAME LAST_ENABLE_DHCP LAST_GATEWAY
 761         LAST_IP_ADDRESS LAST_NETMASK);
 762
 763         open (SAVEFILE, ">${save}") || die "Error opening save-file: $!\n";
 764         print SAVEFILE "[global]\n";
 765         print STDERR "saving" if (!$verbose);
 766         foreach my $ts (@fw_vars) {
 767                 next if (grep(/^${ts}$/, @dontsave));
 768
 769                 my $phash = _getprop($ts)->{PROPLIST}->{PROP};
 770                 next if ($phash->{PERMS} ne 'RW');
 771
 772                 print SAVEFILE "${ts}=".$phash->{VAL}."\n";
 773                 print STDERR "." if (!$verbose);
 774         }
 775         foreach my $usr (usrlist()) {
 776                 print SAVEFILE "\n[${usr}]\n";
 777                 foreach my $up (@{getusrprops($usr)}) {
 778                         next if ($up->{PERMS} ne 'RW');
 779
 780                         print SAVEFILE $up->{NAME}."=".$up->{VAL}."\n";
 781                 }
 782                 print STDERR "." if (!$verbose);
 783         }
 784         close(SAVEFILE);
 785         print STDERR "done\n" if (!$verbose);
 786 }
 787
 788 if ($load ne '') {
 789         my %loadfile = read_inifile("${load}");
 790         print STDERR "loading" if (!$verbose);
 791
 792         foreach my $p (keys(%{$loadfile{'global'}})) {
 793                 setprop($p, $loadfile{'global'}->{$p});
 794                 print STDERR "." if (!$verbose);
 795         }
 796
 797         my @users = usrlist();
 798         foreach my $usr (keys(%loadfile)) {
 799                 next if ($usr eq 'global');
 800                 if (!grep(/^${usr}$/, @users)) {
 801                         print STDERR "\nAdding user \"${usr}\".\n" if ($verbose);
 802                         usradd($usr);
 803                 }
 804                 foreach my $p (keys(%{$loadfile{$usr}})) {
 805                         setusrprop($usr, $p, $loadfile{$usr}->{$p});
 806                         print STDERR "." if (!$verbose);
 807                 }
 808         }
 809         print STDERR "done\n" if (!$verbose);
 810         print "Settings loaded, resetting board...\n";
 811         _cmd("boardreset");
 812         exit(0);
 813 }
 814
 815 if ($enable_debug ne '') {
 816         syslog_debug($enable_debug, "TRUE");
 817 }
 818
 819 if ($reset) {
 820         print "hardreset\n" if ($verbose);
 821         serveraction("hardreset");
 822 }
 823
 824 if ($powup) {
 825         powerup();
 826 }
 827
 828 if ($powdown) {
 829         powerdown();
 830 }
 831
 832 if ($powcyc) {
 833         powercycle();
 834 }
 835
 836 if ($showstat) {
 837         status();
 838 }
 839
 840 if ($resetrsbs2) {
 841         print "Resetting board...\n";
 842         _cmd("boardreset");
 843         exit(0);
 844 }
 845
 846 logout();