/[cwmp]/google/acs.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /google/acs.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 15 by dpavlin, Mon May 21 15:27:38 2007 UTC revision 19 by dpavlin, Mon May 21 18:42:17 2007 UTC
# Line 7  use lib 'lib'; Line 7  use lib 'lib';
7  use SOAP::Transport::HTTP +trace => 'debug';  use SOAP::Transport::HTTP +trace => 'debug';
8  use HTTP::Cookies;  use HTTP::Cookies;
9  use CGI::Simple::Cookie;  use CGI::Simple::Cookie;
10    use Data::Dump qw/dump/;
11    
12  SOAP::Trace->import( 'all' );  #SOAP::Trace->import( 'all' );
13    
14  # Eh...  # Eh...
15  $SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND = 1;  $SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND = 1;
16    
17  $SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C  $SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C
18    
19    my $cwmp = new CWMP;
20    
21  my $daemon = SOAP::Transport::HTTP::Daemon->new(  my $daemon = SOAP::Transport::HTTP::Daemon->new(
22          #LocalAddr => 'localhost',          #LocalAddr => 'localhost',
23          LocalPort => 3333,          LocalPort => 3333,
24          Reuse => 1,          Reuse => 1,
25          #'Listen' => 128,          #'Listen' => 128,
26  )  )
27          ->dispatch_with(          ->dispatch_with({
28                  { 'urn:dslforum-org:cwmp-1-0' => 'CWMP'},                  'urn:dslforum-org:cwmp-1-0' => $cwmp,
29          )                  'http://schemas.xmlsoap.org/soap/envelope/' => $cwmp,
30            })
31  ;  ;
32    
33  my $cookies = new CGI::Simple::Cookie(  my $cookies = new CGI::Simple::Cookie(
# Line 32  my $cookies = new CGI::Simple::Cookie( Line 36  my $cookies = new CGI::Simple::Cookie(
36  );  );
37  $daemon->options->{simple_cookie} = $cookies;  $daemon->options->{simple_cookie} = $cookies;
38    
39  print "Contact to ACS server at ", $daemon->url, "\n";  $cwmp->enqueue( qw/GetRPCMethods/ );
40    
41    print "Contact to ACS server at ", $daemon->url, " queue ", dump( $cwmp->queue ),"\n";
42  $daemon->handle;  $daemon->handle;
43    
44  package CWMP;  package CWMP;
# Line 75  sub new { Line 81  sub new {
81    
82  my $ID;  my $ID;
83    
84    my @queue;
85    
86    sub enqueue {
87            my $self = shift;
88            push @queue, @_;
89    }
90    
91    sub queue {
92            my $self = shift;
93            return @queue;
94    }
95    
96    sub consume_queue {
97            my @results = ( SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1) );
98    
99    
100            my $op = shift @queue;
101    
102            if ( $op ) {
103                    push @results, SOAP::Data->name( $op )->prefix('cwmp');
104                    warn "consume_queue $op\n";
105            };
106    
107            push @results, SOAP::Header->name('NoMoreRequests' => 1)->prefix('cwmp') unless ( @queue );
108    
109            warn "## conqume_queue results = ", dump( @results );
110    
111            return @results;
112    }
113    
114    ## SOAP ACS methods
115    
116  sub Inform {  sub Inform {
117          my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_;          my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_;
118    
# Line 91  sub Inform { Line 129  sub Inform {
129    
130          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 );
131    
132          return SOAP::Data->name('MaxEnvelopes' => $MaxEnvelopes);          return SOAP::Data->name('MaxEnvelopes' => 1);
133  }  }
134    
135  sub GetParameterValuesResponse {  sub GetParameterValuesResponse {
136            my $self = shift;
137    
138          warn "GetParameterValuesResponse ",dump( @_ );          warn "GetParameterValuesResponse ",dump( @_ );
139    
140            return;
141    }
142    
143    sub Fault {
144            my $self = shift;
145    
146            warn "Fault ",dump( @_ );
147    
148            return;
149  }  }
150    
151    ## special handling of empty POST request from CPE
152    
153  sub empty_request {  sub empty_request {
154          my (undef, $self) = @_;          my (undef, $self) = @_;
155    
156    #       warn "empty_request headers = ",dump( $self->request->headers );
157    
158      $self->serializer->soapversion(SOAP::Lite->soapversion);      $self->serializer->soapversion(SOAP::Lite->soapversion);
159      $self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);      $self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);
160    
161          my @results = (          my @results = (
162                  SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1),  #               SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1),
163                  SOAP::Data->name('GetParameterValues' =>  #               SOAP::Data->name('GetParameterValues' =>
164                          \SOAP::Data->value( 'ParametarNames' => [  #                       SOAP::Data->value( 'ParametarNames' => [
165                                  'InternetGatewayDevice.ManagementServer.',  #                               'InternetGatewayDevice.ManagementServer.',
166                                  'a.', 'a.b.', 'a.b.c.',  #                               'a.', 'a.b.', 'a.b.c.',
167                          ]),  #                       ],
168                  )->prefix('cwmp'),  #                       ),
169    #               )->prefix('cwmp'),
170          );          );
171    
172    
173    
174            push @results, ( consume_queue );
175    
176      my $result = $self->serializer      my $result = $self->serializer
177  #      ->prefix('s') # distinguish generated element names between client and server  #      ->prefix('s') # distinguish generated element names between client and server
178  #      ->uri('urn:dslforum-org:cwmp-1-0')  #      ->uri('urn:dslforum-org:cwmp-1-0')
# Line 123  sub empty_request { Line 182  sub empty_request {
182          my $xml = $result;          my $xml = $result;
183          $xml =~ s/</\n</gs;          $xml =~ s/</\n</gs;
184    
185          print "empty request result: $xml\n", dump( $self->request->headers, $self->response->headers, $self->packager->headers_http );          warn "empty_request result:\n$xml\n";
186    
187    #       warn $self->response->headers;
188    
189          return $result;          return $result;
190  }  }
191    
Legend:
Removed from v.15  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26