/[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 17 by dpavlin, Mon May 21 17:41:32 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    
# Line 15  $SOAP::Constants::DO_NOT_CHECK_MUSTUNDER Line 16  $SOAP::Constants::DO_NOT_CHECK_MUSTUNDER
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,
# Line 22  my $daemon = SOAP::Transport::HTTP::Daem Line 25  my $daemon = SOAP::Transport::HTTP::Daem
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',                  'http://schemas.xmlsoap.org/soap/envelope/' => $cwmp,
30          })          })
31  ;  ;
32    
# Line 33  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 76  sub new { Line 81  sub new {
81    
82  my $ID;  my $ID;
83    
84  my @queue = qw/  my @queue;
85          GetRPCMethods  
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) = @_;
# Line 115  sub Fault { Line 148  sub Fault {
148          return;          return;
149  }  }
150    
151  sub consume_queue {  ## special handling of empty POST request from CPE
         my @results = ( SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1) );  
         if ( ! @queue ) {  
                 push @results, SOAP::Header->name('NoMoreRequests' => 1)->prefix('cwmp');  
         } else {  
                 my $op = shift @queue;  
                 push @results, SOAP::Data->name( $op )->prefix('cwmp');  
         }  
         warn "consume queue results = ", dump( @results );  
         return @results;  
 }  
152    
153  sub empty_request {  sub empty_request {
154          my (undef, $self) = @_;          my (undef, $self) = @_;
155    
156          if ( ! @queue ) {  #       warn "empty_request headers = ",dump( $self->request->headers );
                 return '';  
         }  
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);
# Line 148  sub empty_request { Line 169  sub empty_request {
169  #               )->prefix('cwmp'),  #               )->prefix('cwmp'),
170          );          );
171    
172          push @results, consume_queue;  
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
# Line 159  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    
 sub envelope_only {  
         warn "envelope_only = ", dump( @_ );  
   
         return;  
 }  
Legend:
Removed from v.17  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26