8 |
use HTTP::Cookies; |
use HTTP::Cookies; |
9 |
use CGI::Simple::Cookie; |
use CGI::Simple::Cookie; |
10 |
|
|
11 |
SOAP::Trace->import( 'all' ); |
#SOAP::Trace->import( 'all' ); |
12 |
|
|
13 |
# Eh... |
# Eh... |
14 |
$SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND = 1; |
$SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND = 1; |
21 |
Reuse => 1, |
Reuse => 1, |
22 |
#'Listen' => 128, |
#'Listen' => 128, |
23 |
) |
) |
24 |
->dispatch_with( |
->dispatch_with({ |
25 |
{ 'urn:dslforum-org:cwmp-1-0' => 'CWMP'}, |
'urn:dslforum-org:cwmp-1-0' => 'CWMP', |
26 |
) |
'http://schemas.xmlsoap.org/soap/envelope/' => 'CWMP', |
27 |
|
}) |
28 |
; |
; |
29 |
|
|
30 |
my $cookies = new CGI::Simple::Cookie( |
my $cookies = new CGI::Simple::Cookie( |
76 |
|
|
77 |
my $ID; |
my $ID; |
78 |
|
|
79 |
|
my @queue = qw/ |
80 |
|
GetRPCMethods |
81 |
|
/; |
82 |
|
|
83 |
sub Inform { |
sub Inform { |
84 |
my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_; |
my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_; |
85 |
|
|
96 |
|
|
97 |
warn "request $ID from ", dump( $DeviceId ), " with events ",dump( $Event ), "maxEnvelopes: $MaxEnvelopes on $CurrentTime retry $RetryCount params ", dump( $p ); |
warn "request $ID from ", dump( $DeviceId ), " with events ",dump( $Event ), "maxEnvelopes: $MaxEnvelopes on $CurrentTime retry $RetryCount params ", dump( $p ); |
98 |
|
|
99 |
return SOAP::Data->name('MaxEnvelopes' => $MaxEnvelopes); |
return SOAP::Data->name('MaxEnvelopes' => 1); |
100 |
} |
} |
101 |
|
|
102 |
sub GetParameterValuesResponse { |
sub GetParameterValuesResponse { |
103 |
|
my $self = shift; |
104 |
|
|
105 |
warn "GetParameterValuesResponse ",dump( @_ ); |
warn "GetParameterValuesResponse ",dump( @_ ); |
106 |
|
|
107 |
|
return; |
108 |
|
} |
109 |
|
|
110 |
|
sub Fault { |
111 |
|
my $self = shift; |
112 |
|
|
113 |
|
warn "Fault ",dump( @_ ); |
114 |
|
|
115 |
|
return; |
116 |
|
} |
117 |
|
|
118 |
|
sub consume_queue { |
119 |
|
my @results = ( SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1) ); |
120 |
|
if ( ! @queue ) { |
121 |
|
push @results, SOAP::Header->name('NoMoreRequests' => 1)->prefix('cwmp'); |
122 |
|
} else { |
123 |
|
my $op = shift @queue; |
124 |
|
push @results, SOAP::Data->name( $op )->prefix('cwmp'); |
125 |
|
} |
126 |
|
warn "consume queue results = ", dump( @results ); |
127 |
|
return @results; |
128 |
} |
} |
129 |
|
|
130 |
sub empty_request { |
sub empty_request { |
131 |
my (undef, $self) = @_; |
my (undef, $self) = @_; |
132 |
|
|
133 |
|
if ( ! @queue ) { |
134 |
|
return ''; |
135 |
|
} |
136 |
|
|
137 |
$self->serializer->soapversion(SOAP::Lite->soapversion); |
$self->serializer->soapversion(SOAP::Lite->soapversion); |
138 |
$self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA); |
$self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA); |
139 |
|
|
140 |
my @results = ( |
my @results = ( |
141 |
SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1), |
# SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1), |
142 |
SOAP::Data->name('GetParameterValues' => |
# SOAP::Data->name('GetParameterValues' => |
143 |
\SOAP::Data->value( 'ParametarNames' => [ |
# SOAP::Data->value( 'ParametarNames' => [ |
144 |
'InternetGatewayDevice.ManagementServer.', |
# 'InternetGatewayDevice.ManagementServer.', |
145 |
'a.', 'a.b.', 'a.b.c.', |
# 'a.', 'a.b.', 'a.b.c.', |
146 |
]), |
# ], |
147 |
)->prefix('cwmp'), |
# ), |
148 |
|
# )->prefix('cwmp'), |
149 |
); |
); |
150 |
|
|
151 |
|
push @results, consume_queue; |
152 |
|
|
153 |
my $result = $self->serializer |
my $result = $self->serializer |
154 |
# ->prefix('s') # distinguish generated element names between client and server |
# ->prefix('s') # distinguish generated element names between client and server |
155 |
# ->uri('urn:dslforum-org:cwmp-1-0') |
# ->uri('urn:dslforum-org:cwmp-1-0') |
163 |
|
|
164 |
return $result; |
return $result; |
165 |
} |
} |
166 |
|
|
167 |
|
sub envelope_only { |
168 |
|
warn "envelope_only = ", dump( @_ ); |
169 |
|
|
170 |
|
return; |
171 |
|
} |