/[Intel-AMT]/trunk/lib/Intel/AMT/SOAP.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/lib/Intel/AMT/SOAP.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 23 - (hide annotations)
Mon Sep 14 14:15:08 2009 UTC (14 years, 7 months ago) by dpavlin
File size: 8632 byte(s)
added configurable timeout (by default 1s) to prevent long hangs if AMT is not available

1 dpavlin 2 package Intel::AMT::SOAP;
2    
3     # based on amttool from amtterm 1.2 from http://dl.bytesex.org/releases/amtterm/
4    
5     use strict;
6     use warnings;
7     use SOAP::Lite;
8     #use SOAP::Lite +trace => 'all';
9 dpavlin 5 use Data::Dump qw/dump/;
10 dpavlin 2
11 dpavlin 5 use lib 'lib';
12    
13 dpavlin 16 sub soap_url {
14     my $amt_host = $ENV{'AMT_HOST'};
15     my $amt_port = "16992";
16     "http://$amt_host:$amt_port";
17     }
18    
19 dpavlin 2 my $amt_debug = 0;
20     $amt_debug = $ENV{'AMT_DEBUG'} if defined($ENV{'AMT_DEBUG'});
21    
22 dpavlin 23 my $timeout = $ENV{'AMT_TIMEOUT'} || 1;
23    
24 dpavlin 2 my $amt_version;
25    
26     #############################################################################
27     # data
28    
29     my @ps = ("S0", "S1", "S2", "S3", "S4", "S5 (soft-off)", "S4/S5", "Off");
30    
31     # incomplete list
32     my %pt_status = (
33     0x0 => "success",
34     0x1 => "internal error",
35     0x3 => "invalid pt_mode",
36     0xc => "invalid name",
37     0xf => "invalid byte_count",
38     0x10 => "not permitted",
39     0x17 => "max limit_reached",
40     0x18 => "invalid auth_type",
41     0x1a => "invalid dhcp_mode",
42     0x1b => "invalid ip_address",
43     0x1c => "invalid domain_name",
44     0x20 => "invalid provisioning_state",
45     0x22 => "invalid time",
46     0x23 => "invalid index",
47     0x24 => "invalid parameter",
48     0x25 => "invalid netmask",
49     0x26 => "flash write_limit_exceeded",
50     0x800 => "network if_error_base",
51     0x801 => "unsupported oem_number",
52     0x802 => "unsupported boot_option",
53     0x803 => "invalid command",
54     0x804 => "invalid special_command",
55     0x805 => "invalid handle",
56     0x806 => "invalid password",
57     0x807 => "invalid realm",
58     0x808 => "storage acl_entry_in_use",
59     0x809 => "data missing",
60     0x80a => "duplicate",
61     0x80b => "eventlog frozen",
62     0x80c => "pki missing_keys",
63     0x80d => "pki generating_keys",
64     0x80e => "invalid key",
65     0x80f => "invalid cert",
66     0x810 => "cert key_not_match",
67     0x811 => "max kerb_domain_reached",
68     0x812 => "unsupported",
69     0x813 => "invalid priority",
70     0x814 => "not found",
71     0x815 => "invalid credentials",
72     0x816 => "invalid passphrase",
73     0x818 => "no association",
74     );
75    
76    
77     #############################################################################
78     # soap setup
79    
80     my ($nas, $sas, $rcs);
81    
82     sub SOAP::Transport::HTTP::Client::get_basic_credentials {
83 dpavlin 16 return 'admin' => $ENV{AMT_PASSWORD};
84 dpavlin 2 }
85    
86 dpavlin 5 sub init() {
87 dpavlin 16 my $proxybase = soap_url;
88 dpavlin 2 my $schemabase = "http://schemas.intel.com/platform/client";
89    
90     $nas = SOAP::Lite->new(
91     proxy => "$proxybase/NetworkAdministrationService",
92     default_ns => "$schemabase/NetworkAdministration/2004/01");
93     $sas = SOAP::Lite->new(
94     proxy => "$proxybase/SecurityAdministrationService",
95     default_ns => "$schemabase/SecurityAdministration/2004/01");
96     $rcs = SOAP::Lite->new(
97     proxy => "$proxybase/RemoteControlService",
98     default_ns => "$schemabase/RemoteControl/2004/01");
99    
100     $nas->autotype(0);
101     $sas->autotype(0);
102     $rcs->autotype(0);
103    
104 dpavlin 23 $nas->transport->timeout($timeout);
105     $sas->transport->timeout($timeout);
106     $rcs->transport->timeout($timeout);
107    
108 dpavlin 5 warn $proxybase;
109    
110 dpavlin 2 $amt_version = $sas->GetCoreVersion()->paramsout;
111     }
112    
113 dpavlin 6 sub _soap {
114     my $name = shift;
115 dpavlin 2
116 dpavlin 16 my $proxybase = soap_url;
117 dpavlin 6 my $schemabase = "http://schemas.intel.com/platform/client";
118    
119     warn "call_soap $proxybase $name ",dump( @_ );
120    
121     my $soap = SOAP::Lite->new(
122     proxy => "$proxybase/${name}Service",
123     default_ns => "$schemabase/$name/2004/01");
124    
125     $soap->autotype(0);
126 dpavlin 23 $soap->transport->timeout($timeout);
127 dpavlin 6
128     if ( @_ ) {
129 dpavlin 7 do_soap($soap, $name, @_)
130 dpavlin 6 } else {
131     return $soap;
132     }
133     }
134    
135    
136 dpavlin 2 #############################################################################
137     # functions
138    
139     sub usage() {
140     print STDERR <<EOF;
141    
142     This utility can talk to Intel AMT managed machines.
143    
144     usage: amttool <hostname> [ <command> ] [ <arg(s)> ]
145     commands:
146     info - print some machine info (default).
147     reset - reset machine.
148     powerup - turn on machine.
149     powerdown - turn off machine.
150     powercycle - powercycle machine.
151    
152     AMT 2.5+ only:
153     netinfo - print network config.
154     netconf <args> - configure network (check manpage).
155    
156     Password is passed via AMT_PASSWORD environment variable.
157    
158     EOF
159     }
160    
161     sub print_result($) {
162     my $ret = shift;
163     my $rc = $ret->result;
164     my $msg;
165    
166     if (!defined($rc)) {
167     $msg = "soap failure";
168 dpavlin 5 warn dump( $ret->faultdetail );
169 dpavlin 2 } elsif (!defined($pt_status{$rc})) {
170     $msg = sprintf("unknown pt_status code: 0x%x", $rc);
171     } else {
172     $msg = "pt_status: " . $pt_status{$rc};
173     }
174     printf "result: %s\n", $msg;
175     }
176    
177     sub print_paramsout($) {
178     my $ret = shift;
179     my @paramsout = $ret->paramsout;
180     print "params: " . join(", ", @paramsout) . "\n";
181     }
182    
183     sub print_hash {
184     my $hash = shift;
185     my $in = shift;
186     my $wi = shift;
187    
188     foreach my $item (sort keys %{$hash}) {
189     if (ref($hash->{$item}) eq "HASH") {
190     # printf "%*s%s\n", $in, "", $item;
191     next;
192     }
193     printf "%*s%-*s%s\n", $in, "", $wi, $item, $hash->{$item};
194     }
195     }
196    
197     sub print_hash_ipv4 {
198     my $hash = shift;
199     my $in = shift;
200     my $wi = shift;
201    
202     foreach my $item (sort keys %{$hash}) {
203     my $addr = sprintf("%d.%d.%d.%d",
204     $hash->{$item} / 256 / 256 / 256,
205     $hash->{$item} / 256 / 256 % 256,
206     $hash->{$item} / 256 % 256,
207     $hash->{$item} % 256);
208     printf "%*s%-*s%s\n", $in, "", $wi, $item, $addr;
209     }
210     }
211    
212     sub do_soap {
213     my $soap = shift;
214     my $name = shift;
215     my @args = @_;
216     my $method;
217    
218     $method = SOAP::Data->name($name)
219     ->attr( { xmlns => $soap->ns } );
220    
221     if ($amt_debug) {
222     print "-- \n";
223     open XML, "| xmllint --format -";
224     print XML $soap->serializer->envelope(method => $method, @_);
225     close XML;
226     print "-- \n";
227     }
228    
229     my $ret = $soap->call($method, @args);
230     print_result($ret);
231     return $ret;
232     }
233    
234     sub check_amt_version {
235     my $major = shift;
236     my $minor = shift;
237    
238     $amt_version =~ m/^(\d+).(\d+)/;
239     return if $1 > $major;
240     return if $1 == $major && $2 >= $minor;
241     die "version mismatch (need >= $major.$minor, have $amt_version)";
242     }
243    
244     sub print_general_info() {
245    
246     printf "AMT version: %s\n", $amt_version;
247    
248     my $hostname = $nas->GetHostName()->paramsout;
249     my $domainname = $nas->GetDomainName()->paramsout;
250     printf "Hostname: %s.%s\n", $hostname, $domainname;
251    
252     my $powerstate = $rcs->GetSystemPowerState()->paramsout;
253     printf "Powerstate: %s\n", $ps [ $powerstate & 0x0f ];
254     }
255 dpavlin 5
256 dpavlin 2 sub print_network_info() {
257     my $ret;
258    
259     $ret = $nas->EnumerateInterfaces();
260     my @if = $ret->paramsout;
261     foreach my $if (@if) {
262     printf "Network Interface %s:\n", $if;
263     my $arg = SOAP::Data->name('InterfaceHandle' => $if);
264     $ret = $nas->GetInterfaceSettings($arg);
265     my $desc = $ret->paramsout;
266     print_hash($ret->paramsout, 4, 32);
267     print_hash_ipv4($ret->paramsout->{'IPv4Parameters'}, 8, 28);
268     }
269     }
270    
271     sub ipv4_addr($$) {
272     my $name = shift;
273     my $ipv4 = shift;
274    
275     $ipv4 =~ m/(\d+).(\d+).(\d+).(\d+)/ or die "parse ipv4 address: $ipv4";
276     my $num = $1 * 256 * 256 * 256 +
277     $2 * 256 * 246 +
278     $3 * 256 +
279     $4;
280     printf STDERR "ipv4 %-24s: %-16s -> %d\n", $name, $ipv4, $num
281     if $amt_debug;
282     return SOAP::Data->name($name => $num);
283     }
284    
285     sub configure_network {
286     my $if = shift;
287     my $link = shift;
288     my $ip = shift;
289     my $mask = shift;
290     my $gw = shift;
291     my $dns1 = shift;
292     my $dns2 = shift;
293    
294     my $mode;
295     my @ifdesc;
296     my @ipv4;
297    
298     my $method;
299     my @args;
300    
301     # build argument structs ...
302     die "no interface" if !defined($if);
303     die "no linkpolicy" if !defined($link);
304     if (defined($ip)) {
305     $mode = "SEPARATE_MAC_ADDRESS";
306     die "no ip mask" if !defined($mask);
307     die "no default gw" if !defined($gw);
308     $dns1 = $gw if !defined($dns1);
309     $dns2 = "0.0.0.0" if !defined($dns2);
310     push (@ipv4, ipv4_addr("LocalAddress", $ip));
311     push (@ipv4, ipv4_addr("SubnetMask", $mask));
312     push (@ipv4, ipv4_addr("DefaultGatewayAddress", $gw));
313     push (@ipv4, ipv4_addr("PrimaryDnsAddress", $dns1));
314     push (@ipv4, ipv4_addr("SecondaryDnsAddress", $dns2));
315     } else {
316     $mode = "SHARED_MAC_ADDRESS";
317     # no ip info -- use DHCP
318     }
319    
320     push (@ifdesc, SOAP::Data->name("InterfaceMode" => $mode));
321     push (@ifdesc, SOAP::Data->name("LinkPolicy" => $link));
322     push (@ifdesc, SOAP::Data->name("IPv4Parameters" =>
323     \SOAP::Data->value(@ipv4)))
324     if @ipv4;
325    
326     push (@args, SOAP::Data->name("InterfaceHandle" => $if));
327     push (@args, SOAP::Data->name("InterfaceDescriptor" =>
328     \SOAP::Data->value(@ifdesc)));
329    
330     # perform call
331     do_soap($nas, "SetInterfaceSettings", @args);
332     }
333    
334    
335     sub command {
336     my ($amt_command,$amt_arg) = @_;
337    
338 dpavlin 5 init;
339 dpavlin 2
340     if ($amt_command eq "info") {
341     print_general_info;
342     } elsif ($amt_command eq "netinfo") {
343     check_amt_version(2,5);
344     print_network_info;
345     } elsif ($amt_command eq "netconf") {
346     check_amt_version(2,5);
347 dpavlin 5 configure_network(@_);
348 dpavlin 2 } elsif ($amt_command =~ m/^(reset|powerup|powerdown|powercycle)$/) {
349     remote_control($amt_command, $amt_arg);
350     } else {
351     print "unknown command: $amt_command\n";
352     }
353    
354     }
355    
356     warn 'loaded';
357    
358     1;

  ViewVC Help
Powered by ViewVC 1.1.26