/[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 7 by dpavlin, Sat May 19 19:13:59 2007 UTC revision 19 by dpavlin, Mon May 21 18:42:17 2007 UTC
# Line 3  Line 3 
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6    use lib 'lib';
7  use SOAP::Transport::HTTP +trace => 'debug';  use SOAP::Transport::HTTP +trace => 'debug';
8    use HTTP::Cookies;
9    use CGI::Simple::Cookie;
10    use Data::Dump qw/dump/;
11    
12    #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  # change LocalPort to 81 if you want to test it with soapmark.pl  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',
# Line 18  my $daemon = SOAP::Transport::HTTP::Daem Line 24  my $daemon = SOAP::Transport::HTTP::Daem
24          Reuse => 1,          Reuse => 1,
25          #'Listen' => 128,          #'Listen' => 128,
26  )  )
27          ->dispatch_with({ 'urn:dslforum-org:cwmp-1-0' => 'CWMP'})          ->dispatch_with({
28                    '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(
34            -name => 'foo',
35            -value => 'bar',
36    );
37    $daemon->options->{simple_cookie} = $cookies;
38    
39    $cwmp->enqueue( qw/GetRPCMethods/ );
40    
41  print "Contact to ACS server at ", $daemon->url, "\n";  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 35  sub new { Line 51  sub new {
51          bless {}, shift;          bless {}, shift;
52  }  }
53    
54    # CPE methods             Responding  Calling
55    #
56    # GetRPCMethods           Required    Optional
57    # SetParameterValues      Required    Required
58    # GetParameterValues      Required    Required
59    # GetParameterNames       Required    Required
60    # SetParameterAttributes  Required    Optional
61    # GetParameterAttributes  Required    Optional
62    # AddObject               Required    Optional
63    # DeleteObject            Required    Optional
64    # Reboot                  Required    Optional
65    # Download                Required    Required
66    # Upload                  Optional    Optional
67    # FactoryReset            Optional    Optional
68    # GetQueuedTransfers      Optional    Optional
69    # ScheduleInform          Optional    Optional
70    # SetVouchers             Optional    Optional
71    # GetOptions              Optional    Optional
72    
73  # Server methods   Calling    Responding  # Server methods   Calling    Responding
74    #
75  # GetRPCMethods    Optional   Required  # GetRPCMethods    Optional   Required
76  # Inform           Required   Required  # Inform           Required   Required
77  # TransferComplete Required   Required  # TransferComplete Required   Required
78  # RequestDownload  Optional   Optional  # RequestDownload  Optional   Optional
79  # Kicked           Optional   Optional  # Kicked           Optional   Optional
80    
81    
82    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 50  sub Inform { Line 121  sub Inform {
121          #cluck dump( $daemon );          #cluck dump( $daemon );
122          #warn dump( $headers );          #warn dump( $headers );
123    
124          my $ID = ( grep { $_->name eq 'ID' } @$headers )[0]->value;          $ID = ( grep { $_->name eq 'ID' } @$headers )[0]->value;
125    
126          foreach ( @$ParameterList ) {          foreach ( @$ParameterList ) {
127                  $p->{ $_->{Name} } = $_->{Value};                  $p->{ $_->{Name} } = $_->{Value};
# Line 58  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 {
136            my $self = shift;
137    
138            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 {
154            my (undef, $self) = @_;
155    
156    #       warn "empty_request headers = ",dump( $self->request->headers );
157    
158        $self->serializer->soapversion(SOAP::Lite->soapversion);
159        $self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);
160    
161            my @results = (
162    #               SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1),
163    #               SOAP::Data->name('GetParameterValues' =>
164    #                       SOAP::Data->value( 'ParametarNames' => [
165    #                               'InternetGatewayDevice.ManagementServer.',
166    #                               'a.', 'a.b.', 'a.b.c.',
167    #                       ],
168    #                       ),
169    #               )->prefix('cwmp'),
170            );
171    
172    
173    
174            push @results, ( consume_queue );
175    
176        my $result = $self->serializer
177    #      ->prefix('s') # distinguish generated element names between client and server
178    #      ->uri('urn:dslforum-org:cwmp-1-0')
179              ->ns('urn:dslforum-org:cwmp-1-0', 'cwmp')
180          ->envelope( freeform => @results );
181    
182            my $xml = $result;
183            $xml =~ s/</\n</gs;
184    
185            warn "empty_request result:\n$xml\n";
186    
187    #       warn $self->response->headers;
188    
189            return $result;
190    }
191    
Legend:
Removed from v.7  
changed lines
  Added in v.19
  ViewVC Help
Powered by ViewVC 1.1.26