#!/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(cookie_jar => {});
my $url;
my $poweronms=200;
my $poweroffms=5000;
my $verbose = 0;
my @fw_vars = qw(ENABLE_LAN_AUTONEG ENABLE_LAN_100 ENABLE_LAN_FDUPLEX GATEWAY
IP_ADDRESS NETMASK TFTP_FIRMWARE_FILE TFTP_ADDR_FIRMWARE ENABLE_DHCP
ENABLE_DNS DNS_SERVER DNS_DOMAIN_NAME
ACCESS_CONTROL_SERVER_1 ACCESS_CONTROL_SERVER_2 ACCESS_CONTROL_SERVERS
ACPI_DISABLE_BIOS_SCAN ACPI_FORCE_RSDP_ADDRESS ACPI_FORCE_RSDT_ADDRESS
ACPI_RSDP_BIOS_ROM_ADDRESS ACPI_SCAN_DELAY_SECONDS AMR_AUTH_METHOD
AMR_DISABLE_PCI AMR_ENABLE_ISCSI_TIMEOUT AMR_ENABLED AMR_HOST_INTERFACE
AMR_SERVER_LIST AMR_USB_FDD_CBI_UFI_TRANSPORT AMR_USB_R2T_TIMEOUT_MSEC
AVR_4BIT_ACTION AVR_4BIT_SAMPLE_TIME AVR_ARCHITECTURE AVR_CHIP_TYPE
AVR_CLIENT_LANGUAGE AVR_DISABLE_SVR_MOUSE_ON_SESSION_START
AVR_KB_VERSION AVR_MAX_SESSION_COUNT AVR_MOUSE_ACCELERATION
AVR_MOUSE_MAX_STEP_SIZE AVR_NUMB_MOUSE_PACKETS
AVR_PCI_PATTERN_HANDS_OFF_ENABLED AVR_PREF_KB_STICKY_KEY_MODE_ON
AVR_PREF_KB_TYPING_MODE_ON AVR_PREF_KB_WARN_UNID_EV
AVR_REGISTERS_BASE_ADDR AVR_RESET_PAUSE AVR_SCREEN_REFRESH
AVR_SUPPORTED_CHIP AVR_TILE_TIMEOUT AVR_VIDEO_MEM_BASE_ADDR BAUDRATE
BAUDRATE_MODEM BAUDRATE_PPP BMC_SUPPORTS_GRACEFULL
BMC_TIMESYNC_INTERVAL CARD_NAME CONSOLE_IPMI_MOUSE_BYTE_TIME
CONSOLE_KEYBOARD_ACCESS_MODE CONSOLE_MOUSE_ACCESS_MODE
CONSOLE_VIDEO_PARAM_MODE CONTACT CONTACT_PHONE CRIT_TEMP_SHUTDOWN
CRIT_VOLT_SHUTDOWN DHCP_ADD_EXTENSION DHCP_ADD_SERIAL
DHCP_CONFIGURE_DNS DHCP_HOSTNAME_EXT DHCP_SERVER DHCP_USE_CARDNAME
DIAG_URL ENABLE_ANON_IPMI ENABLE_ANON_PCI
ENABLE_ANON_WEB ENABLE_AVR_CHIP_DETECT ENABLE_BMC_AUTODETECT
ENABLE_BMC_TIMESYNC ENABLE_CRTC_FETCH ENABLE_DHCP ENABLE_DHCP_HOSTNAME
ENABLE_DS_CONNECTIVITY ENABLE_IO_UART_DECODER ENABLE_LAN_100
ENABLE_LAN_AUTONEG ENABLE_LAN_FDUPLEX ENABLE_MEM_UART_DECODER
ENABLE_PPP ENABLE_REMOTE_FLOPPY_BOOT ENABLE_SELF_DELETE
ENABLE_SERIAL_DBG ETHDRIVER_SID EXPROM_BANNER EXPROM_EBDA_COMPATIBILITY
EXPROM_ENTRY EXPROM_EXIT_DELAY_SEC EXPROM_F3_DELAY_SEC
EXPROM_INT13_COMPATIBILITY EXPROM_SETUP_BANNER FIRMWARE_REVISION
FP_ACDC FP_AMR FP_AVR_ASR FP_AVR_GRAPHIC_CONSOLE FP_AVR_TEXT_CONSOLE
FP_AVRMANCONF_4BIT_SAMPLE FP_AVRMANCONF_ACCESS_MODES FP_AVRMANCONF_CHIP
FP_AVRMANCONF_MOUSE_ACCELERATION FP_AVRMANCONF_MOUSE_TYPE
FP_AVRMANCONF_RESET_PAUSE FP_AVRMANCONF_SCREEN_REFRESH FP_BATTERY
FP_BOARDRESET_BUTTON FP_COMREDIRECT FP_F3_PPP FP_I2C FP_ICMB FP_INSTR
FP_INTERNAL_LAN FP_KEY_CONSOLE FP_LAN_SPEED
FP_LAST_BOARD_POWER_WARNING_ENABLED FP_NO_BLADE_PANEL
FP_NO_CARDCONF_PANEL FP_NO_DIAG_PANEL FP_NO_DSAUTHCONF_PANEL
FP_NO_MANAGE_PANEL FP_NO_MEMORY_PANEL FP_NO_SENSOR_PANEL
FP_NO_SERVERCONF_PANEL FP_NO_SSL_PANEL FP_NO_SYSLOG_PANEL
FP_NO_USERCONF_PANEL FP_PAGING_EMAIL FP_PAGING_SERIAL FP_PAGING_SNMP
FP_PCI_CONFIG FP_PPP FP_PROP_BAUDRATE_REQBOOT FP_PROP_PPP_INIT_REQBOOT
FP_PROP_PS_REQBOOT FP_PROP_TERM_DIRECT_CONNECT_REQBOOT FP_REMOTE_BOOT
FP_REMOTE_DISK FP_REMOTE_POWER FP_SAC_CONSOLE FP_SEL FP_SENSOR_HISTORY
FP_SEQ_SEL FP_SERVER_POWER FP_SERVER_REBOOT FP_SERVER_RESET
FP_SERVER_SHUTDOWN FP_SMM FP_SSL FP_STATUS_DIAG_PANEL
FP_STATUS_MEMORY_PANEL FP_STATUS_PCI_CONFIG FP_STATUS_SAC_CONSOLE
FP_SYSTEM_LAN FP_TEXT_ASR FP_TEXT_CONSOLE FP_TUI FP_VERSION FP_VGA_ASR
FP_VGA_CONSOLE FP_VT100_CONSOLE GATEWAY GATEWAY_MAC
GRATUITOUS_ARP_INTERVAL HELP_LOCATION HIST0_SAMPLE_TIME HIST0_SENSOR_ID
HIST1_SAMPLE_TIME HIST1_SENSOR_ID HIST2_SAMPLE_TIME HIST2_SENSOR_ID
HIST3_SAMPLE_TIME HIST3_SENSOR_ID HTTP_PORT_NUM HTTP_SSL_PORT_NUM
I2C_ADDR_8BIT_CHASSIS_BMC I2C_ADDR_8BIT_MY_BMC I2C_ADDR_8BIT_THIS_CARD
INFOTXT_BPROP_ACCESS INFOTXT_DB_ACCESS IP_ADDRESS IP_ADDRESS_SOURCE
IPMB_RETRY_TIMEOUT IPMB_SEQ_NUM_TIMEOUT IPMB_TX_RETRIES
IPMI_COUNTRY_SELECT IPV4_HEADER_PARAMETERS ISCSI_DEVICE_VENDOR
ISCSI_PRODUCT_EMUL_BD ISCSI_PRODUCT_EMUL_CD ISCSI_PRODUCT_EMUL_FD
LAST_CARD_NAME LAST_ENABLE_DHCP LAST_GATEWAY LAST_IP_ADDRESS
LAST_NETMASK LOCATION MAC_ADDRESS MODEM_CONNECT MODEM_CONNECT2
MODEM_SEPARATOR NETMASK PAGE_RETRIES PAGE_RETRY_DELAY_SEC POST_ERRCODE
POST_PROP PPP_AVAILABLE PPP_INIT PPP_IP_ADDR PPP_NETMASK PPP_PORT
PPP_STATUS PPP_STAY_ALIVE_SECS PPP_WELCOME PPP2_BAUDRATE PPP2_INIT
PPP2_IP_ADDR PPP2_NETMASK PPP2_PORT PPP2_STAY_ALIVE_SECS PRODUCT
PRODUCT_ABBR PS_ASR PS_DISK PS_FAN PS_HARDWARE PS_MEMORY PS_NETWORK
PS_OTHER PS_POST PS_RMC PS_SECURITY PS_SYS_POWER PS_SYS_STATUS
PS_TEMPERATURE PS2_ADAPTER_POWER_UP_MODE PS2_FW_UPDATE_CMD
PS2_FW_UPDATE_IMG_NAME PS2_FW_UPDATE_STATUS RMC_DS_GROUP SAC_PORT
SERVER_CODEPAGE SERVER_HARD_RESET_PULSE_MS SERVER_HARD_RESET_VIA_IPMI
SERVER_ID SERVER_IP SERVER_KEYBOARD SERVER_KEYBOARD_LANGUAGES_LIST
SERVER_MEMORY SERVER_NAME SERVER_POWER_CHANGE_VIA_IPMI
SERVER_POWER_OFF_MODE SERVER_POWER_OFF_PULSE_MS SERVER_POWER_ON_MODE
SERVER_POWER_ON_PULSE_MS SERVER_TIMEZONE SERVER_URL
SESSION_MANAGER_SESSION_TIMEOUT SI_DEF_POLL_INTERVAL_MS
SI_DEF_POLL_OFFSET_MS SMTP_RESP_TIME_SEC SMTP_RETRIES
SMTP_RETRY_DELAY_SEC SMTP_REVERSE_PATH SMTP_SERVER SNMP_AGENT_ENABLED
SNMP_COMMUNITY SNMP_ENTERPRISE_ID SNMP_SERVER SNMP_SERVER_1
SNMP_SERVER_2 SNMP_SERVER_3 SNMP_SERVER_4 SNMP_SERVER_5 SNMP_SERVER_6
SNMP_SERVER_7 SNMP_SERVER_MAC SNMP_SYSOID SNMP_TRAP_MASK
SNMP_TRAP_VERSION SSL_40_OR_128_ENCRYPTION SSL_CAPABLE_FIRMWARE
SSL_ENABLE_ALOG SSL_ENABLE_ALOG_FALLBACK SSL_ENABLE_CLIENT_CERT
SSL_ENABLE_HTTP SSL_ENABLE_HTTPS SSL_ENABLE_NOTIFY
SSL_NOTIFICATION_TIME TELNET_ENABLE TELNET_PORT_NUM
TERMINAL_DIRECT_CONNECT TERMINAL_ENCODING TEXT_CONSOLE_TIMEOUT
TFTP_ADDR_FIRMWARE TFTP_ADDR_REBOOT TFTP_FIRMWARE_FILE TFTP_REBOOT_FILE
TXT_REMOTE_CONSOLE_COLOR_MAP TXT_REMOTE_CONSOLE_FREQ
USB_DEVICE_SETTINGS USE_SERVER_IP_ADDRESS USER_TIMEOUT VENDOR
RMC_AUTODETECT RMC_FUNCTIONS RMC_MODULES AGENT_VERSION BIOS_VER
BOARD_MFT BOARD_MODEL BOARD_PART_NUM BOARD_SERIAL BOARD_VER CAB_MFT
CAB_MODEL CAB_PROD_NUM CAB_PROD_VER CAB_SERIAL CHA_MODEL
CSV_ConfAlarmMailFrom CSV_ConfAlarmMailMessage CSV_ConfAlarmMailSubject
CSV_ConfAlarmMailType CSV_ConfAlarmMailUserInfo0
CSV_ConfAlarmMailUserInfo1 PER_USER_PAGING RMC_SEL_FILTER
SERVER_AD_NAME SERVER_AD_NAME2 SERVER_AD_NAME3 SERVER_AD_NAME4
SERVER_CONTACT SERVER_DESCRIPTION SERVER_IP_ADDRESS SERVER_IP_ADDRESS2
SERVER_IP_ADDRESS3 SERVER_IP_ADDRESS4 SERVER_IP_DHCP SERVER_IP_DHCP2
SERVER_IP_DHCP3 SERVER_IP_DHCP4 SERVER_IP_GATEWAY SERVER_IP_GATEWAY2
SERVER_IP_GATEWAY3 SERVER_IP_GATEWAY4 SERVER_IP_NETMASK
SERVER_IP_NETMASK2 SERVER_IP_NETMASK3 SERVER_IP_NETMASK4
SERVER_LOCATION SERVER_MAC_ADDRESS SERVER_MAC_ADDRESS2
SERVER_MAC_ADDRESS3 SERVER_MAC_ADDRESS4 SERVER_MAX_LAN_ADAPTER
SERVER_OS SERVER_OS_VENDOR);
sub _crc16 {
my $str = shift;
my $crc = 0;
for my $k (0..length($str)-1) {
$crc ^= ord(substr($str, $k, 1)) << 8;
for (0..7) {
$crc = (($crc & 0x8000) == 32768 ? ($crc<<1) ^ 0x1021 : $crc<<1);
}
}
$crc = $crc & 0xFFFF;
return $crc;
}
sub _hash {
my ($password, $challenge) = @_;
my @challenge_bytes = unpack 'c16', decode_base64($challenge);
my @pwd_hash = unpack 'c16', md5($password);
my @xor_bytes;
for my $i (0..15) {
$xor_bytes[$i] = $challenge_bytes[$i] ^ $pwd_hash[$i];
};
my $hash = md5(pack 'c16', @xor_bytes);
my $crc = _crc16($hash);
$hash .= chr($crc & 0xff) . chr($crc >> 8 & 0xff);
return encode_base64($hash, "");
}
sub _req {
my $xml = shift;
$request = HTTP::Request->new(POST => "${url}/cgi/bin");
$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 => '')->{RESP};
}
sub _cmd {
my $cmd = shift;
my $reqstr='';
my $res = _req($reqstr);
if ($res->{RC} ne '0x0') {
print "${cmd} failed: ".$res->{RC}."\n";
undef;
}
$res;
}
sub _getprop {
my $property = shift;
my $reqstr='';
my $resp = _req($reqstr);
print "get: ${property}\n" if ($verbose);
if ($resp->{RC} ne '0x0') {
$resp->{RC};
} else {
$resp;
}
}
sub logout {
print "Logout\n" if ($verbose);
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);
my $xmlin = XMLin($response->decoded_content);
die "Error logging out: ".$xmlin->{RC} if ($xmlin->{RC} ne '0x0');
}
sub setprop {
my $property = shift;
my $value = shift;
my $oldval = _getprop($property)->{PROPLIST}->{PROP}->{VAL};
if ($value eq $oldval) {
print "${property} is already ${value}\n" if ($verbose);
return;
}
my $reqstr=''.$value.'';
my $res = _req($reqstr);
if ($res->{RC} ne '0x0') {
print "Error setting ${property} to ${value}: ".$res->{RC}."\n";
undef;
} else {
print "${property}: ${oldval} -> ${value}\n" if ($verbose);
$oldval;
}
}
sub serveraction {
my $action = shift;
my $pmode = 2;
#setprop("SERVER_HARD_RESET_VIA_IPMI", "FALSE");
#setprop("SERVER_POWER_CHANGE_VIA_IPMI", "FALSE");
#PM Mode
setprop("SERVER_POWER_ON_MODE", sprintf("0x%x", $pmode));
setprop("SERVER_POWER_OFF_MODE", sprintf("0x%x", $pmode));
print "${action}...\n" if ($verbose);
my $reqstr=''.$action.'';
my $res = _req($reqstr);
if ($res->{RC} ne '0x0') {
print "FAILED:".$res->{RC}."\n";
}
}
sub powerup {
if (_getprop("SERVER_POWER_CHANGE_VIA_IPMI")->{PROPLIST}->{PROP}->{VAL} eq "TRUE") {
print "powerup via IPMI\n" if ($verbose);
serveraction("powerup");
} else {
print "powerup via relay (hack)\n" if ($verbose);
setprop("SERVER_POWER_ON_PULSE_MS", sprintf("0x%x", $poweronms));
setprop("SERVER_POWER_OFF_PULSE_MS", "0x0");
serveraction("powercycle");
}
}
sub powerdown {
if (_getprop("SERVER_POWER_CHANGE_VIA_IPMI")->{PROPLIST}->{PROP}->{VAL} eq "TRUE") {
print "powerdown via IPMI\n" if ($verbose);
serveraction("powerdown");
} else {
print "powerdown via relay (hack)\n" if ($verbose);
setprop("SERVER_POWER_ON_PULSE_MS", "0x0");
setprop("SERVER_POWER_OFF_PULSE_MS", sprintf("0x%x", $poweroffms));
serveraction("powercycle");
}
}
sub powercycle {
if (_getprop("SERVER_POWER_CHANGE_VIA_IPMI")->{PROPLIST}->{PROP}->{VAL} eq "TRUE") {
print "powercycle via IPMI\n" if ($verbose);
} else {
print "powercycle via relay\n" if ($verbose);
setprop("SERVER_POWER_ON_PULSE_MS", sprintf("0x%x", $poweronms));
setprop("SERVER_POWER_OFF_PULSE_MS", sprintf("0x%x", $poweroffms));
}
serveraction("powercycle");
}
sub showprop {
my $property = shift;
my $phash = _getprop($property)->{PROPLIST}->{PROP};
print "${property}: " . ${phash}->{VAL} . " (" . ${phash}->{PERMS} . ")\n";
}
sub board_properties {
my $reqstr='';
my $resp = _req($reqstr);
print " * Board Properties:\n";
foreach my $bprop (@{$resp->{BPROPLIST}->{BPROP}}) {
print " * " . ${bprop}->{NAME} . ": " . ${bprop}->{VAL} . "\n";
}
}
sub show_boarddesc {
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";
}
sub show_all_vars {
foreach my $fwvar (@fw_vars) {
showprop($fwvar);
}
}
sub usrlist {
my $res = _cmd("usrlist");
my @users = ();
if ($res->{RC} ne '0x0') {
print "FAILED:".$res->{RC}."\n";
();
} else {
if (ref($res->{USRLIST}->{USER}) eq 'ARRAY') {
foreach my $usr (@{$res->{USRLIST}->{USER}}) {
push @users, $usr->{NAME};
}
} else {
push @users, $res->{USRLIST}->{USER}->{NAME};
}
}
@users;
}
sub getusrprops {
my $usr = shift;
my $reqstr = '';
my $res = _req($reqstr)->{USER}->{PROP};
$res;
}
sub usradd {
my $usr = shift;
my $reqstr='';
my $res = _req($reqstr);
if ($res->{RC} ne '0x0') {
print "FAILED:".$res->{RC}."\n";
}
}
sub setusrprop {
my $usr = shift;
my $property = shift;
my $value = shift;
my $reqstr='';
my $res = _req($reqstr);
my $oldval = ${res}->{USER}->{PROP}->{VAL};
if ($value eq $oldval) {
print "${property} is already ${value}\n" if ($verbose);
return;
}
$reqstr=''.$value.'';
$res = _req($reqstr);
if ($res->{RC} ne '0x0') {
print "Error setting ${property} to ${value}: ".$res->{RC}."\n";
undef;
} else {
print "${property}: ${oldval} -> ${value}\n" if ($verbose);
$oldval;
}
}
sub syslog_debug {
my $destination_ip = shift;
my $bcast = shift;
my $reqstr=''.${destination_ip}.''.${bcast}.'FALSE';
my $res = _req($reqstr);
if ($res->{RC} ne '0x0') {
print "FAILED:".$res->{RC}."\n";
return;
}
$reqstr='TRUE0x10x1FALSE';
$res = _req($reqstr);
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");
my $boardfwstatus = $fw->{STATUS};
my $boardfwprogress = $fw->{PROGRESS};
$bs = hex($boardstatus);
print "Server Power:\t\t" . (($bs & 0x01) ? "ON" : "OFF") . "\n";
print "External PSU:\t\t" . (($bs & 0x02) ? "ON" : "OFF") . "\n";
print "Battery:\t\t";
if ($bs & 0x04) {
if ($bs & 0x08) {
print "LOW\n";
} elsif ($bs & 0x800) {
print "ON\n";
} else {
print "UNKNOWN\n";
}
} else {
print "OFF\n";
}
print "Standby Power:\t\t" . (($bs & 0x08) ? "ON" : "OFF") . "\n";
print "LAN:\t\t\t" . (($bs & 0x10) ? "CONNECTED" : "NC") . "\n";
print "I2C:\t\t\t" . (($bs & 0x20) ? "CONNECTED" : "NC") . "\n";
print "SMM:\t\t\t" . (($bs & 0x40) ? "CONNECTED" : "NC") . "\n";
print "Instrumentation:\t" . (($bs & 0x200) ? "CONNECTED" : "NC") . "\n";
print "ICMB:\t\t\t" . (($bs & 0x400) ? "CONNECTED" : "NC") . "\n";
print "PPP:\t\t\t" . (($bs & 0x10000) ? "ON" : "OFF") . "\n";
print "Paging:\t\t\t" . (($bs & 0x20000) ? "ON" : "OFF") . "\n";
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";
} else {
print "DONE";
}
print " (${boardfwstatus})\n";
if (($fws & 0x8080) || ($fws & 0x80)) {
printf("FW error:\t\t0x%02x\n", ($fws & 0xff));
}
if ($fws != 0) {
print "FW upgrade progress:\t${boardfwprogress}\n";
}
print "\nSensors:\n";
show_sensors();
}
sub spawn_gui {
my $base = shift;
$ENV{'AWT_TOOLKIT'} = 'MToolkit';
open(APPLET,"|appletviewer -J-Djava.security.policy=applet.policy -J-Djava.net.preferIPv4Stack=true /dev/stdin");
print APPLET '
RSB S2 User Interface';
print APPLET '';
print APPLET '';
print APPLET '';
close(APPLET);
}
sub login {
my $user = shift;
my $pass = shift;
my $response = $ua->get("${url}/cgi/challenge");
die $response->status_line if (!($response->is_success));
my $xmlin = XMLin($response->decoded_content);
die "Error getting Challenge: ".$xmlin->{RC} if ($xmlin->{RC} ne '0x0');
my $challenge = $xmlin->{CHALLENGE};
print "Challenge: ${challenge}\n" if ($verbose);
my $sid = $response->headers->header('Set-Cookie');
die "No SessionID!" if (!defined($sid));
chomp($sid);
$sid =~ s/.*sid=(.*);.*/$1/;
print "SID: ${sid}\n" if ($verbose);
my $login_hash = _hash($pass, $challenge);
print "Hash: ${login_hash}\n" if ($verbose);
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');
print "Logged in\n" if ($verbose);
}
sub read_inifile {
my $filename = shift;
open(INIFILE,"<${filename}") || die("can't open config: ${filename}: $!");
my %Ini = ();
my @sections = ();
while() {
chomp;
next if (m/^#/);
if (m/^\s*\[(.*)\]\s*$/) {
push @sections, $1;
next;
}
if (@sections) {
if (m/^\s*([^=]+)\s*=\s*(.*)\s*$/) {
${$Ini{$sections[$#sections]}}{$1} = $2;
}
}
}
close(INIFILE);
%Ini;
}
my %Config = read_inifile("$ENV{HOME}/.rsbs2rc");
my $valid_arg = 0;
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])) {
SWITCH: for ($ARGV[0]) {
/^-v$/ && do {
$verbose = 1;
shift @ARGV;
last SWITCH;
};
/^-g$/ && do {
shift @ARGV;
push @gprop, shift @ARGV;
last SWITCH;
};
/^-s$/ && do {
shift @ARGV;
push @sprop, shift @ARGV;
last SWITCH;
};
/^-u$/ && do {
$powup = 1;
shift @ARGV;
last SWITCH;
};
/^-d$/ && do {
$powdown = 1;
shift @ARGV;
last SWITCH;
};
/^-c$/ && do {
$powcyc = 1;
shift @ARGV;
last SWITCH;
};
/^-r$/ && do {
$reset = 1;
shift @ARGV;
last SWITCH;
};
/^-R$/ && do {
$resetrsbs2 = 1;
shift @ARGV;
last SWITCH;
};
/^-l$/ && do {
shift @ARGV;
$enable_debug = shift @ARGV;
last SWITCH;
};
/^-x$/ && do {
$show = 1;
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;
last SWITCH;
};
/^-load$/ && do {
shift @ARGV;
$load = shift @ARGV;
last SWITCH;
};
if (defined($ARGV[0])) {
$hostalias = $ARGV[0];
shift(@ARGV);
$valid_arg = 1;
}
while ( defined($ARGV[0]) ) { $valid_arg = 0; shift(@ARGV); }
}
}
if ($valid_arg && (!defined($Config{$hostalias}))) {
$valid_arg = 0;
}
if (!$valid_arg) {
print STDERR "Usage: $0 options card-alias\n";
print STDERR "Options:\n";
print STDERR "\t-g property\tget property value\n";
print STDERR "\t-s property=val\tset property value\n";
print STDERR "\t-u\t\tpowerup\n";
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";
print STDERR "\n";
print STDERR "card-alias\tone of: ";
foreach my $alias (keys(%Config)) {
print STDERR "\"${alias}\" ";
}
print STDERR "(see ~/.rsbs2rc)\n";
exit(1);
}
my $host = ${$Config{$hostalias}}{"host"};
$poweronms = ${$Config{$hostalias}}{"poweronms"} if (defined(${$Config{$hostalias}}{"poweronms"}));
$poweroffms = ${$Config{$hostalias}}{"poweroffms"} if (defined(${$Config{$hostalias}}{"poweroffms"}));
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);
exit 0;
}
login(${$Config{$hostalias}}{"user"}, ${$Config{$hostalias}}{"pass"});
if ($show) {
show_boarddesc();
board_properties();
show_all_vars();
}
if (@gprop) {
foreach my $p (@gprop) {
showprop($p);
}
}
if (@sprop) {
foreach my $p (@sprop) {
(my $pr, $v) = split(/=/,$p,2);
my $oldval = setprop($pr, $v);
if (defined($oldval)) {
print "${pr}: ${oldval} -> ${v}\n" if (!$verbose);
}
}
}
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
ENABLE_DHCP MAC_ADDRESS LAST_CARD_NAME LAST_ENABLE_DHCP LAST_GATEWAY
LAST_IP_ADDRESS LAST_NETMASK);
open (SAVEFILE, ">${save}") || die "Error opening save-file: $!\n";
print SAVEFILE "[global]\n";
print STDERR "saving" if (!$verbose);
foreach my $ts (@fw_vars) {
next if (grep(/^${ts}$/, @dontsave));
my $phash = _getprop($ts)->{PROPLIST}->{PROP};
next if ($phash->{PERMS} ne 'RW');
print SAVEFILE "${ts}=".$phash->{VAL}."\n";
print STDERR "." if (!$verbose);
}
foreach my $usr (usrlist()) {
print SAVEFILE "\n[${usr}]\n";
foreach my $up (@{getusrprops($usr)}) {
next if ($up->{PERMS} ne 'RW');
print SAVEFILE $up->{NAME}."=".$up->{VAL}."\n";
}
print STDERR "." if (!$verbose);
}
close(SAVEFILE);
print STDERR "done\n" if (!$verbose);
}
if ($load ne '') {
my %loadfile = read_inifile("${load}");
print STDERR "loading" if (!$verbose);
foreach my $p (keys(%{$loadfile{'global'}})) {
setprop($p, $loadfile{'global'}->{$p});
print STDERR "." if (!$verbose);
}
my @users = usrlist();
foreach my $usr (keys(%loadfile)) {
next if ($usr eq 'global');
if (!grep(/^${usr}$/, @users)) {
print STDERR "\nAdding user \"${usr}\".\n" if ($verbose);
usradd($usr);
}
foreach my $p (keys(%{$loadfile{$usr}})) {
setusrprop($usr, $p, $loadfile{$usr}->{$p});
print STDERR "." if (!$verbose);
}
}
print STDERR "done\n" if (!$verbose);
print "Settings loaded, resetting board...\n";
_cmd("boardreset");
exit(0);
}
if ($enable_debug ne '') {
syslog_debug($enable_debug, "TRUE");
}
if ($reset) {
print "hardreset\n" if ($verbose);
serveraction("hardreset");
}
if ($powup) {
powerup();
}
if ($powdown) {
powerdown();
}
if ($powcyc) {
powercycle();
}
if ($showstat) {
status();
}
if ($resetrsbs2) {
print "Resetting board...\n";
_cmd("boardreset");
exit(0);
}
logout();