/[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 15 by dpavlin, Mon May 21 15:27:38 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            )
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";  print "Contact to ACS server at ", $daemon->url, "\n";
36  $daemon->handle;  $daemon->handle;
# Line 35  sub new { Line 45  sub new {
45          bless {}, shift;          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  # Server methods   Calling    Responding
68    #
69  # GetRPCMethods    Optional   Required  # GetRPCMethods    Optional   Required
70  # Inform           Required   Required  # Inform           Required   Required
71  # TransferComplete Required   Required  # TransferComplete Required   Required
72  # RequestDownload  Optional   Optional  # RequestDownload  Optional   Optional
73  # Kicked           Optional   Optional  # Kicked           Optional   Optional
74    
75    
76    my $ID;
77    
78  sub Inform {  sub Inform {
79          my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_;          my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_;
80    
# Line 50  sub Inform { Line 83  sub Inform {
83          #cluck dump( $daemon );          #cluck dump( $daemon );
84          #warn dump( $headers );          #warn dump( $headers );
85    
86          my $ID = ( grep { $_->name eq 'ID' } @$headers )[0]->value;          $ID = ( grep { $_->name eq 'ID' } @$headers )[0]->value;
87    
88          foreach ( @$ParameterList ) {          foreach ( @$ParameterList ) {
89                  $p->{ $_->{Name} } = $_->{Value};                  $p->{ $_->{Name} } = $_->{Value};
# Line 60  sub Inform { Line 93  sub Inform {
93    
94          return SOAP::Data->name('MaxEnvelopes' => $MaxEnvelopes);          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    }
Legend:
Removed from v.7  
changed lines
  Added in v.15
  ViewVC Help
Powered by ViewVC 1.1.26