]> cvs.zerfleddert.de Git - rsbs2/blame - rsbs2.pl
use of qw() as parentheses is deprecated...
[rsbs2] / rsbs2.pl
CommitLineData
190cff13
MG
1#!/usr/bin/perl -w
2
3use LWP::UserAgent;
0efb50b5 4use LWP::ConnCache;
190cff13
MG
5use XML::Simple;
6use Data::Dumper;
7use MIME::Base64;
8use Digest::MD5 qw(md5);
9
0efb50b5 10my $ua = LWP::UserAgent->new(cookie_jar => {});
3f4d6039 11my $url;
f4d84b07 12my $poweronms=200;
e270bbeb 13my $poweroffms=5000;
5a8d9e2e 14my $verbose = 0;
190cff13 15
874e09fb
MG
16my @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
3d45f4d1 18 ENABLE_DNS DNS_SERVER DNS_DOMAIN_NAME
874e09fb
MG
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
27cd8c11 38 DIAG_URL ENABLE_ANON_IPMI ENABLE_ANON_PCI
874e09fb
MG
39 ENABLE_ANON_WEB ENABLE_AVR_CHIP_DETECT ENABLE_BMC_AUTODETECT
40 ENABLE_BMC_TIMESYNC ENABLE_CRTC_FETCH ENABLE_DHCP ENABLE_DHCP_HOSTNAME
be101700 41 ENABLE_DS_CONNECTIVITY ENABLE_IO_UART_DECODER ENABLE_LAN_100
874e09fb
MG
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
190cff13
MG
119sub _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
132sub _hash {
133 my ($password, $challenge) = @_;
134 my @challenge_bytes = unpack 'c16', decode_base64($challenge);
0efb50b5 135 my @pwd_hash = unpack 'c16', md5($password);
190cff13
MG
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
146sub _req {
147 my $xml = shift;
3f4d6039 148 $request = HTTP::Request->new(POST => "${url}/cgi/bin");
190cff13 149 $request->content_type('application/x-www-form-urlencoded');
762f3898 150 $request->content('<?XML version="1.0"?><?RMCXML version="1.0"?><RMCSEQ>'.$xml.'</RMCSEQ>');
190cff13
MG
151 $response = $ua->request($request);
152 die("Error in request: " . $response->status_line . "\n") unless ($response->is_success);
65d527a7 153 XMLin($response->content, SuppressEmpty => '')->{RESP};
190cff13
MG
154}
155
26d316a4
MG
156sub _cmd {
157 my $cmd = shift;
158
762f3898 159 my $reqstr='<REQ CMD="'.$cmd.'"></REQ>';
26d316a4 160 my $res = _req($reqstr);
65d527a7
MG
161 if ($res->{RC} ne '0x0') {
162 print "${cmd} failed: ".$res->{RC}."\n";
26d316a4
MG
163 undef;
164 }
165
65d527a7 166 $res;
26d316a4
MG
167}
168
190cff13
MG
169sub _getprop {
170 my $property = shift;
171
762f3898 172 my $reqstr='<REQ CMD="propget"><PROPLIST><PROP NAME="'.$property.'"/></PROPLIST></REQ>';
190cff13 173 my $resp = _req($reqstr);
e7ae5b6c
MG
174
175 print "get: ${property}\n" if ($verbose);
190cff13 176
65d527a7
MG
177 if ($resp->{RC} ne '0x0') {
178 $resp->{RC};
190cff13 179 } else {
874e09fb 180 $resp;
190cff13
MG
181 }
182}
183
184sub logout {
5a8d9e2e 185 print "Logout\n" if ($verbose);
3f4d6039 186 my $request = HTTP::Request->new(GET => "${url}/cgi/logout");
190cff13
MG
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
194sub setprop {
195 my $property = shift;
196 my $value = shift;
197
65d527a7 198 my $oldval = _getprop($property)->{PROPLIST}->{PROP}->{VAL};
190cff13
MG
199
200 if ($value eq $oldval) {
5a8d9e2e 201 print "${property} is already ${value}\n" if ($verbose);
190cff13
MG
202 return;
203 }
204
762f3898 205 my $reqstr='<REQ CMD="propset"><PROP NAME="'.$property.'"><VAL>'.$value.'</VAL></PROP></REQ>';
190cff13
MG
206 my $res = _req($reqstr);
207
65d527a7
MG
208 if ($res->{RC} ne '0x0') {
209 print "Error setting ${property} to ${value}: ".$res->{RC}."\n";
75085d94 210 undef;
190cff13 211 } else {
75085d94
MG
212 print "${property}: ${oldval} -> ${value}\n" if ($verbose);
213 $oldval;
190cff13
MG
214 }
215}
216
217sub serveraction {
218 my $action = shift;
219
f4d84b07
MG
220 my $pmode = 2;
221
04040cd0
MG
222 #setprop("SERVER_HARD_RESET_VIA_IPMI", "FALSE");
223 #setprop("SERVER_POWER_CHANGE_VIA_IPMI", "FALSE");
224
f4d84b07
MG
225 #PM Mode
226 setprop("SERVER_POWER_ON_MODE", sprintf("0x%x", $pmode));
227 setprop("SERVER_POWER_OFF_MODE", sprintf("0x%x", $pmode));
228
5a8d9e2e 229 print "${action}...\n" if ($verbose);
762f3898 230 my $reqstr='<REQ CMD="serveraction"><ACT>'.$action.'</ACT></REQ>';
190cff13
MG
231 my $res = _req($reqstr);
232
65d527a7
MG
233 if ($res->{RC} ne '0x0') {
234 print "FAILED:".$res->{RC}."\n";
190cff13
MG
235 }
236}
237
f4d84b07 238sub powerup {
04040cd0
MG
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 }
f4d84b07
MG
248}
249
250sub powerdown {
04040cd0
MG
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 }
f4d84b07
MG
260}
261
262sub powercycle {
04040cd0
MG
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 }
f4d84b07
MG
270 serveraction("powercycle");
271}
272
190cff13
MG
273sub showprop {
274 my $property = shift;
275
65d527a7 276 my $phash = _getprop($property)->{PROPLIST}->{PROP};
874e09fb
MG
277
278 print "${property}: " . ${phash}->{VAL} . " (" . ${phash}->{PERMS} . ")\n";
279}
280
281sub board_properties {
762f3898 282 my $reqstr='<REQ CMD="boardpropget"><PROPLIST><PROP NAME=""/></PROPLIST></REQ>';
874e09fb
MG
283 my $resp = _req($reqstr);
284
285 print " * Board Properties:\n";
65d527a7 286 foreach my $bprop (@{$resp->{BPROPLIST}->{BPROP}}) {
874e09fb
MG
287 print " * " . ${bprop}->{NAME} . ": " . ${bprop}->{VAL} . "\n";
288 }
289}
290
bd1a6723 291sub show_boarddesc {
762f3898 292 my $reqstr='<REQ CMD="boardpropget"><BPROPLIST><BPROP NAME="BOARD_DESCRIPTION"/></BPROPLIST></REQ>';
65d527a7 293 my $boarddesc64 = _req($reqstr)->{BPROPLIST}->{BPROP}->{VAL};
bd1a6723
MG
294 my $boarddesc = decode_base64($boarddesc64);
295 my @board = split(//, $boarddesc);
296 foreach my $byte (@board) {
297 printf ("0x%02x ", ord($byte));
661b5a0e
MG
298 }
299 print "\n";
bd1a6723
MG
300}
301
874e09fb
MG
302sub show_all_vars {
303 foreach my $fwvar (@fw_vars) {
304 showprop($fwvar);
305 }
190cff13
MG
306}
307
d5e3ce21 308sub usrlist {
762f3898 309 my $res = _cmd("usrlist");
d5e3ce21
MG
310 my @users = ();
311
762f3898
MG
312 if ($res->{RC} ne '0x0') {
313 print "FAILED:".$res->{RC}."\n";
d5e3ce21
MG
314 ();
315 } else {
762f3898
MG
316 if (ref($res->{USRLIST}->{USER}) eq 'ARRAY') {
317 foreach my $usr (@{$res->{USRLIST}->{USER}}) {
e7e46551
MG
318 push @users, $usr->{NAME};
319 }
320 } else {
762f3898 321 push @users, $res->{USRLIST}->{USER}->{NAME};
d5e3ce21
MG
322 }
323 }
324 @users;
325}
326
e7e46551
MG
327sub getusrprops {
328 my $usr = shift;
329
762f3898 330 my $reqstr = '<REQ CMD="usrpropget"><USER NAME="'.$usr.'"></USER></REQ>';
65d527a7 331 my $res = _req($reqstr)->{USER}->{PROP};
e7e46551
MG
332
333 $res;
334}
335
336sub usradd {
337 my $usr = shift;
338
762f3898 339 my $reqstr='<REQ CMD="usradd"><USER NAME="'.$usr.'"/></REQ>';
e7e46551 340 my $res = _req($reqstr);
65d527a7
MG
341 if ($res->{RC} ne '0x0') {
342 print "FAILED:".$res->{RC}."\n";
e7e46551
MG
343 }
344}
345
346sub setusrprop {
347 my $usr = shift;
348 my $property = shift;
349 my $value = shift;
350
762f3898 351 my $reqstr='<REQ CMD="usrpropget"><USER NAME="'.$usr.'"><PROP NAME="'.$property.'"></PROP></USER></REQ>';
e7e46551
MG
352 my $res = _req($reqstr);
353
65d527a7 354 my $oldval = ${res}->{USER}->{PROP}->{VAL};
e7e46551
MG
355
356 if ($value eq $oldval) {
357 print "${property} is already ${value}\n" if ($verbose);
358 return;
359 }
360
762f3898 361 $reqstr='<REQ CMD="usrpropset"><USER NAME="'.$usr.'"><PROP NAME="'.$property.'"><VAL>'.$value.'</VAL></PROP></USER></REQ>';
e7e46551
MG
362 $res = _req($reqstr);
363
65d527a7
MG
364 if ($res->{RC} ne '0x0') {
365 print "Error setting ${property} to ${value}: ".$res->{RC}."\n";
e7e46551
MG
366 undef;
367 } else {
368 print "${property}: ${oldval} -> ${value}\n" if ($verbose);
369 $oldval;
370 }
371}
372
99b39951
MG
373sub syslog_debug {
374 my $destination_ip = shift;
375 my $bcast = shift;
376
762f3898 377 my $reqstr='<REQ CMD="dbgmsglancfg"><IP>'.${destination_ip}.'</IP><BCAST>'.${bcast}.'</BCAST><STORE>FALSE</STORE></REQ>';
e7e46551 378 my $res = _req($reqstr);
65d527a7
MG
379 if ($res->{RC} ne '0x0') {
380 print "FAILED:".$res->{RC}."\n";
99b39951
MG
381 return;
382 }
383
762f3898 384 $reqstr='<REQ CMD="dbgmsgcfg"><ON>TRUE</ON><CHANNELMASK>0x1</CHANNELMASK><MMASK>0x1</MMASK><STORE>FALSE</STORE></REQ>';
99b39951 385 $res = _req($reqstr);
65d527a7
MG
386 if ($res->{RC} ne '0x0') {
387 print "FAILED:".$res->{RC}."\n";
99b39951
MG
388 return;
389 }
390
391 print "Debug messages will be sent to ${destination_ip} (broadcast: ${bcast})\n";
392}
393
661b5a0e 394sub get_sensors {
762f3898 395 my $slist= _cmd("sensorlist");
661b5a0e 396 my @sensors;
762f3898
MG
397
398 if ($slist->{RC} ne '0x0') {
399 print "Error getting sensorlist: ".$slist->{RC}."\n";
400 return;
401 }
402
a97855de 403 my $req = '<REQ CMD="sensorpropget"><HANDLE>'.$slist->{HANDLE}.'</HANDLE><SENSORLIST>';
762f3898 404 foreach my $s (@{$slist->{SENSORLIST}->{SENSOR}}) {
661b5a0e
MG
405 $req .= '<SENSOR KEY="'.$s->{KEY}.'"/>';
406 }
407 $req .= '</SENSORLIST></REQ>';
408
409 my $sprop = _req($req);
65d527a7 410 foreach my $s (@{$sprop->{SENSORLIST}->{SENSOR}}) {
661b5a0e
MG
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
423sub show_sensors {
424 my @sensors = get_sensors();
425
426 foreach my $sensor (@sensors) {
06873593 427 print $sensor->{NAME}.": ".$sensor->{VAL}.$sensor->{UNITS};
661b5a0e
MG
428
429 my @info = ();
920420f7 430 foreach my $field (qw(MIN MAX LOW_NON_CRITICAL UPPER_NON_CRITICAL LOW_CRITICAL UPPER_CRITICAL)) {
661b5a0e
MG
431 if ($sensor->{$field} ne '') {
432 push @info, "${field}: ".$sensor->{$field}.$sensor->{UNITS};
433 }
434 }
435
06873593 436 print "\t(".join(", ",@info).")" if (@info);
661b5a0e
MG
437
438 print "\n";
762f3898
MG
439 }
440}
441
26d316a4
MG
442sub 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";
7ef02e76 474 print "Hex BoardStatus:\t${boardstatus}\n";
26d316a4
MG
475 my $fws = hex ($boardfwstatus);
476 print "FW status:\t\t";
477 if ($fws == 3 || $fws == 32771) {
7ef02e76 478 print "WAITING";
26d316a4 479 } else {
7ef02e76 480 print "DONE";
26d316a4 481 }
7ef02e76 482 print " (${boardfwstatus})\n";
26d316a4
MG
483 if (($fws & 0x8080) || ($fws & 0x80)) {
484 printf("FW error:\t\t0x%02x\n", ($fws & 0xff));
485 }
7ef02e76
MG
486 if ($fws != 0) {
487 print "FW upgrade progress:\t${boardfwprogress}\n";
488 }
762f3898 489 print "\nSensors:\n";
661b5a0e 490 show_sensors();
26d316a4
MG
491}
492
3f4d6039
MG
493sub spawn_gui {
494 my $base = shift;
6fb1c808 495 $ENV{'AWT_TOOLKIT'} = 'MToolkit';
fef953cf 496 open(APPLET,"|appletviewer -J-Djava.security.policy=applet.policy -J-Djava.net.preferIPv4Stack=true /dev/stdin");
3f4d6039
MG
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
bd1a6723
MG
508sub login {
509 my $user = shift;
510 my $pass = shift;
511
3f4d6039 512 my $response = $ua->get("${url}/cgi/challenge");
bd1a6723
MG
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};
5a8d9e2e 518 print "Challenge: ${challenge}\n" if ($verbose);
bd1a6723 519
0efb50b5 520 my $sid = $response->headers->header('Set-Cookie');
bd1a6723
MG
521 die "No SessionID!" if (!defined($sid));
522 chomp($sid);
523 $sid =~ s/.*sid=(.*);.*/$1/;
5a8d9e2e 524 print "SID: ${sid}\n" if ($verbose);
bd1a6723
MG
525
526 my $login_hash = _hash($pass, $challenge);
5a8d9e2e 527 print "Hash: ${login_hash}\n" if ($verbose);
bd1a6723 528
3f4d6039 529 my $request = HTTP::Request->new(GET => "${url}/cgi/login?user=${user}&hash=${login_hash}");
bd1a6723
MG
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
0efb50b5 536 print "Logged in\n" if ($verbose);
190cff13 537}
bd1a6723 538
e7e46551
MG
539sub read_inifile {
540 my $filename = shift;
bd1a6723 541
e7e46551
MG
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 }
bd1a6723
MG
559 }
560 }
e7e46551
MG
561 close(INIFILE);
562
563 %Ini;
bd1a6723 564}
e7e46551
MG
565
566my %Config = read_inifile("$ENV{HOME}/.rsbs2rc");
bd1a6723 567
5a8d9e2e
MG
568my $valid_arg = 0;
569my $powup = 0;
570my $powdown = 0;
571my $powcyc = 0;
572my $reset = 0;
3a889507 573my $resetrsbs2 = 0;
5a8d9e2e
MG
574my @sprop = ();
575my @gprop = ();
3a889507 576my @xmlsend = ();
5a8d9e2e
MG
577my $show = 0;
578my $enable_debug = "";
579my $save = "";
580my $load = "";
26d316a4 581my $showstat = 0;
e50748d5 582my $gui = 0;
5a8d9e2e
MG
583my $hostalias;
584
585while (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 };
3a889507
MG
622 /^-R$/ && do {
623 $resetrsbs2 = 1;
624 shift @ARGV;
625 last SWITCH;
626 };
5a8d9e2e
MG
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 };
3a889507
MG
637 /^-X$/ && do {
638 shift @ARGV;
639 push @xmlsend, shift @ARGV;
640 last SWITCH;
641 };
26d316a4
MG
642 /^-b$/ && do {
643 $showstat = 1;
644 shift @ARGV;
645 last SWITCH;
646 };
e50748d5
MG
647 /^-G$/ && do {
648 $gui = 1;
649 shift @ARGV;
650 last SWITCH;
651 };
5a8d9e2e
MG
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}
bd1a6723 672
41ae426b 673if ($valid_arg && (!defined($Config{$hostalias}))) {
5a8d9e2e
MG
674 $valid_arg = 0;
675}
bd1a6723 676
5a8d9e2e
MG
677if (!$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";
a09bedd6 686 print STDERR "\t-R\t\treset RSB S2 board\n";
5a8d9e2e
MG
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";
26d316a4 689 print STDERR "\t-b\t\tshow board/server status\n";
3a889507 690 print STDERR "\t-X\t\tsend raw XML string (start with REQ tag)\n";
e50748d5 691 print STDERR "\t-G\t\tstart GUI in appletviewer\n";
5a8d9e2e
MG
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: ";
e7e46551 697 foreach my $alias (keys(%Config)) {
5a8d9e2e
MG
698 print STDERR "\"${alias}\" ";
699 }
700 print STDERR "(see ~/.rsbs2rc)\n";
701 exit(1);
702}
703
3f4d6039 704my $host = ${$Config{$hostalias}}{"host"};
5a8d9e2e
MG
705$poweronms = ${$Config{$hostalias}}{"poweronms"} if (defined(${$Config{$hostalias}}{"poweronms"}));
706$poweroffms = ${$Config{$hostalias}}{"poweroffms"} if (defined(${$Config{$hostalias}}{"poweroffms"}));
707
fc0c5f31
MG
708my $ssl = ${$Config{$hostalias}}{"ssl"};
709my $port = ${$Config{$hostalias}}{"port"};
710
711if (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}
3f4d6039 720
e50748d5 721if ($gui) {
3f4d6039 722 spawn_gui($url);
e50748d5
MG
723}
724
0efb50b5 725login(${$Config{$hostalias}}{"user"}, ${$Config{$hostalias}}{"pass"});
5a8d9e2e
MG
726
727if ($show) {
728 show_boarddesc();
729 board_properties();
730 show_all_vars();
731}
190cff13 732
5a8d9e2e
MG
733if (@gprop) {
734 foreach my $p (@gprop) {
735 showprop($p);
736 }
737}
874e09fb 738
5a8d9e2e
MG
739if (@sprop) {
740 foreach my $p (@sprop) {
741 (my $pr, $v) = split(/=/,$p,2);
75085d94
MG
742 my $oldval = setprop($pr, $v);
743 if (defined($oldval)) {
744 print "${pr}: ${oldval} -> ${v}\n" if (!$verbose);
745 }
5a8d9e2e
MG
746 }
747}
874e09fb 748
3a889507
MG
749if (@xmlsend) {
750 foreach my $x (@xmlsend) {
65d527a7 751 $Data::Dumper::Terse = 1;
762f3898 752 print Dumper(_req($x));
3a889507
MG
753 }
754}
755
5a8d9e2e 756if ($save ne '') {
be101700
MG
757 my @dontsave = qw(ENABLE_LAN_AUTONEG ENABLE_LAN_100 ENABLE_LAN_FDUPLEX
758 GATEWAY IP_ADDRESS NETMASK TFTP_FIRMWARE_FILE TFTP_ADDR_FIRMWARE
98f1f9af 759 ENABLE_DHCP MAC_ADDRESS LAST_CARD_NAME LAST_ENABLE_DHCP LAST_GATEWAY
be101700 760 LAST_IP_ADDRESS LAST_NETMASK);
e7ae5b6c
MG
761
762 open (SAVEFILE, ">${save}") || die "Error opening save-file: $!\n";
e7e46551 763 print SAVEFILE "[global]\n";
75085d94 764 print STDERR "saving" if (!$verbose);
e7ae5b6c
MG
765 foreach my $ts (@fw_vars) {
766 next if (grep(/^${ts}$/, @dontsave));
767
65d527a7 768 my $phash = _getprop($ts)->{PROPLIST}->{PROP};
e7ae5b6c
MG
769 next if ($phash->{PERMS} ne 'RW');
770
771 print SAVEFILE "${ts}=".$phash->{VAL}."\n";
75085d94 772 print STDERR "." if (!$verbose);
e7ae5b6c 773 }
d5e3ce21 774 foreach my $usr (usrlist()) {
e7e46551
MG
775 print SAVEFILE "\n[${usr}]\n";
776 foreach my $up (@{getusrprops($usr)}) {
777 next if ($up->{PERMS} ne 'RW');
778
779 print SAVEFILE $up->{NAME}."=".$up->{VAL}."\n";
780 }
781 print STDERR "." if (!$verbose);
d5e3ce21 782 }
e7ae5b6c 783 close(SAVEFILE);
75085d94 784 print STDERR "done\n" if (!$verbose);
5a8d9e2e 785}
190cff13 786
5a8d9e2e 787if ($load ne '') {
e7e46551 788 my %loadfile = read_inifile("${load}");
75085d94 789 print STDERR "loading" if (!$verbose);
e7e46551
MG
790
791 foreach my $p (keys(%{$loadfile{'global'}})) {
792 setprop($p, $loadfile{'global'}->{$p});
75085d94 793 print STDERR "." if (!$verbose);
e7ae5b6c 794 }
e7e46551
MG
795
796 my @users = usrlist();
797 foreach my $usr (keys(%loadfile)) {
798 next if ($usr eq 'global');
799 if (!grep(/^${usr}$/, @users)) {
800 print STDERR "\nAdding user \"${usr}\".\n" if ($verbose);
801 usradd($usr);
802 }
803 foreach my $p (keys(%{$loadfile{$usr}})) {
804 setusrprop($usr, $p, $loadfile{$usr}->{$p});
805 print STDERR "." if (!$verbose);
806 }
807 }
75085d94 808 print STDERR "done\n" if (!$verbose);
be101700 809 print "Settings loaded, resetting board...\n";
26d316a4 810 _cmd("boardreset");
be101700 811 exit(0);
5a8d9e2e 812}
99b39951 813
5a8d9e2e
MG
814if ($enable_debug ne '') {
815 syslog_debug($enable_debug, "TRUE");
816}
f4d84b07 817
5a8d9e2e
MG
818if ($reset) {
819 print "hardreset\n" if ($verbose);
820 serveraction("hardreset");
821}
190cff13 822
5a8d9e2e
MG
823if ($powup) {
824 powerup();
825}
190cff13 826
5a8d9e2e
MG
827if ($powdown) {
828 powerdown();
829}
190cff13 830
5a8d9e2e
MG
831if ($powcyc) {
832 powercycle();
833}
190cff13 834
26d316a4
MG
835if ($showstat) {
836 status();
837}
838
3a889507
MG
839if ($resetrsbs2) {
840 print "Resetting board...\n";
841 _cmd("boardreset");
842 exit(0);
843}
844
190cff13 845logout();
Impressum, Datenschutz