1package Net::ILO; 2 3use strict; 4use warnings; 5 6use Carp; 7use Data::Dumper; 8use English qw(-no_match_vars); 9use IO::Socket::SSL; 10use XML::Simple; 11 12our $VERSION = '0.54'; 13 14 15my $METHOD_UNSUPPORTED = 'Method not supported by this iLO version'; 16 17 18sub address { 19 20 my $self = shift; 21 22 if (@_) { 23 $self->{address} = shift; 24 } 25 26 return $self->{address}; 27 28} 29 30 31sub add_user { 32 33 my $self = shift; 34 35 if (@_) { 36 37 my $arg_ref = shift; 38 39 my $user_name = $arg_ref->{name} or croak 'name required'; 40 my $user_login = $arg_ref->{username} or croak 'username required'; 41 my $user_password = $arg_ref->{password} or croak 'password required'; 42 43 my $user_admin = $arg_ref->{admin} || 'No'; 44 my $user_can_remote = $arg_ref->{remote_console_privilege} || 'No'; 45 my $user_can_reset = $arg_ref->{reset_privilege} || 'No'; 46 my $user_can_virtual = $arg_ref->{virtual_media_privilege} || 'No'; 47 my $user_can_config = $arg_ref->{config_ilo_privilege} || 'No'; 48 my $user_can_view_logs = $arg_ref->{view_logs_privilege} || 'No'; 49 my $user_can_clear_logs = $arg_ref->{clear_logs_privilege} || 'No'; 50 my $user_can_update = $arg_ref->{update_ilo_privilege} || 'No'; 51 52 my $ilo_command = qq| 53 <USER_INFO MODE="write"> 54 <ADD_USER USER_NAME="$user_name" USER_LOGIN="$user_login" PASSWORD="$user_password"> 55 <ADMIN_PRIV value="$user_admin"/> 56 <REMOTE_CONS_PRIV value="$user_can_remote"/> 57 <RESET_SERVER_PRIV value="$user_can_reset"/> 58 <VIRTUAL_MEDIA_PRIV value="$user_can_virtual"/> 59 <CONFIG_ILO_PRIV value="$user_can_config"/> 60 <VIEW_LOGS_PRIV value="$user_can_view_logs"/> 61 <CLEAR_LOGS_PRIV value="$user_can_clear_logs"/> 62 <UPDATE_ILO_PRIV value="$user_can_update"/> 63 </ADD_USER> 64 </USER_INFO> 65 |; 66 67 $ilo_command = $self->_wrap($ilo_command); 68 my $response = $self->_send($ilo_command) or return; 69 my $xml = $self->_serialize($response) or return; 70 71 if ( my $errmsg = _check_errors($xml) ) { 72 $self->error($errmsg); 73 return; 74 } 75 76 } 77 else { 78 79 croak 'add_user() requires parameters'; 80 81 } 82 83 return 1; 84 85} 86 87 88sub biosdate { 89 90 my $self = shift; 91 92 if (!$self->{biosdate}) { 93 $self->_populate_host_data or return; 94 } 95 96 return $self->{biosdate}; 97 98} 99 100 101sub cpus { 102 103 my $self = shift; 104 105 if (!$self->{cpus}) { 106 $self->_populate_host_data or return; 107 } 108 109 return $self->{cpus}; 110 111} 112 113 114sub del_user { 115 116 my $self = shift; 117 118 if (@_) { 119 120 my $user_login = shift; 121 122 my $ilo_command = qq| 123 <USER_INFO MODE="write"> 124 <DELETE_USER USER_LOGIN="$user_login"/> 125 </USER_INFO> 126 |; 127 128 $ilo_command = $self->_wrap($ilo_command); 129 my $response = $self->_send($ilo_command) or return; 130 my $xml = $self->_serialize($response) or return; 131 132 if ( my $errmsg = _check_errors($xml) ) { 133 $self->error($errmsg); 134 return; 135 } 136 137 } 138 else { 139 140 croak 'del_user() requires the username to delete'; 141 142 } 143 144 return 1; 145 146} 147 148 149sub dhcp_enabled { 150 151 my $self = shift; 152 153 if (!$self->{dhcp_enable}) { 154 $self->_populate_network_settings or return; 155 } 156 157 return $self->{dhcp_enable}; 158 159} 160 161 162sub domain_name { 163 164 my $self = shift; 165 166 if (!$self->{domain_name}) { 167 $self->_populate_network_settings or return; 168 } 169 170 return $self->{domain_name}; 171 172} 173 174 175sub error { 176 177 my $self = shift; 178 179 if (@_) { 180 $self->{error} = shift; 181 } 182 183 return $self->{error}; 184 185} 186 187 188sub fans { 189 190 my $self = shift; 191 192 if (!$self->{fans}) { 193 $self->_populate_embedded_health or return; 194 } 195 196 return $self->{fans}; 197 198} 199 200 201sub fw_date { 202 203 my $self = shift; 204 205 if (!$self->{fw_date}) { 206 $self->_populate_fw_version or return; 207 } 208 209 return $self->{fw_date}; 210 211} 212 213 214sub fw_type { 215 216 my $self = shift; 217 218 if (!$self->{fw_type}) { 219 $self->_populate_fw_version or return; 220 } 221 222 return $self->{fw_type}; 223 224} 225 226 227sub fw_version { 228 229 my $self = shift; 230 231 if (!$self->{fw_version}) { 232 $self->_populate_fw_version or return; 233 } 234 235 return $self->{fw_version}; 236 237} 238 239 240sub gateway { 241 242 my $self = shift; 243 244 if (!$self->{gateway_ip_address}) { 245 $self->_populate_network_settings or return; 246 } 247 248 return $self->{gateway_ip_address}; 249 250} 251 252 253sub hostname { 254 255 my $self = shift; 256 257 if (!$self->{dns_name}) { 258 $self->_populate_network_settings or return; 259 } 260 261 return $self->{dns_name}; 262 263} 264 265 266sub http_port { 267 268 my $self = shift; 269 270 if (@_) { 271 272 my $http_port = shift; 273 274 _port_is_valid($http_port) or croak "HTTP port must be an integer between 0 and 65535"; 275 276 my $ilo_command = qq| 277 <RIB_INFO MODE="write"> 278 <MOD_GLOBAL_SETTINGS> 279 <HTTP_PORT value="$http_port"/> 280 </MOD_GLOBAL_SETTINGS> 281 </RIB_INFO> 282 |; 283 284 $ilo_command = $self->_wrap($ilo_command); 285 my $response = $self->_send($ilo_command) or return; 286 my $xml = $self->_serialize($response) or return; 287 288 if ( my $errmsg = _check_errors($xml) ) { 289 $self->error($errmsg); 290 return; 291 } 292 293 $self->{http_port} = $http_port; 294 295 } 296 297 if (!$self->{http_port}) { 298 $self->_populate_global_settings or return; 299 } 300 301 return $self->{http_port}; 302 303} 304 305 306sub https_port { 307 308 my $self = shift; 309 310 if (@_) { 311 312 my $https_port = shift; 313 314 _port_is_valid($https_port) or croak "HTTPS port must be an integer between 0 and 65535"; 315 316 my $ilo_command = qq| 317 <RIB_INFO MODE="write"> 318 <MOD_GLOBAL_SETTINGS> 319 <HTTPS_PORT value="$https_port"/> 320 </MOD_GLOBAL_SETTINGS> 321 </RIB_INFO> 322 |; 323 324 $ilo_command = $self->_wrap($ilo_command); 325 my $response = $self->_send($ilo_command) or return; 326 my $xml = $self->_serialize($response) or return; 327 328 if ( my $errmsg = _check_errors($xml) ) { 329 $self->error($errmsg); 330 return; 331 } 332 333 $self->{https_port} = $https_port; 334 335 } 336 337 if (!$self->{https_port}) { 338 $self->_populate_global_settings or return; 339 } 340 341 return $self->{https_port}; 342 343} 344 345 346sub ip_address { 347 348 my $self = shift; 349 350 if (!$self->{ip_address}) { 351 $self->_populate_network_settings or return; 352 } 353 354 return $self->{ip_address}; 355 356} 357 358 359sub license { 360 361 my $self = shift; 362 363 if (@_) { 364 365 my $license_key = shift; 366 367 my $ilo_command = qq| 368 <RIB_INFO MODE="write"> 369 <LICENSE> 370 <ACTIVATE KEY="$license_key"/> 371 </LICENSE> 372 </RIB_INFO> 373 |; 374 375 $ilo_command = $self->_wrap($ilo_command); 376 my $response = $self->_send($ilo_command) or return; 377 my $xml = $self->_serialize($response) or return; 378 379 if ( my $errmsg = _check_errors($xml) ) { 380 $self->error($errmsg); 381 return; 382 } 383 384 } 385 else { 386 387 croak 'license() requires the license key as a paramater'; 388 389 } 390 391 return 1; 392 393} 394 395 396sub mac01 { 397 398 my $self = shift; 399 400 if (!$self->{mac01}) { 401 $self->_populate_host_data or return; 402 } 403 404 if ($self->{mac01}) { 405 return $self->{mac01}; 406 } 407 else { 408 $self->error($METHOD_UNSUPPORTED); 409 return; 410 } 411 412} 413 414 415sub mac02 { 416 417 my $self = shift; 418 419 if (!$self->{mac02}) { 420 $self->_populate_host_data or return; 421 } 422 423 if ($self->{mac02}) { 424 return $self->{mac02}; 425 } 426 else { 427 $self->error($METHOD_UNSUPPORTED); 428 return; 429 } 430 431} 432 433 434sub mac03 { 435 436 my $self = shift; 437 438 # if mac01 is defined but mac03 isn't we aren't going to get it 439 # this time around either 440 441 if (!$self->{mac03} && !$self->{mac01}) { 442 $self->_populate_host_data or return; 443 } 444 445 if ($self->{mac03}) { 446 return $self->{mac03}; 447 } 448 else { 449 $self->error($METHOD_UNSUPPORTED); 450 return; 451 } 452 453} 454 455 456sub mac04 { 457 458 my $self = shift; 459 460 # see above 461 462 if (!$self->{mac04} && !$self->{mac01}) { 463 $self->_populate_host_data or return; 464 } 465 466 if ($self->{mac04}) { 467 return $self->{mac04}; 468 } 469 else { 470 $self->error($METHOD_UNSUPPORTED); 471 return; 472 } 473 474} 475 476 477sub macilo { 478 479 my $self = shift; 480 481 if (!$self->{macilo}) { 482 $self->_populate_host_data or return; 483 } 484 485 if ($self->{macilo}) { 486 return $self->{macilo}; 487 } 488 else { 489 $self->error($METHOD_UNSUPPORTED); 490 return; 491 } 492 493} 494 495 496sub model { 497 498 my $self = shift; 499 500 if (!$self->{model}) { 501 $self->_populate_host_data or return; 502 } 503 504 return $self->{model}; 505 506} 507 508 509sub mod_user { 510 511 my $self = shift; 512 513 if (@_) { 514 515 my $arg_ref = shift; 516 517 my $mod_username = $arg_ref->{username} || $self->username; 518 my $mod_password = $arg_ref->{password} || $self->password; 519 520 if (!$mod_username && !$mod_password) { 521 522 croak "mod_user requires username to modify and new password"; 523 524 } 525 526 my $ilo_command = qq| 527 <USER_INFO MODE="write"> 528 <MOD_USER USER_LOGIN="$mod_username"> 529 <PASSWORD value="$mod_password"/> 530 </MOD_USER> 531 </USER_INFO> 532 |; 533 534 $ilo_command = $self->_wrap($ilo_command); 535 my $response = $self->_send($ilo_command) or return; 536 my $xml = $self->_serialize($response) or return; 537 538 if ( my $errmsg = _check_errors($xml) ) { 539 $self->error($errmsg); 540 return; 541 } 542 543 if ($self->username eq $mod_username) { 544 545 $self->password($mod_password); 546 547 } 548 549 } 550 else { 551 552 croak "mod_user() requires parameters"; 553 554 } 555 556 557 return 1; 558 559} 560 561 562sub network { 563 564 my $self = shift; 565 566 if (@_) { 567 568 my $arg_ref = shift; 569 570 my $domain_name = $arg_ref->{domain_name} || $self->domain_name or croak "domain_name not set"; 571 my $dns_name = $arg_ref->{hostname} || $self->hostname or croak "name not set"; 572 my $dhcp_enable = $arg_ref->{dhcp_enabled} || $self->dhcp_enabled or croak "dhcp_enabled not set"; 573 my $ip_address = $arg_ref->{ip_address} || $self->ip_address or croak "ip_address not set"; 574 my $subnet_mask = $arg_ref->{subnet_mask} || $self->subnet_mask or croak "subnet_mask not set"; 575 my $gateway = $arg_ref->{gateway} || $self->gateway or croak "gateway not set"; 576 577 my $ilo_command = qq| 578 <RIB_INFO MODE="write"> 579 <MOD_NETWORK_SETTINGS> 580 <DHCP_ENABLE value="$dhcp_enable"/> 581 <IP_ADDRESS value="$ip_address"/> 582 <SUBNET_MASK value="$subnet_mask"/> 583 <GATEWAY_IP_ADDRESS value="$gateway"/> 584 <DNS_NAME value="$dns_name"/> 585 <DOMAIN_NAME value="$domain_name"/> 586 </MOD_NETWORK_SETTINGS> 587 </RIB_INFO> 588 |; 589 590 $ilo_command = $self->_wrap($ilo_command); 591 my $response = $self->_send($ilo_command) or return; 592 my $xml = $self->_serialize($response) or return; 593 594 if ( my $errmsg = _check_errors($xml) ) { 595 $self->error($errmsg); 596 return; 597 } 598 599 # force module to refresh new settings from the remote server 600 foreach my $option_changed (keys %$arg_ref) { 601 602 delete $self->{$option_changed}; 603 604 } 605 606 # if IP was changed it should be updated, if not this won't hurt 607 $self->address($ip_address); 608 609 } 610 611 return 1; 612 613} 614 615 616sub new { 617 618 my ($class) = shift; 619 620 # RT #65352: allow hash or hashref constructor args 621 my %options = ref $_[0] ? %{$_[0]} : @_; 622 623 my $self = {}; 624 625 bless($self, $class); 626 627 $self->address( $options{address} ); 628 $self->username( $options{username} ); 629 $self->password( $options{password} ); 630 631 if ($options{port}) { 632 $self->port($options{port}); 633 } 634 else { 635 $self->port(443); 636 } 637 638 # iLO version will be autodetected later if not specified 639 $self->{_version} = $options{version} || undef; 640 $self->{_debug} = $options{debug} || '0'; 641 642 return $self; 643 644} 645 646 647sub password { 648 649 my $self = shift; 650 651 if ( @_ ) { 652 $self->{password} = shift; 653 } 654 655 return $self->{password}; 656 657} 658 659 660sub port { 661 662 my $self = shift; 663 664 if (@_) { 665 my $port = shift; 666 667 _port_is_valid($port) or croak "Port must be an integer between 0 and 65535"; 668 669 $self->{port} = $port; 670 } 671 672 return $self->{port}; 673 674} 675 676 677sub power { 678 679 my $self = shift; 680 681 if ( @_ ) { 682 683 my $state_requested = shift; 684 685 my $ilo_command; 686 687 if (lc($state_requested) eq 'on') { 688 689 $ilo_command = $self->_generate_cmd('power_on'); 690 691 } 692 elsif (lc($state_requested) eq 'off') { 693 694 $ilo_command = $self->_generate_cmd('power_off'); 695 696 } 697 elsif (lc($state_requested) eq 'reset') { 698 699 $ilo_command = $self->_generate_cmd('power_reset'); 700 701 } 702 else { 703 704 croak "State '$state_requested' is not valid"; 705 706 } 707 708 my $response = $self->_send($ilo_command) or return; 709 my $xml = $self->_serialize($response) or return; 710 711 if ( my $errmsg = _check_errors($xml) ) { 712 $self->error($errmsg); 713 return; 714 } 715 716 return $state_requested; 717 718 } 719 720 my $ilo_command = $self->_generate_cmd('power_status'); 721 722 my $response = $self->_send($ilo_command) or return; 723 my $xml = $self->_serialize($response) or return; 724 725 if ( my $errmsg = _check_errors($xml) ) { 726 $self->error($errmsg); 727 return; 728 } 729 730 my $state = $xml->{GET_HOST_POWER}->{HOST_POWER}; 731 732 if (!$state) { 733 $self->error('Invalid response from remote ilo'); 734 return; 735 } 736 737 return lc($state); 738 739} 740 741 742sub power_consumption { 743 744 my $self = shift; 745 746 my $ilo_command = $self->_generate_cmd('power_consumption'); 747 748 my $response = $self->_send($ilo_command) or return; 749 my $xml = $self->_serialize($response) or return; 750 751 if ( my $errmsg = _check_errors($xml) ) { 752 $self->error($errmsg); 753 return unless $errmsg =~ /^Syntax error/; 754 } 755 756 if ($self->{power_consumption} = $xml->{GET_POWER_READINGS}->{PRESENT_POWER_READING}->{VALUE}) { 757 758 return $self->{power_consumption}; 759 760 } 761 else { 762 763 $self->error($METHOD_UNSUPPORTED); 764 return; 765 766 } 767 768} 769 770 771sub power_supplies { 772 773 my $self = shift; 774 775 if (!$self->{power_supplies}) { 776 $self->_populate_embedded_health or return; 777 } 778 779 return $self->{power_supplies}; 780 781} 782 783 784sub ramslots { 785 786 my $self = shift; 787 788 if (!$self->{ramslots}) { 789 $self->_populate_host_data or return; 790 } 791 792 return $self->{ramslots}; 793 794} 795 796 797sub reset { 798 799 my $self = shift; 800 801 my $ilo_command = $self->_generate_cmd('reset'); 802 803 my $response = $self->_send($ilo_command) or return; 804 my $xml = $self->_serialize($response) or return; 805 806 if ( my $errmsg = _check_errors($xml) ) { 807 $self->error($errmsg); 808 return; 809 } 810 811 return 1; 812 813} 814 815 816sub serialID { 817 818 my $self = shift; 819 820 if (!$self->{serialID}) { 821 $self->_populate_host_data or return; 822 } 823 824 return $self->{serialID}; 825 826} 827 828 829sub session_timeout { 830 831 my $self = shift; 832 833 if (!$self->{session_timeout}) { 834 $self->_populate_global_settings or return; 835 } 836 837 return $self->{session_timeout}; 838 839} 840 841 842sub ssh_port { 843 844 my $self = shift; 845 846 if (@_) { 847 848 my $ssh_port = shift; 849 850 _port_is_valid($ssh_port) or croak "ssh_port must be an integer between 0 and 65535"; 851 852 my $ilo_command = qq| 853 <RIB_INFO MODE="write"> 854 <MOD_GLOBAL_SETTINGS> 855 <SSH_PORT value="$ssh_port"/> 856 </MOD_GLOBAL_SETTINGS> 857 </RIB_INFO> 858 |; 859 860 $ilo_command = $self->_wrap($ilo_command); 861 my $response = $self->_send($ilo_command) or return; 862 my $xml = $self->_serialize($response) or return; 863 864 if ( my $errmsg = _check_errors($xml) ) { 865 $self->error($errmsg); 866 return; 867 } 868 869 $self->{ssh_port} = $ssh_port; 870 871 } 872 873 if (!$self->{ssh_port}) { 874 $self->_populate_global_settings or return; 875 } 876 877 return $self->{ssh_port}; 878 879} 880 881 882sub ssh_status { 883 884 my $self = shift; 885 886 if (@_) { 887 888 my $ssh_status = shift; 889 890 my $ilo_command = qq| 891 <RIB_INFO MODE="write"> 892 <MOD_GLOBAL_SETTINGS> 893 <SSH_STATUS value="$ssh_status"/> 894 </MOD_GLOBAL_SETTINGS> 895 </RIB_INFO> 896 |; 897 898 $ilo_command = $self->_wrap($ilo_command); 899 my $response = $self->_send($ilo_command) or return; 900 my $xml = $self->_serialize($response) or return; 901 902 if ( my $errmsg = _check_errors($xml) ) { 903 $self->error($errmsg); 904 return; 905 } 906 907 $self->{ssh_status} = $ssh_status; 908 909 } 910 911 if (!$self->{ssh_status}) { 912 $self->_populate_global_settings or return; 913 } 914 915 return $self->{ssh_status}; 916 917} 918 919 920sub subnet_mask { 921 922 my $self = shift; 923 924 if (!$self->{subnet_mask}) { 925 $self->_populate_network_settings or return; 926 } 927 928 return $self->{subnet_mask}; 929 930} 931 932 933sub temperatures { 934 935 my $self = shift; 936 937 if (!$self->{temperatures}) { 938 $self->_populate_embedded_health or return; 939 } 940 941 return $self->{temperatures}; 942 943} 944 945 946sub uid { 947 948 my $self = shift; 949 950 if (@_) { 951 952 my $state_requested = shift; 953 954 my $ilo_command; 955 956 if ($state_requested eq 'on') { 957 958 $ilo_command = $self->_generate_cmd('uid_on'); 959 960 } 961 elsif ($state_requested eq 'off') { 962 963 $ilo_command = $self->_generate_cmd('uid_off'); 964 965 } 966 else { 967 968 $self->error("State '$state_requested' is not valid"); 969 return; 970 971 } 972 973 my $response = $self->_send($ilo_command) or return; 974 my $xml = $self->_serialize($response) or return; 975 976 if ( my $errmsg = _check_errors($xml) ) { 977 $self->error($errmsg); 978 return; 979 } 980 981 return $state_requested; 982 983 } 984 985 my $ilo_command = $self->_generate_cmd('uid_status'); 986 987 my $response = $self->_send($ilo_command) or return; 988 my $xml = $self->_serialize($response) or return; 989 990 if ( my $errmsg = _check_errors($xml) ) { 991 $self->error($errmsg); 992 return; 993 } 994 995 my $uid_status = $xml->{GET_UID_STATUS}->{UID}; 996 997 return lc($uid_status); 998 999} 1000 1001 1002sub username { 1003 1004 my $self = shift; 1005 1006 if (@_) { 1007 $self->{username} = shift; 1008 } 1009 1010 return $self->{username}; 1011 1012} 1013 1014 1015sub _check_errors { 1016 1017 my $xml = shift; 1018 1019 my $errcode = $xml->{RESPONSE}->{STATUS}; 1020 my $errmsg = $xml->{RESPONSE}->{MESSAGE}; 1021 1022 if ($errcode ne '0x0000') { 1023 return $errmsg; 1024 } 1025 else { 1026 return; 1027 } 1028 1029} 1030 1031 1032sub _connect { 1033 1034 my $self = shift; 1035 1036 if ($self->{_client}) { 1037 return $self->{_client}; 1038 } 1039 1040 my $address = $self->address or croak "Can't connect: address not set"; 1041 my $port = $self->port or croak "Can't connect: port not set"; 1042 1043 $self->{_client} = IO::Socket::SSL->new( 1044 PeerAddr => "$address:$port", 1045 ); 1046 1047 if (!$self->{_client}) { 1048 $self->error( "Unable to establish SSL connection with $address:$port [" . IO::Socket::SSL::errstr() . "]" ); 1049 return; 1050 } 1051 1052 return $self->{_client}; 1053 1054} 1055 1056 1057sub _debug { 1058 1059 my $self = shift; 1060 1061 if (@_) { 1062 $self->{_debug} = shift; 1063 } 1064 1065 return $self->{_debug}; 1066 1067} 1068 1069 1070sub _detect_version { 1071 1072 my $self = shift; 1073 1074 # iLO 3 has a slightly different interface; it requires that 1075 # you preface commands with an HTTP header 1076 1077 my $ilo_command = qq( 1078 POST /ribcl HTTP/1.1 1079 HOST: localhost 1080 Content-length: 30 1081 Connection: Close 1082 1083 <RIBCL VERSION="2.0"></RIBCL> 1084 ); 1085 1086 my $response = $self->_send($ilo_command) or return; 1087 1088 if ($response =~ /^HTTP\/1.1 200 OK/) { 1089 return 3; 1090 } 1091 else { 1092 return 2; 1093 } 1094 1095} 1096 1097 1098sub _disconnect { 1099 1100 my $self = shift; 1101 1102 my $client = $self->{_client} or return; 1103 1104 $client->close; 1105 1106 delete $self->{_client}; 1107 1108 return 1; 1109 1110} 1111 1112 1113sub _generate_cmd { 1114 1115 my ($self, $command) = @_; 1116 1117 my %commands = ( 1118 1119 'get_embedded_health' => qq( <SERVER_INFO MODE="read"> 1120 <GET_EMBEDDED_HEALTH/> 1121 </SERVER_INFO> ), 1122 1123 'get_fw_version' => qq( <RIB_INFO MODE="read"> 1124 <GET_FW_VERSION/> 1125 </RIB_INFO> ), 1126 1127 'get_global_settings' => qq( <RIB_INFO MODE="read"> 1128 <GET_GLOBAL_SETTINGS/> 1129 </RIB_INFO> ), 1130 1131 'get_host_data' => qq( <SERVER_INFO MODE="read"> 1132 <GET_HOST_DATA/> 1133 </SERVER_INFO> ), 1134 1135 'get_network_settings' => qq( <RIB_INFO MODE="read"> 1136 <GET_NETWORK_SETTINGS/> 1137 </RIB_INFO> ), 1138 1139 'power_consumption' => qq( <SERVER_INFO MODE="read"> 1140 <GET_POWER_READINGS/> 1141 </SERVER_INFO> ), 1142 1143 'power_off' => qq( <SERVER_INFO MODE="write"> 1144 <SET_HOST_POWER HOST_POWER="No"/> 1145 </SERVER_INFO> ), 1146 1147 'power_on' => qq( <SERVER_INFO MODE="write"> 1148 <SET_HOST_POWER HOST_POWER="Yes"/> 1149 </SERVER_INFO> ), 1150 1151 'power_reset' => qq( <SERVER_INFO MODE="write"> 1152 <RESET_SERVER/> 1153 </SERVER_INFO> ), 1154 1155 'power_status' => qq( <SERVER_INFO MODE="read"> 1156 <GET_HOST_POWER_STATUS/> 1157 </SERVER_INFO> ), 1158 1159 'reset' => qq( <RIB_INFO MODE="write"> 1160 <RESET_RIB/> 1161 </RIB_INFO> ), 1162 1163 'uid_off' => qq( <SERVER_INFO MODE="write"> 1164 <UID_CONTROL UID="No"/> 1165 </SERVER_INFO> ), 1166 1167 'uid_on' => qq( <SERVER_INFO MODE="write"> 1168 <UID_CONTROL UID="Yes"/> 1169 </SERVER_INFO> ), 1170 1171 'uid_status' => qq( <SERVER_INFO MODE="read"> 1172 <GET_UID_STATUS/> 1173 </SERVER_INFO> ), 1174 1175 ); 1176 1177 my $ilo_command = $commands{$command} or die "Internal error: command '$command' doesn't exist"; 1178 1179 $ilo_command = $self->_wrap($ilo_command); 1180 1181 return $ilo_command; 1182 1183} 1184 1185 1186sub _length { 1187 1188 # for iLO 3 we need to know the length of the XML for the 1189 # Content-length field in the http header 1190 1191 my ($self, $ilo_command) = @_; 1192 1193 my $length = 0; 1194 1195 foreach my $line (split(/\n/, $ilo_command)) { 1196 1197 $line =~ s/^\s+//; 1198 $line =~ s/\s+$//; 1199 1200 # each line has \r\n appended when sending, so + 2 1201 $length += length($line) + 2; 1202 1203 } 1204 1205 return $length; 1206 1207} 1208 1209 1210sub _populate_embedded_health { 1211 1212 my $self = shift; 1213 1214 my $ilo_command = $self->_generate_cmd('get_embedded_health'); 1215 1216 my $response = $self->_send($ilo_command) or return; 1217 my $xml = $self->_serialize($response) or return; 1218 1219 if ( my $errmsg = _check_errors($xml) ) { 1220 $self->error($errmsg); 1221 return; 1222 } 1223 1224 my $fans = $xml->{GET_EMBEDDED_HEALTH_DATA}->{FANS}->{FAN}; 1225 my $power_supplies = $xml->{GET_EMBEDDED_HEALTH_DATA}->{POWER_SUPPLIES}->{SUPPLY}; 1226 my $temperatures = $xml->{GET_EMBEDDED_HEALTH_DATA}->{TEMPERATURE}->{TEMP}; 1227 1228 foreach my $fan (@$fans) { 1229 1230 my $location = $fan->{ZONE}->{VALUE}; 1231 my $name = $fan->{LABEL}->{VALUE}; 1232 my $speed = $fan->{SPEED}->{VALUE}; 1233 my $status = $fan->{STATUS}->{VALUE}; 1234 my $unit = $fan->{SPEED}->{UNIT}; 1235 1236 next unless $speed && $speed =~ /^\d+$/; 1237 1238 push( @{$self->{fans}}, { 1239 'location' => $location, 1240 'name' => $name, 1241 'speed' => $speed, 1242 'status' => $status, 1243 'unit' => $unit, 1244 }); 1245 1246 } 1247 1248 foreach my $power_supply (@$power_supplies) { 1249 1250 my $name = $power_supply->{LABEL}->{VALUE}; 1251 my $status = $power_supply->{STATUS}->{VALUE}; 1252 1253 next if $status eq 'Not Installed'; 1254 1255 push( @{$self->{power_supplies}}, { 1256 'name' => $name, 1257 'status' => $status, 1258 }); 1259 1260 } 1261 1262 foreach my $temperature (@$temperatures) { 1263 1264 my $name = $temperature->{LABEL}->{VALUE}; 1265 my $location = $temperature->{LOCATION}->{VALUE}; 1266 my $value = $temperature->{CURRENTREADING}->{VALUE}; 1267 my $unit = $temperature->{CURRENTREADING}->{UNIT}; 1268 my $caution = $temperature->{CAUTION}->{VALUE}; 1269 my $critical = $temperature->{CRITICAL}->{VALUE}; 1270 my $status = $temperature->{STATUS}->{VALUE}; 1271 1272 next unless $value && $value =~ /^\d+$/; 1273 1274 push( @{$self->{temperatures}}, { 1275 'name' => $name, 1276 'location' => $location, 1277 'value' => $value, 1278 'unit' => $unit, 1279 'caution' => $caution, 1280 'critical' => $critical, 1281 'status' => $status, 1282 }); 1283 1284 } 1285 1286 return 1; 1287 1288} 1289 1290 1291sub _populate_fw_version { 1292 1293 my $self = shift; 1294 1295 my $ilo_command = $self->_generate_cmd('get_fw_version'); 1296 1297 my $response = $self->_send($ilo_command) or return; 1298 my $xml = $self->_serialize($response) or return; 1299 1300 if ( my $errmsg = _check_errors($xml) ) { 1301 $self->error($errmsg); 1302 return; 1303 } 1304 1305 $self->{fw_type} = $xml->{GET_FW_VERSION}->{MANAGEMENT_PROCESSOR}; 1306 $self->{fw_date} = $xml->{GET_FW_VERSION}->{FIRMWARE_DATE}; 1307 $self->{fw_version} = $xml->{GET_FW_VERSION}->{FIRMWARE_VERSION}; 1308 1309 return 1; 1310 1311} 1312 1313 1314sub _populate_global_settings { 1315 1316 my $self = shift; 1317 1318 my $ilo_command = $self->_generate_cmd('get_global_settings'); 1319 1320 my $response = $self->_send($ilo_command) or return; 1321 my $xml = $self->_serialize($response) or return; 1322 1323 if ( my $errmsg = _check_errors($xml) ) { 1324 $self->error($errmsg); 1325 return; 1326 } 1327 1328 my @fields = qw( session_timeout https_port http_port 1329 ssh_port ssh_status ); 1330 1331 foreach my $field (@fields) { 1332 1333 $self->{$field} = $xml->{GET_GLOBAL_SETTINGS}->{uc($field)}->{VALUE}; 1334 1335 } 1336 1337 return 1; 1338 1339} 1340 1341 1342sub _populate_host_data { 1343 1344 my $self = shift; 1345 1346 my $ilo_command = $self->_generate_cmd('get_host_data'); 1347 1348 my $response = $self->_send($ilo_command) or return; 1349 my $xml = $self->_serialize($response) or return; 1350 1351 if ( my $errmsg = _check_errors($xml) ) { 1352 $self->error($errmsg); 1353 return; 1354 } 1355 1356 # SMBIOS data is stored in a big fat array 1357 # 1358 # data is not guaranteed to be in any particular index, so we have to 1359 # iterate through all the data looking for certain fields. 1360 # 1361 # thankfully, SMBIOS *types* are standard (eg. CPU data is type 4) 1362 # so we have a starting point 1363 # 1364 # this really sucks but I don't know of a better way 1365 1366 for my $fieldnum (0 .. scalar @{$xml->{GET_HOST_DATA}->{SMBIOS_RECORD}}) { 1367 1368 my $smbios_data = $xml->{GET_HOST_DATA}->{SMBIOS_RECORD}[$fieldnum]->{FIELD}; 1369 my $smbios_type = $xml->{GET_HOST_DATA}->{SMBIOS_RECORD}[$fieldnum]->{TYPE}; 1370 1371 next unless defined $smbios_type; 1372 1373 if ($smbios_type == 0) { 1374 1375 for my $entry (0 .. scalar @$smbios_data) { 1376 1377 my $field_name = $smbios_data->[$entry]->{NAME}; 1378 my $field_value = $smbios_data->[$entry]->{VALUE}; 1379 1380 next unless $field_name && $field_value; 1381 1382 if ($field_name eq 'Date') { 1383 $self->{biosdate} = $field_value; 1384 } 1385 1386 } 1387 1388 } 1389 elsif ($smbios_type == 1) { 1390 1391 for my $entry (0 .. scalar @$smbios_data) { 1392 1393 my $field_name = $smbios_data->[$entry]->{NAME}; 1394 my $field_value = $smbios_data->[$entry]->{VALUE}; 1395 1396 next unless $field_name && $field_value; 1397 1398 if ($field_name eq 'Product Name') { 1399 $self->{model} = $field_value; 1400 } 1401 elsif ($field_name eq 'Serial Number') { 1402 $self->{serialID} = $field_value; 1403 } 1404 elsif ($field_name eq 'UUID') { 1405 $self->{UUID} = $field_value; 1406 } 1407 1408 } 1409 1410 } 1411 elsif ($smbios_type == 4) { 1412 1413 my ($name, $speed, $cores); 1414 1415 for my $entry (0 .. scalar @$smbios_data) { 1416 1417 my $field_name = $smbios_data->[$entry]->{NAME}; 1418 my $field_value = $smbios_data->[$entry]->{VALUE}; 1419 1420 next unless $field_name && $field_value; 1421 1422 if ($field_name eq 'Label') { 1423 $name = $field_value; 1424 } 1425 elsif ($field_name eq 'Speed') { 1426 $speed = $field_value; 1427 } 1428 elsif ($field_name eq 'Execution Technology') { 1429 $cores = $field_value || 'single core'; 1430 } 1431 1432 } 1433 1434 # otherwise slot is empty 1435 next unless $speed && $speed =~ /^[1-9]/; 1436 1437 push( @{$self->{cpus}}, { 1438 'name' => $name, 1439 'speed' => $speed, 1440 'cores' => $cores } 1441 ); 1442 1443 } 1444 elsif ($smbios_type == 17) { 1445 1446 my ($location, $size, $speed); 1447 1448 for my $entry (0 .. scalar @$smbios_data) { 1449 1450 my $field_name = $smbios_data->[$entry]->{NAME}; 1451 my $field_value = $smbios_data->[$entry]->{VALUE}; 1452 1453 next unless $field_name && $field_value; 1454 1455 if ($field_name eq 'Label') { 1456 $location = $field_value; 1457 } 1458 elsif ($field_name eq 'Size') { 1459 $size = $field_value; 1460 } 1461 elsif ($field_name eq 'Speed') { 1462 $speed = $field_value; 1463 } 1464 1465 } 1466 1467 push( @{$self->{ramslots}}, { 1468 'location' => $location, 1469 'size' => $size, 1470 'speed' => $speed } 1471 ); 1472 1473 } 1474 elsif ($smbios_type == 209) { 1475 1476 for my $entry (0 .. scalar @$smbios_data) { 1477 1478 my $field_name = $smbios_data->[$entry]->{NAME}; 1479 my $field_value = $smbios_data->[$entry]->{VALUE}; 1480 1481 next unless $field_name && $field_value; 1482 next unless $field_name eq 'Port'; 1483 1484 # MAC address is offset by one from port label 1485 1486 my $current_mac = $smbios_data->[$entry + 1]->{VALUE}; 1487 1488 if ($field_value eq '1') { 1489 $self->{mac01} = $current_mac; 1490 } 1491 elsif ($field_value eq '2') { 1492 $self->{mac02} = $current_mac; 1493 } 1494 elsif ($field_value eq '3') { 1495 $self->{mac03} = $current_mac; 1496 } 1497 elsif ($field_value eq '4') { 1498 $self->{mac04} = $current_mac; 1499 } 1500 elsif ($field_value eq 'iLO') { 1501 $self->{macilo} = $current_mac; 1502 } 1503 1504 } 1505 1506 } 1507 1508 } 1509 1510 ($self->{mac01} = lc($self->{mac01})) =~ tr/-/:/; 1511 ($self->{mac02} = lc($self->{mac02})) =~ tr/-/:/; 1512 ($self->{mac03} = lc($self->{mac03})) =~ tr/-/:/; 1513 ($self->{mac04} = lc($self->{mac04})) =~ tr/-/:/; 1514 ($self->{macilo} = lc($self->{macilo})) =~ tr/-/:/; 1515 1516 return 1; 1517 1518} 1519 1520 1521sub _populate_network_settings { 1522 1523 my $self = shift; 1524 1525 my $ilo_command = $self->_generate_cmd('get_network_settings'); 1526 1527 my $response = $self->_send($ilo_command) or return; 1528 my $xml = $self->_serialize($response) or return; 1529 1530 if ( my $errmsg = _check_errors($xml) ) { 1531 $self->error($errmsg); 1532 return; 1533 } 1534 1535 my @fields = qw( dhcp_dns_server dhcp_gateway dns_name 1536 dhcp_domain_name ip_address domain_name 1537 dhcp_enable subnet_mask gateway_ip_address ); 1538 1539 foreach my $field (@fields) { 1540 1541 $self->{$field} = $xml->{GET_NETWORK_SETTINGS}->{uc($field)}->{VALUE}; 1542 1543 } 1544 1545 return 1; 1546 1547} 1548 1549 1550sub _send { 1551 1552 my ($self, $ilo_command) = @_; 1553 1554 my $client = $self->_connect or return; 1555 1556 foreach my $line ( split(/\n/, $ilo_command) ) { 1557 1558 $line =~ s/^\s+//; 1559 $line =~ s/\s+$//; 1560 1561 if ($self->_debug > 0) { 1562 print "'$line'\n"; 1563 } 1564 1565 my $ok = print {$client} $line . "\r\n"; 1566 1567 if (!$ok) { 1568 $self->error("Error transmitting command to server"); 1569 return; 1570 } 1571 1572 } 1573 1574 chomp( my $response = join('', <$client>) ); 1575 1576 # iLO 3 returns a chunked http response 1577 # rather than parse it, just filter out the chunking data 1578 # janky, but a lightweight solution which works for all iLO versions 1579 1580 $response =~ s/[\r\n]+[0-9a-f]{3}[\r\n]+//gs; 1581 1582 $self->_disconnect or die "Internal error: disconnect failed, wtf!"; 1583 1584 if (!$response) { 1585 $self->error("No response received from remote machine"); 1586 return; 1587 } 1588 1589 if ($self->_debug > 0) { 1590 print Dumper $response; 1591 } 1592 1593 return $response; 1594 1595} 1596 1597 1598sub _serialize { 1599 1600 my ($self, $data) = @_; 1601 1602 if (!$data) { 1603 $self->error('Error parsing response: no data received'); 1604 return; 1605 } 1606 1607 # iLO returns multiple XML stanzas, all starting with a standard header. 1608 # We first need to break this glob of data into individual XML components, 1609 # while ignoring the HTTP header returned by iLO 3. 1610 1611 chomp( my @stanzas = grep { !/HTTP\/1.1/ } split(/<\?xml.*?\?>/, $data) ); 1612 1613 # @stanzas now contains a number of valid XML sequences. 1614 # All but one is unnecessary; they contain short status messages and 1615 # nothing else. So, we want to parse only the longest message. 1616 # 1617 # NB: The same status codes are also included in the longest stanza. 1618 1619 my $longest = ( sort {length($b) <=> length($a)} @stanzas )[0]; 1620 1621 if ($self->_debug > 3) { 1622 print Dumper $longest; 1623 } 1624 1625 # XML::Simple croaks if it can't parse the data properly. 1626 # We want to capture any errors and propagate them on our own terms. 1627 1628 my $xml; 1629 1630 eval { $xml = XMLin( $longest, NormaliseSpace => 2 ) }; 1631 1632 if ($EVAL_ERROR) { 1633 $self->error("Error parsing response: $EVAL_ERROR"); 1634 return; 1635 } 1636 1637 if ($self->_debug >= 2) { 1638 print Dumper $xml; 1639 } 1640 1641 return $xml; 1642 1643} 1644 1645 1646sub _port_is_valid { 1647 1648 my $port = shift; 1649 1650 return unless defined $port && $port =~ /^\d{1,5}$/ && $port <= 65535; 1651 1652 return 1; 1653 1654} 1655 1656 1657sub _version { 1658 1659 my $self = shift; 1660 1661 if (@_) { 1662 $self->{_version} = shift; 1663 } 1664 1665 return $self->{_version}; 1666 1667} 1668 1669 1670sub _wrap { 1671 1672 my $self = shift; 1673 1674 my $body = shift or die "Internal error: no data passed to _wrap()"; 1675 1676 my $username = $self->username or croak "Username not set"; 1677 my $password = $self->password or croak "Password not set"; 1678 1679 if (!$self->_version) { 1680 1681 my $ilo_version = $self->_detect_version or return; 1682 1683 print "Detected iLO version $ilo_version\n" if $self->_debug > 2; 1684 1685 $self->_version($ilo_version); 1686 1687 } 1688 1689 my $header = qq| 1690 <?xml version="1.0"?> 1691 <LOCFG version="2.21"> 1692 <RIBCL VERSION="2.0"> 1693 <LOGIN USER_LOGIN="$username" PASSWORD="$password"> 1694 |; 1695 1696 my $footer = qq| 1697 </LOGIN> 1698 </RIBCL> 1699 |; 1700 1701 my $ilo_command = $header . $body . $footer; 1702 1703 if ($self->_version == 3) { 1704 1705 my $command_length = $self->_length($ilo_command); 1706 1707 my $http_header = qq| 1708 POST /ribcl HTTP/1.1 1709 HOST: localhost 1710 Content-length: $command_length 1711 Connection: Close 1712 1713 |; 1714 1715 $ilo_command = $http_header . $ilo_command; 1716 1717 } 1718 1719 return $ilo_command; 1720 1721} 1722 1723 1724sub DESTROY { 1725 1726 my $self = shift; 1727 1728 my $client = $self->{_client} or return; 1729 $client->close; 1730 1731 return; 1732} 1733 17341; 1735__END__ 1736 1737=head1 NAME 1738 1739Net::ILO - Interface to HP Integrated Lights-Out 1740 1741=head1 SYNOPSIS 1742 1743 use Net::ILO; 1744 1745 my $ilo = Net::ILO->new({ 1746 address => '192.168.128.10', 1747 username => 'Administrator', 1748 password => 'secret', 1749 }); 1750 1751 # returns 'on' or 'off' 1752 my $power_status = $ilo->power or die $ilo->error; 1753 1754 $ilo->power('off'); 1755 $ilo->power('reset'); 1756 1757 my $mac01 = $ilo->mac01; 1758 my $mac02 = $ilo->mac02; 1759 my $macilo = $ilo->macilo; 1760 1761 # see METHODS for complete listing 1762 1763=head1 DESCRIPTION 1764 1765The Net::ILO module is an interface to a subset of Hewlett-Packards 1766Integrated Lights-Out out-of-band management system. HP's API is XML-based 1767and cumbersome to use; this module aims to simplify accessing 1768the iLO from Perl while retaining as much functionality as possible. 1769 1770Not every iLO function is implemented here, however most common ones are. 1771 1772This module is based on the sixth edition of the "HP Integrated Lights-Out 1773Management Processor Scripting and Command Line Resource Guide" and has 1774been successfully tested with the following server types: 1775 1776 DL360/G3 1777 DL360/G4 1778 DL360/G4p 1779 DL360/G5 1780 DL360/G6 1781 DL360/G7 ** see note below 1782 DL380/G3 1783 DL380/G4 1784 DL380/G5 1785 1786It should work with other server models; feedback (either way) is much 1787appreciated. 1788 1789Note: iLO 3 support is in BETA, and still being tested. 1790 1791=head1 INTERFACE QUIRKS 1792 1793Wherever possible, I have mimicked HP's API to maintain consistency. However, 1794certain names have been changed to reflect a more common usage, for example, 1795what HP calls 'DNS_NAME' is referred to as 'hostname' by Net::ILO. 1796 1797Boolean types are represented in the documentation as either 'Yes' or 'No'. 1798When ILO returns a boolean response, it is shortened to 'Y' or 'N'. Either form 1799is acceptable when passing a value to your server's iLO. 1800 1801Power and UID statuses are an exception; their states can be either 1802'on' or 'off'. 1803 1804=head1 METHODS 1805 1806The interface is extensive and methods have been grouped by function for 1807easier digestion. 1808 1809=head2 GENERAL METHODS 1810 1811=over 1812 1813=item new() 1814 1815 my $ilo = Net::ILO->new({ 1816 address => '192.168.131.185', 1817 username => 'Administrator', 1818 password => 'secret', 1819 }); 1820 1821 # can also use a hash rather than hashref 1822 1823 my $ilo = Net::ILO->new( 1824 address => '192.168.131.185', 1825 username => 'Administrator', 1826 password => 'secret', 1827 ); 1828 1829Creates a new ILO object, but does not attempt a connection. Parameters 1830are passed as an anonymous hash or hashref. 1831 1832Required paramters: 1833 1834None, however trying to call any method without setting at least the 1835address, username and password will fail. You may however, set these 1836later using their associated methods if you want. 1837 1838Optional parameters: 1839 1840 address - hostname or IP of remote machine's iLO 1841 port - default is 443, you may specify another port here 1842 username - username for logging in to iLO 1843 password - password for logging in to iLO 1844 version - version of iLO API to use, '1', '2' or '3'. versions 1 and 2 are 1845 the same and correspond to iLO and iLO 2 respectively, if version 1846 '3' is used the module will use the new iLO 3 interface. if not 1847 specified the version will be detected automatically (recommended) 1848 debug - debug level (default 0). Increasing this number (to a maximum of 3) 1849 displays more diagnostic information to the screen, such as the 1850 data sent to and received from iLO, the Perl data structure 1851 created from the XML received, etc. 1852 1853=item address() 1854 1855 # connect to a different machine 1856 $ilo->address('192.168.131.186'); 1857 1858 print $ilo->power; 1859 1860Returns or sets the address of the remote machine to connect to. 1861 1862Please note that a lot of the data gathered (power state excluded) is cached. 1863Connecting to machine A, calling mac01(), then connecting to machine B and 1864calling mac01() will return the same data. It is recommended that you 1865instantiate a new object for each server you connect to. 1866 1867=item port() 1868 1869 # your company's machines use a non-standard SSL port 1870 $ilo->port(447); 1871 1872Returns or sets the port to connect to the remote server on. 1873Port 443 is assumed if not specified. 1874 1875=item username() 1876 1877 $ilo->username('jane_doe'); 1878 1879 # do some non-admin tasks 1880 # power-cycling machine requires elevated privileges 1881 1882 $ilo->username('Administrator'); 1883 $ilo->power('reset'); 1884 1885Returns or sets the username to use when logging in. 1886 1887=item password() 1888 1889 # try both passwords, we forgot which one was good 1890 $ilo->password('foobar'); 1891 1892 # all methods return false on failure 1893 if (!$ilo->power) { 1894 1895 $ilo->password('barfoo'); 1896 1897 } 1898 1899Returns or sets the password to use when logging in. 1900 1901=item error() 1902 1903 $ilo->address('127.0.0.1'); 1904 1905 my $power_status = $ilo->power or die $ilo->error; 1906 1907 Unable to establish SSL connection with 127.0.0.1:443 1908 [IO::Socket::INET6 configuration failederror:00000000:lib(0):func(0):reason(0)] at /somescript.pl line 14. 1909 1910Returns the last error reported, if any. All methods return false when 1911an error is encountered, and $ilo->error is set to the error message 1912reported by the remote machine. Note that on success, error() is not cleared, 1913and so should not be used to determine whether an error occurred. 1914 1915Every single method which interacts with the remote machine may throw an 1916error, so it is very important that you check to ensure the command 1917succeeded. Error checking has been omitted from most examples for brevity. 1918 1919=back 1920 1921=head2 POWER MANAGEMENT 1922 1923=over 1924 1925=item power() 1926 1927 my $power_status = $ilo->power; 1928 1929 if ($power_status eq 'off') { 1930 1931 $ilo->power('on'); 1932 1933 } 1934 else { 1935 1936 $ilo->power('reset'); 1937 1938 } 1939 1940Calling this method without parameters will return the current power 1941state of the machine, either 'on' or 'off'. Passing any of the following 1942to this method will attempt to change the power state: 1943 1944 on 1945 off 1946 reset 1947 1948=item power_consumption() 1949 1950 # something like 340 1951 print $ilo->power_consumption; 1952 1953Returns the current power consumption in watts. 1954 1955This method is only available when using iLO 2 and above. Calling it on an 1956older machine will cause the following error to be returned: 1957 1958Method not supported by this iLO version 1959 1960=back 1961 1962=head2 NETWORKING 1963 1964=over 1965 1966=item hostname 1967 1968 # default is ILO0000000000 where 000... is your serial number 1969 my $machine_name = $ilo->hostname; 1970 1971Returns the hostname of the remote machine. This is also the name shown 1972when logging in to the iLO interface, in the SSL cert, etc. 1973 1974For information on changing the hostname, see the network() method. 1975 1976=item domain_name() 1977 1978 # maybe ilo.somecompany.net 1979 my $domain_name = $ilo->domain_name; 1980 1981Returns the DNS domain name of the remote machine. 1982 1983For information on changing the domain name, see the network() method. 1984 1985=item dhcp_enabled() 1986 1987 # either 'Y' or 'N' 1988 print $ilo->dhcp_enabled; 1989 1990Returns 'Y' if DHCP is enabled for the iLO networking, and 'N' if a 1991static IP address is in use. 1992 1993=item ip_address() 1994 1995 # network dependent, something like 192.168.1.129 1996 print $ilo->ip_address; 1997 1998Returns the IP address of the iLO processor. Note that the IP can NOT 1999be changed using this method. For managing network settings, see 2000network(). 2001 2002=item subnet_mask() 2003 2004 # network dependent, something like 255.255.255.0 2005 print $ilo->subnet_mask; 2006 2007Returns the subnet mask of the iLO processor. 2008 2009=item gateway() 2010 2011 # you guessed it, network dependent 2012 print $ilo->gateway; 2013 2014Returns the default gateway in use for the iLO networking. 2015 2016=item network() 2017 2018 $ilo->network({ 2019 name => 'testbox01', 2020 domain_name => 'mydomain.com', 2021 dhcp_enabled => 'no', 2022 ip_address => '192.168.128.10', 2023 subnet_mask => '255.255.255.0', 2024 gateway => '192.168.128.1', 2025 }) or die $ilo->error; 2026 2027Allows you to modify the network configuration of the iLO processor. The 2028following parameters are allowed, see individual methods above for more detail: 2029 2030 name 2031 domain_name 2032 dhcp_enabled 2033 ip_address 2034 subnet_mask 2035 gateway 2036 2037If any parameter is not specified, current values are used. 2038 2039Setting dhcp_enabled to 'yes' causes all IP related settings to have no effect. 2040 2041If the IP address is changed here, address() is updated with the new information. 2042 2043Networking changes cause the iLO processor to reset, it should become 2044available again within 30 seconds. 2045 2046The rationale behind seperate methods for viewing and changing network 2047settings is as follows: 2048 2049Network configuration generally needs to be modified as a package, for 2050example, changing both the IP address and default gateway. Without a 2051separate method, calling the ip_address() method as a setter could 2052cause you to lose connectivity. 2053 2054=back 2055 2056=head2 SYSTEM INFORMATION 2057 2058=over 2059 2060=item model() 2061 2062 # ProLiant DL380 G5 2063 print $ilo->model; 2064 2065Returns the model name of the machine. 2066 2067=item serialID() 2068 2069 # unique to your machine 2070 print $ilo->serialID; 2071 2072Returns the serial number of the remote machine. 2073 2074=item cpus() 2075 2076 my $cpus = $ilo->cpus; 2077 2078 print "Number of CPUs: ", scalar @$cpus, "\n\n"; 2079 2080 foreach my $cpu (@$cpus) { 2081 2082 print " CPU: ", $cpu->{name}, "\n"; 2083 print "Speed: ", $cpu->{speed}, "\n"; 2084 print "Cores: ", $cpu->{cores}, "\n"; 2085 2086 } 2087 2088 # yields the following on a single CPU Xeon: 2089 # 2090 # Number of CPUs: 1 2091 # 2092 # CPU: Proc 1 2093 # Speed: 2000 MHz 2094 # Cores: 4 of 4 cores; 4 threads 2095 2096Returns arrayref containing information about each CPU. Included is the 2097CPU name (eg. Proc 1, Proc 2, etc.), speed in MHz and number of cores. 2098 2099=item ramslots() 2100 2101 my $ramslots = $ilo->ramslots or die $ilo->error; 2102 2103 print "DIMM slots: ", scalar @$ramslots, "\n\n"; 2104 2105 foreach my $slot (@$ramslots) { 2106 2107 print " Slot: ", $slot->{location}, "\n"; 2108 print " Size: ", $slot->{size}, "\n"; 2109 print "Speed: ", $slot->{speed}, "\n" if defined $slot->{speed}; 2110 2111 } 2112 2113 # yields the following on a DL360/G5 with 8 GB of RAM: 2114 # 2115 # DIMM slots: 8 2116 # 2117 # Slot: DIMM 1A 2118 # Size: 2048 MB 2119 # Speed: 667 MHz 2120 # 2121 # Slot: DIMM 2C 2122 # Size: 1024 MB 2123 # Speed: 667 MHz 2124 # 2125 # Slot: DIMM 3A 2126 # Size: 2048 MB 2127 # Speed: 667 MHz 2128 # 2129 # Slot: DIMM 4C 2130 # Size: 1024 MB 2131 # Speed: 667 MHz 2132 # 2133 # Slot: DIMM 5B 2134 # Size: 1024 MB 2135 # Speed: 667 MHz 2136 # 2137 # Slot: DIMM 6D 2138 # Size: not installed 2139 # 2140 # Slot: DIMM 7B 2141 # Size: 1024 MB 2142 # Speed: 667 MHz 2143 # 2144 # Slot: DIMM 8D 2145 # Size: not installed 2146 2147Returns arrayref containing information about installed memory modules. Includes 2148slot name, module size and module speed. Speed is undefined when slot is empty. 2149 2150=item mac01() 2151 2152 my $eth0_mac = $ilo->mac01; 2153 2154Returns the mac address associated with the machine's primary NIC (aka eth0). 2155 2156This method is not supported by pre-generation 4 hardware. 2157 2158=item mac02() 2159 2160 my $eth1_mac = $ilo->mac02; 2161 2162Returns the mac address associated with the machine's secondary NIC (aka eth1). 2163 2164This method is not supported by pre-generation 4 hardware. 2165 2166=item mac03() 2167 2168 my $eth2_mac = $ilo->mac03; 2169 2170Returns the mac address associated with the machine's tertiary NIC, if 2171installed. Note that mac addresses for add-on cards will not be available 2172via this method. 2173 2174=item mac04() 2175 2176 my $eth3_mac = $ilo->mac04; 2177 2178Returns the mac address associated with the machine's quaternary NIC, if 2179installed. Note that mac addresses for add-on cards will not be available 2180via this method. 2181 2182=item macilo() 2183 2184 my $ilo_mac = $ilo->macilo; 2185 2186Returns the mac address associated with the machine's iLO interface. 2187 2188This method is not supported by pre-generation 4 hardware. 2189 2190=item biosdate() 2191 2192 # format is 11/30/2006 2193 print $ilo->biosdate; 2194 2195Returns the release date of the system's BIOS. 2196 2197=back 2198 2199=head2 SERVER HEALTH 2200 2201=over 2202 2203=item fans() 2204 2205 my $fans = $ilo->fans; 2206 2207 foreach my $fan (@$fans) { 2208 2209 print " Name: ", $fan->{name}, "\n"; 2210 print "Location: ", $fan->{location}, "\n"; 2211 print " Speed: ", $fan->{speed}, "\n"; 2212 print " Unit: ", $fan->{unit}, "\n"; 2213 print " Status: ", $fan->{status}, "\n\n"; 2214 2215 } 2216 2217 # Name: Fan Block 1 2218 # Location: Power Supply 2219 # Speed: 34 2220 # Unit: Percentage 2221 # Status: Ok 2222 # 2223 # Name: Fan Block 2 2224 # Location: CPU 2 2225 # Speed: 29 2226 # Unit: Percentage 2227 # Status: Ok 2228 # 2229 # Name: Fan Block 3 2230 # Location: CPU 1 2231 # Speed: 34 2232 # Unit: Percentage 2233 # Status: Ok 2234 2235Returns arrayref containing the status of the fan block(s) installed in the 2236system. 'status' will be 'Ok' or 'Failed'. 2237 2238=item temperatures() 2239 2240 my $temperatures = $ilo->temperatures; 2241 2242 foreach my $sensor (@$temperatures) { 2243 2244 print " Name: ", $sensor->{name}, "\n"; 2245 print "Location: ", $sensor->{location}, "\n"; 2246 print " Value: ", $sensor->{value}, "\n"; 2247 print " Unit: ", $sensor->{unit}, "\n"; 2248 print " Caution: ", $sensor->{caution}, "\n"; 2249 print "Critical: ", $sensor->{critical}, "\n"; 2250 print " Status: ", $sensor->{status}, "\n\n"; 2251 2252 } 2253 2254 # Name: Temp 1 2255 # Location: I/O Board 2256 # Value: 49 2257 # Unit: Celsius 2258 # Caution: 80 2259 # Critical: 90 2260 # Status: Ok 2261 # 2262 # Name: Temp 2 2263 # Location: Ambient 2264 # Value: 19 2265 # Unit: Celsius 2266 # Caution: 80 2267 # Critical: 90 2268 # Status: Ok 2269 # 2270 # Name: Temp 3 2271 # Location: CPU 1 2272 # Value: 32 2273 # Unit: Celsius 2274 # Caution: 80 2275 # Critical: 90 2276 # Status: Ok 2277 # 2278 # Name: Temp 4 2279 # Location: CPU 1 2280 # Value: 32 2281 # Unit: Celsius 2282 # Caution: 80 2283 # Critical: 90 2284 # Status: Ok 2285 # 2286 # Name: Temp 5 2287 # Location: Power Supply 2288 # Value: 28 2289 # Unit: Celsius 2290 # Caution: 80 2291 # Critical: 90 2292 # Status: Ok 2293 2294Returns arrayref containing the status of the temperature sensor(s) installed 2295in the system. 'status' will be 'Failed' if the temperature exceeds the 2296critical threshold. 2297 2298=item power_supplies() 2299 2300 my $power_supplies = $ilo->power_supplies; 2301 2302 foreach my $power_supply (@$power_supplies) { 2303 2304 print " Name: ", $power_supply->{name}, "\n"; 2305 print "Status: ", $power_supply->{status}, "\n\n"; 2306 2307 } 2308 2309 # Name: Power Supply 1 2310 # Status: Ok 2311 2312Returns arrayref containing the status of the power supplies installed in the 2313system. 'status' will be 'Ok' or 'Failed'. 2314 2315=back 2316 2317=head2 ILO INFORMATION AND MANAGEMENT 2318 2319=over 2320 2321=item reset() 2322 2323 # iLO web interface is hung, try resetting it 2324 $ilo->reset; 2325 2326Resets the iLO management processor. 2327 2328=item license() 2329 2330 # 25 characters, according to HP 2331 $ilo->license('1111122222333334444455555'); 2332 2333Activates iLO advanced pack licensing. An error will be returned if 2334the key is not valid or if it is already in use. 2335 2336=item fw_type() 2337 2338 # either 'iLO', 'iLO2' or 'iLO3' 2339 print $ilo->fw_type; 2340 2341Returns the type of iLO management processor in the remote machine. 2342Possible values are 'iLO', 'iLO2' and 'iLO3', depending on 2343how modern the server is. 2344 2345=item fw_version() 2346 2347 # something like 1.26 2348 print $ilo->fw_version; 2349 2350Returns the version of iLO firmware currently running. 2351 2352=item fw_date() 2353 2354 # format is Nov 17 2006 2355 print $ilo->fw_date; 2356 2357Returns the date the iLO firmware was released. 2358 2359=item ssh_status() 2360 2361 # either 'Y' or 'N' 2362 print $ilo->ssh_status; 2363 2364 # disable SSH access to iLO 2365 $ilo->ssh_status('No'); 2366 2367Returns or modifies whether SSH access is enabled on the iLO. 2368Gives 'Y' if SSH is enabled and 'N' if SSH is disabled. 2369 2370=item ssh_port() 2371 2372 if ($ilo->ssh_port == 22) { 2373 2374 $ilo->ssh_port(12345); 2375 2376 } 2377 2378Returns or sets the port iLO will listen on for incoming SSH connections. 2379This should be an integer between 0 and 65535. 2380 2381Changing the SSH port causes the iLO processor to reset, it should become 2382available again within about 30 seconds. 2383 2384=item http_port() 2385 2386 # default is 80 2387 print $ilo->http_port; 2388 2389 $ilo->http_port(8000); 2390 2391Returns or sets the port iLO's http service listens on. Valid port numbers 2392are between 0 and 65535. 2393 2394Changing the HTTP port causes the iLO processor to reset, it should become 2395available again within about 30 seconds. 2396 2397=item https_port() 2398 2399 # default is 443 2400 print $ilo->https_port; 2401 2402 $ilo->https_port(554); 2403 2404Returns or sets the port iLO's https service listens on. Valid port numbers 2405are between 0 and 65535. 2406 2407Changing the HTTPS port causes the iLO processor to reset, it should become 2408available again within about 30 seconds. 2409 2410=item session_timeout() 2411 2412 # default is 30 2413 print $ilo->session_timeout; 2414 2415Returns the current session timeout in minutes. This applies to all sessions, 2416eg. http, https, ssh, etc. 2417 2418=back 2419 2420=head2 USER MANAGEMENT 2421 2422=over 2423 2424=item add_user() 2425 2426 # add a user with admin privileges 2427 $ilo->add_user({ 2428 name => 'John Doe', 2429 username => 'jdoe', 2430 password => 'secret', 2431 admin => 'Yes', 2432 }); 2433 2434 # add a regular user with no privileges 2435 $ilo->add_user({ 2436 name => 'Jim Beam', 2437 username => 'jbeam', 2438 password => 'secret', 2439 }); 2440 2441 # add a regular user with full privileges (aside from managing users) 2442 # 2443 # for a detailed discussion of what each privilege provides, please see 2444 # the document 'HP Integrated Lights-Out Management Processor Scripting and 2445 # Command Line Resource Guide' 2446 # 2447 # if unspecified, default for each privilege is 'No'. 2448 2449 $ilo->add_user({ 2450 name => 'Jack Daniels', 2451 username => 'jdaniels', 2452 password => 'secret', 2453 remote_console_privilege => 'Yes', 2454 reset_privilege => 'Yes', 2455 virtual_media_privilege => 'Yes', 2456 config_ilo_privilege => 'Yes', 2457 view_logs_privilege => 'Yes', 2458 clear_logs_privilege => 'Yes', 2459 update_ilo_privilege => 'Yes', 2460 }) 2461 2462Adds an iLO user. Admin users have full priveleges, including the ability to 2463add and remove other users. Non-admin users have configurable privileges which 2464default to disabled. The subset of permissions implemented is listed above. 2465Users can log in to iLO via any interface, ie. HTTPS, SSH, etc. When adding a 2466non-admin user, passing in the parameter admin => 'No' is also acceptable. 2467 2468=item mod_user() 2469 2470 # change current user's password 2471 # in this case username is optional 2472 2473 $ilo->mod_user({ 2474 password => 'supersecret', 2475 }); 2476 2477 # change another user's password 2478 # this requires administrator privileges 2479 2480 $ilo->mod_user({ 2481 username => 'guest', 2482 password => 'changem3!', 2483 }); 2484 2485Method for modifying existing user accounts. Currently this method is 2486only able to change user's passwords; it cannot change permission 2487levels. 2488 2489Passwords may consist of up to 39 printable characters. If you exceed 2490the maximum password length, an error to that effect will be returned. 2491 2492If you update the current user's password the stored password used for 2493logging in will be updated automatically. 2494 2495=item del_user() 2496 2497 # you're fired! 2498 $ilo->del_user('jbeam'); 2499 2500Removes an existing user from the iLO. 2501 2502=back 2503 2504=head2 MISCELLANEOUS 2505 2506=over 2507 2508=item uid() 2509 2510 if ($ilo->uid eq 'on') { 2511 2512 $ilo->uid('off'); 2513 2514 } 2515 2516Get the status of or control the machine's UID light. 2517 2518Called without parameters simply returns the current status, either 2519'on' or 'off'. 2520 2521You may pass values 'on' or 'off' to this method however be careful not to 2522set the uid light to on when it is currently on, and vice versa, as this 2523could throw an error, depending on iLO firmware version. 2524 2525An error will be returned if you pass an invalid state. 2526 2527 $ilo->uid('blinking') or die $ilo->error; 2528 2529 State blinking is not valid at /somescript.pl line 13. 2530 2531=back 2532 2533=head1 DIAGNOSTICS 2534 2535=over 2536 2537=item C<User login name was not found> 2538 2539General authentication error, eg. bad username or password when logging in. 2540 2541Could also mean you attempted to change the settings (eg. password) for a 2542user which doesn't exist 2543 2544=item C<Method not supported by this iLO version> 2545 2546Either your machine / iLO firmware version is too old, or the method you called 2547requires a more advanced license than you have. 2548 2549=item C<State %s is not valid> 2550 2551An invalid UID state was passed to uid(). Valid states are 'on' and 'off'. 2552 2553=item C<Unable to establish SSL connection with %s:%d [%s]> 2554 2555An error occurred while connecting to iLO. The message in brackets is 2556propagated from IO::Socket::SSL, and is rarely useful. 2557 2558=item C<Error transmitting command to server> 2559 2560A connection was established, but something went wrong while sending the 2561command to the remote iLO. Try reconnecting, and ensure that your 2562network settings are correct. 2563 2564=item C<No response received from remote machine> 2565 2566A connection was established and a command successfully sent to the iLO, but 2567no data was received. Again, ensure that your network settings are correct. 2568 2569There could also be something wrong with the remote iLO management processor. 2570Troubleshooting is beyond the scope of this document. 2571 2572=item C<Error parsing response: %s> 2573 2574An error occurred while parsing the XML response from the iLO. The error 2575message is propagated from XML::Simple, and could mean HP changed the iLO 2576API. 2577 2578=back 2579 2580=head1 DEPENDENCIES 2581 2582 IO::Socket::SSL 2583 XML::Simple 2584 2585=head1 AUTHOR 2586 2587Nicholas Lewis, C<< <nick.lewis at gmail.com> >> 2588 2589=head1 BUGS 2590 2591Please report any bugs or feature requests to C<bug-net-ilo at rt.cpan.org>, or through 2592the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-ILO>. I will be notified, and then you'll 2593automatically be notified of progress on your bug as I make changes. 2594 2595 2596=head1 SUPPORT 2597 2598You can find documentation for this module with the perldoc command. 2599 2600 perldoc Net::ILO 2601 2602 2603You can also look for information at: 2604 2605=over 4 2606 2607=item * RT: CPAN's request tracker 2608 2609L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-ILO> 2610 2611=item * AnnoCPAN: Annotated CPAN documentation 2612 2613L<http://annocpan.org/dist/Net-ILO> 2614 2615=item * CPAN Ratings 2616 2617L<http://cpanratings.perl.org/d/Net-ILO> 2618 2619=item * Search CPAN 2620 2621L<http://search.cpan.org/dist/Net-ILO> 2622 2623=back 2624 2625 2626=head1 COPYRIGHT & LICENSE 2627 2628Copyright 2011 Nicholas Lewis, all rights reserved. 2629 2630This program is free software; you can redistribute it and/or modify it 2631under the same terms as Perl itself. 2632 2633 2634=cut 2635 2636