/[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 2 by dpavlin, Sat May 19 15:15:14 2007 UTC revision 18 by dpavlin, Mon May 21 17:53:48 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    
11    #SOAP::Trace->import( 'all' );
12    
13  # Eh...  # Eh...
14  $SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND = 1;  $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  $SIG{PIPE} = $SIG{INT} = 'IGNORE'; # don't want to die on 'Broken pipe' or Ctrl-C
17    
 # change LocalPort to 81 if you want to test it with soapmark.pl  
   
18  my $daemon = SOAP::Transport::HTTP::Daemon->new(  my $daemon = SOAP::Transport::HTTP::Daemon->new(
19          #LocalAddr => 'localhost',          #LocalAddr => 'localhost',
20          LocalPort => 3333,          LocalPort => 3333,
21          Reuse => 1,          Reuse => 1,
22          #'Listen' => 128,          #'Listen' => 128,
23  )  )
24          ->dispatch_with({ 'urn:dslforum-org:cwmp-1-0' => 'CWMP'})          ->dispatch_with({
25                    '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(
31            -name => 'foo',
32            -value => 'bar',
33    );
34    $daemon->options->{simple_cookie} = $cookies;
35    
36  print "Contact to ACS server at ", $daemon->url, "\n";  print "Contact to ACS server at ", $daemon->url, "\n";
37  $daemon->handle;  $daemon->handle;
# Line 29  package CWMP; Line 40  package CWMP;
40  use strict;  use strict;
41    
42  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
43    use Carp qw/cluck/;
44    
45  sub new {  sub new {
46          bless {}, shift;          bless {}, shift;
47  }  }
48    
49    # CPE methods             Responding  Calling
50    #
51    # GetRPCMethods           Required    Optional
52    # SetParameterValues      Required    Required
53    # GetParameterValues      Required    Required
54    # GetParameterNames       Required    Required
55    # SetParameterAttributes  Required    Optional
56    # GetParameterAttributes  Required    Optional
57    # AddObject               Required    Optional
58    # DeleteObject            Required    Optional
59    # Reboot                  Required    Optional
60    # Download                Required    Required
61    # Upload                  Optional    Optional
62    # FactoryReset            Optional    Optional
63    # GetQueuedTransfers      Optional    Optional
64    # ScheduleInform          Optional    Optional
65    # SetVouchers             Optional    Optional
66    # GetOptions              Optional    Optional
67    
68  # Server methods   Calling    Responding  # Server methods   Calling    Responding
69    #
70  # GetRPCMethods    Optional   Required  # GetRPCMethods    Optional   Required
71  # Inform           Required   Required  # Inform           Required   Required
72  # TransferComplete Required   Required  # TransferComplete Required   Required
73  # RequestDownload  Optional   Optional  # RequestDownload  Optional   Optional
74  # Kicked           Optional   Optional  # Kicked           Optional   Optional
75    
76    
77    my $ID;
78    
79    my @queue = qw/
80            GetRPCMethods
81    /;
82    
83    sub consume_queue {
84            my @results = ( SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1) );
85            if ( ! @queue ) {
86                    push @results, SOAP::Header->name('NoMoreRequests' => 1)->prefix('cwmp');
87            } else {
88                    my $op = shift @queue;
89                    push @results, SOAP::Data->name( $op )->prefix('cwmp');
90            }
91            warn "consume queue results = ", dump( @results );
92            return @results;
93    }
94    
95    ## SOAP ACS methods
96    
97  sub Inform {  sub Inform {
98          my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList) = @_;          my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_;
99    
100          my $p;          my $p;
101    
102            #cluck dump( $daemon );
103            #warn dump( $headers );
104    
105            $ID = ( grep { $_->name eq 'ID' } @$headers )[0]->value;
106    
107          foreach ( @$ParameterList ) {          foreach ( @$ParameterList ) {
108                  $p->{ $_->{Name} } = $_->{Value};                  $p->{ $_->{Name} } = $_->{Value};
109          }          }
110    
111          warn "request 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 );
112    
113            return SOAP::Data->name('MaxEnvelopes' => 1);
114    }
115    
116    sub GetParameterValuesResponse {
117            my $self = shift;
118    
119            warn "GetParameterValuesResponse ",dump( @_ );
120    
121            return;
122    }
123    
124    sub Fault {
125            my $self = shift;
126    
127            warn "Fault ",dump( @_ );
128    
129            return;
130    }
131    
132    ## special handling of empty POST request from CPE
133    
134    sub empty_request {
135            my (undef, $self) = @_;
136    
137        $self->serializer->soapversion(SOAP::Lite->soapversion);
138        $self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);
139    
140            my @results = (
141    #               SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1),
142    #               SOAP::Data->name('GetParameterValues' =>
143    #                       SOAP::Data->value( 'ParametarNames' => [
144    #                               'InternetGatewayDevice.ManagementServer.',
145    #                               'a.', 'a.b.', 'a.b.c.',
146    #                       ],
147    #                       ),
148    #               )->prefix('cwmp'),
149            );
150    
151            push @results, consume_queue;
152    
153        my $result = $self->serializer
154    #      ->prefix('s') # distinguish generated element names between client and server
155    #      ->uri('urn:dslforum-org:cwmp-1-0')
156              ->ns('urn:dslforum-org:cwmp-1-0', 'cwmp')
157          ->envelope( freeform => @results );
158    
159            my $xml = $result;
160            $xml =~ s/</\n</gs;
161    
162            print "empty request result: $xml\n", dump( $self->request->headers, $self->response->headers, $self->packager->headers_http );
163    
164            return $result;
165  }  }
166    
Legend:
Removed from v.2  
changed lines
  Added in v.18
  ViewVC Help
Powered by ViewVC 1.1.26