cwmp/google/acs.pl

#!/usr/bin/perl

use warnings;
use strict;

use lib 'lib';
use SOAP::Transport::HTTP +trace => 'debug';
use HTTP::Cookies;
use CGI::Simple::Cookie;

SOAP::Trace->import( 'all' );

# Eh...
$SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND = 1;

$SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C

my $daemon = SOAP::Transport::HTTP::Daemon->new(
        #LocalAddr => 'localhost',
        LocalPort => 3333,
        Reuse => 1,
        #'Listen' => 128,
)
        ->dispatch_with(
                { 'urn:dslforum-org:cwmp-1-0' => 'CWMP'},
        )
;

my $cookies = new CGI::Simple::Cookie(
        -name => 'foo',
        -value => 'bar',
);
$daemon->options->{simple_cookie} = $cookies;

print "Contact to ACS server at ", $daemon->url, "\n";
$daemon->handle;

package CWMP;
use strict;

use Data::Dump qw/dump/;
use Carp qw/cluck/;

sub new {
        bless {}, shift;
}

# CPE methods             Responding  Calling
#
# GetRPCMethods           Required    Optional
# SetParameterValues      Required    Required
# GetParameterValues      Required    Required
# GetParameterNames       Required    Required
# SetParameterAttributes  Required    Optional
# GetParameterAttributes  Required    Optional
# AddObject               Required    Optional
# DeleteObject            Required    Optional
# Reboot                  Required    Optional
# Download                Required    Required
# Upload                  Optional    Optional
# FactoryReset            Optional    Optional
# GetQueuedTransfers      Optional    Optional
# ScheduleInform          Optional    Optional
# SetVouchers             Optional    Optional
# GetOptions              Optional    Optional

# Server methods   Calling    Responding
#
# GetRPCMethods    Optional   Required
# Inform           Required   Required
# TransferComplete Required   Required
# RequestDownload  Optional   Optional
# Kicked           Optional   Optional


my $ID;

sub Inform {
        my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_;

        my $p;

        #cluck dump( $daemon );
        #warn dump( $headers );

        $ID = ( grep { $_->name eq 'ID' } @$headers )[0]->value;

        foreach ( @$ParameterList ) {
                $p->{ $_->{Name} } = $_->{Value};
        }

        warn "request $ID from ", dump( $DeviceId ), " with events ",dump( $Event ), "maxEnvelopes: $MaxEnvelopes on $CurrentTime retry $RetryCount params ", dump( $p );

        return SOAP::Data->name('MaxEnvelopes' => $MaxEnvelopes);
}

sub GetParameterValuesResponse {
        warn "GetParameterValuesResponse ",dump( @_ );
}

sub empty_request {
        my (undef, $self) = @_;

    $self->serializer->soapversion(SOAP::Lite->soapversion);
    $self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);

        my @results = (
                SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1),
                SOAP::Data->name('GetParameterValues' =>
                        \SOAP::Data->value( 'ParametarNames' => [
                                'InternetGatewayDevice.ManagementServer.',
                                'a.', 'a.b.', 'a.b.c.',
                        ]),
                )->prefix('cwmp'),
        );

    my $result = $self->serializer
#      ->prefix('s') # distinguish generated element names between client and server
#      ->uri('urn:dslforum-org:cwmp-1-0')
          ->ns('urn:dslforum-org:cwmp-1-0', 'cwmp')
      ->envelope( freeform => @results );

        my $xml = $result;
        $xml =~ s/</\n</gs;

        print "empty request result: $xml\n", dump( $self->request->headers, $self->response->headers, $self->packager->headers_http );

        return $result;
}
1	#!/usr/bin/perl
2
3	use warnings;
4	use strict;
5
6	use lib 'lib';
7	use SOAP::Transport::HTTP +trace => 'debug';
8	use HTTP::Cookies;
9	use CGI::Simple::Cookie;
10
11	SOAP::Trace->import( 'all' );
12
13	# Eh...
14	$SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND = 1;
15
16	$SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C
17
18	my $daemon = SOAP::Transport::HTTP::Daemon->new(
19	#LocalAddr => 'localhost',
20	LocalPort => 3333,
21	Reuse => 1,
22	#'Listen' => 128,
23	)
24	->dispatch_with(
25	{ 'urn:dslforum-org:cwmp-1-0' => 'CWMP'},
26	)
27	;
28
29	my $cookies = new CGI::Simple::Cookie(
30	-name => 'foo',
31	-value => 'bar',
32	);
33	$daemon->options->{simple_cookie} = $cookies;
34
35	print "Contact to ACS server at ", $daemon->url, "\n";
36	$daemon->handle;
37
38	package CWMP;
39	use strict;
40
41	use Data::Dump qw/dump/;
42	use Carp qw/cluck/;
43
44	sub new {
45	bless {}, shift;
46	}
47
48	# CPE methods Responding Calling
49	#
50	# GetRPCMethods Required Optional
51	# SetParameterValues Required Required
52	# GetParameterValues Required Required
53	# GetParameterNames Required Required
54	# SetParameterAttributes Required Optional
55	# GetParameterAttributes Required Optional
56	# AddObject Required Optional
57	# DeleteObject Required Optional
58	# Reboot Required Optional
59	# Download Required Required
60	# Upload Optional Optional
61	# FactoryReset Optional Optional
62	# GetQueuedTransfers Optional Optional
63	# ScheduleInform Optional Optional
64	# SetVouchers Optional Optional
65	# GetOptions Optional Optional
66
67	# Server methods Calling Responding
68	#
69	# GetRPCMethods Optional Required
70	# Inform Required Required
71	# TransferComplete Required Required
72	# RequestDownload Optional Optional
73	# Kicked Optional Optional
74
75
76	my $ID;
77
78	sub Inform {
79	my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_;
80
81	my $p;
82
83	#cluck dump( $daemon );
84	#warn dump( $headers );
85
86	$ID = ( grep { $_->name eq 'ID' } @$headers )[0]->value;
87
88	foreach ( @$ParameterList ) {
89	$p->{ $_->{Name} } = $_->{Value};
90	}
91
92	warn "request $ID from ", dump( $DeviceId ), " with events ",dump( $Event ), "maxEnvelopes: $MaxEnvelopes on $CurrentTime retry $RetryCount params ", dump( $p );
93
94	return SOAP::Data->name('MaxEnvelopes' => $MaxEnvelopes);
95	}
96
97	sub GetParameterValuesResponse {
98	warn "GetParameterValuesResponse ",dump( @_ );
99	}
100
101	sub empty_request {
102	my (undef, $self) = @_;
103
104	$self->serializer->soapversion(SOAP::Lite->soapversion);
105	$self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);
106
107	my @results = (
108	SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1),
109	SOAP::Data->name('GetParameterValues' =>
110	\SOAP::Data->value( 'ParametarNames' => [
111	'InternetGatewayDevice.ManagementServer.',
112	'a.', 'a.b.', 'a.b.c.',
113	]),
114	)->prefix('cwmp'),
115	);
116
117	my $result = $self->serializer
118	# ->prefix('s') # distinguish generated element names between client and server
119	# ->uri('urn:dslforum-org:cwmp-1-0')
120	->ns('urn:dslforum-org:cwmp-1-0', 'cwmp')
121	->envelope( freeform => @results );
122
123	my $xml = $result;
124	$xml =~ s/</\n</gs;
125
126	print "empty request result: $xml\n", dump( $self->request->headers, $self->response->headers, $self->packager->headers_http );
127
128	return $result;
129	}