1 |
package Intel::AMT::Redir; |
2 |
|
3 |
use warnings; |
4 |
use strict; |
5 |
|
6 |
use IO::Socket::INET; |
7 |
use Data::Dump qw/dump/; |
8 |
|
9 |
our $sock; |
10 |
|
11 |
my $MAX_TRANSMIT_BUFFER = 1000; |
12 |
my $TRANSMIT_BUFFER_TIMEOUT = 100; |
13 |
my $TRANSMIT_OVERFLOW_TIMEOUT = 0; |
14 |
my $HOST_SESSION_RX_TIMEOUT = 10000; |
15 |
my $HOST_FIFO_RX_FLUSH_TIMEOUT = 0; |
16 |
my $HEARTBEAT_INTERVAL = 5000; |
17 |
|
18 |
sub connect { |
19 |
my ( $host ) = shift; |
20 |
my $port = 16994; |
21 |
|
22 |
my $user = 'admin'; |
23 |
my $passwd = $ENV{AMT_PASSWORD}; |
24 |
|
25 |
warn 'connect ', $host, ':', $port; |
26 |
|
27 |
$sock = IO::Socket::INET->new( |
28 |
PeerAddr => $host, |
29 |
PeerPort => $port, |
30 |
); |
31 |
|
32 |
$sock->autoflush(1); |
33 |
|
34 |
put( pack('C4A4', 0x10, 0, 0, 0, "SOL ") |
35 |
, 'start redirection session' ); |
36 |
get( 0x11, 13 |
37 |
, 'start redirection session reply' ); |
38 |
|
39 |
my $credentials = pack('CA*CA*', length($user), $user, length($passwd), $passwd); |
40 |
|
41 |
put( pack('C9', 0x13, 0, 0, 0, 0x01, length($credentials), 0, 0, 0) . $credentials |
42 |
, 'autheniticate session' ); |
43 |
get( 0x14, 9 |
44 |
, 'authenticate session reply' ); |
45 |
|
46 |
put( |
47 |
pack('C8v6C4', |
48 |
0x20, 0,0,0, |
49 |
0,0,0,0, |
50 |
$MAX_TRANSMIT_BUFFER, |
51 |
$TRANSMIT_BUFFER_TIMEOUT, |
52 |
$TRANSMIT_OVERFLOW_TIMEOUT, |
53 |
$HOST_SESSION_RX_TIMEOUT, |
54 |
$HOST_FIFO_RX_FLUSH_TIMEOUT, |
55 |
$HEARTBEAT_INTERVAL, |
56 |
0,0,0,0, |
57 |
) |
58 |
, 'start sol redirection' ); |
59 |
get( 0x21, 23 |
60 |
, 'start sol redirection reply' ); |
61 |
|
62 |
my $send = "\r"; |
63 |
|
64 |
put( |
65 |
pack('C8v', 0x28,0,0,0, 0,0,0,0, length($send) ) . $send, |
66 |
'sol data to host' |
67 |
); |
68 |
my $host = get( 0x2a, -10, 'sol data from host' ); |
69 |
|
70 |
warn "$host\n"; |
71 |
|
72 |
put( |
73 |
pack('C8', 0x22,0,0,0, 0,0,0,0), |
74 |
'end sol redirection' |
75 |
); |
76 |
get( 0x23, 8, 'end sol redirection reply' ); |
77 |
|
78 |
put( pack('C4', 0x12,0,0,0 ), 'XXX close' ); |
79 |
|
80 |
close($sock); |
81 |
|
82 |
} |
83 |
|
84 |
sub hdump { |
85 |
my ($data,$desc) = @_; |
86 |
my $out = unpack('H*', $data); |
87 |
$out =~ s/(.{16})/$1 /g; |
88 |
$out =~ s/(\S\S)/$1 /g; |
89 |
warn $desc ? "# $desc\n$out\n" : "$out\n"; |
90 |
} |
91 |
|
92 |
sub put { |
93 |
my ( $data, $desc ) = @_; |
94 |
hdump $data, $desc; |
95 |
syswrite $sock, $data, length($data); |
96 |
} |
97 |
|
98 |
sub get { |
99 |
my ( $expect, $len, $desc ) = @_; |
100 |
|
101 |
my $reply; |
102 |
sysread $sock,$reply,abs($len); |
103 |
hdump $reply, $desc; |
104 |
|
105 |
my ( $op, $error ) = unpack('CC', $reply); |
106 |
die "expected $expect got $op" unless $op == $expect; |
107 |
die "error" unless $error == 0x00; |
108 |
|
109 |
if ( $len < 0 ) { |
110 |
$len = unpack('x8v', $reply); |
111 |
warn "len: $len\n"; |
112 |
sysread $sock, $reply, $len; |
113 |
hdump $reply, 'data'; |
114 |
} |
115 |
|
116 |
return $reply; |
117 |
} |
118 |
|
119 |
1; |
120 |
|