/[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 12 by dpavlin, Mon May 21 12:06:04 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 SOAP::Lite +trace => 'debug';
9    
10  # Eh...  # Eh...
11  $SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND = 1;  $SOAP::Constants::DO_NOT_CHECK_MUSTUNDERSTAND = 1;
12    
13  $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
14    
 # change LocalPort to 81 if you want to test it with soapmark.pl  
   
15  my $daemon = SOAP::Transport::HTTP::Daemon->new(  my $daemon = SOAP::Transport::HTTP::Daemon->new(
16          #LocalAddr => 'localhost',          #LocalAddr => 'localhost',
17          LocalPort => 3333,          LocalPort => 3333,
18          Reuse => 1,          Reuse => 1,
19          #'Listen' => 128,          #'Listen' => 128,
20  )  )
21          ->dispatch_with({ 'urn:dslforum-org:cwmp-1-0' => 'CWMP'})          ->dispatch_with(
22                    { 'urn:dslforum-org:cwmp-1-0' => 'CWMP'},
23            )
24  ;  ;
25    
26    
# Line 29  package CWMP; Line 31  package CWMP;
31  use strict;  use strict;
32    
33  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
34    use Carp qw/cluck/;
35    
36  sub new {  sub new {
37          bless {}, shift;          bless {}, shift;
38  }  }
39    
40    # CPE methods             Responding  Calling
41    #
42    # GetRPCMethods           Required    Optional
43    # SetParameterValues      Required    Required
44    # GetParameterValues      Required    Required
45    # GetParameterNames       Required    Required
46    # SetParameterAttributes  Required    Optional
47    # GetParameterAttributes  Required    Optional
48    # AddObject               Required    Optional
49    # DeleteObject            Required    Optional
50    # Reboot                  Required    Optional
51    # Download                Required    Required
52    # Upload                  Optional    Optional
53    # FactoryReset            Optional    Optional
54    # GetQueuedTransfers      Optional    Optional
55    # ScheduleInform          Optional    Optional
56    # SetVouchers             Optional    Optional
57    # GetOptions              Optional    Optional
58    
59  # Server methods   Calling    Responding  # Server methods   Calling    Responding
60    #
61  # GetRPCMethods    Optional   Required  # GetRPCMethods    Optional   Required
62  # Inform           Required   Required  # Inform           Required   Required
63  # TransferComplete Required   Required  # TransferComplete Required   Required
64  # RequestDownload  Optional   Optional  # RequestDownload  Optional   Optional
65  # Kicked           Optional   Optional  # Kicked           Optional   Optional
66    
67    
68    my $ID;
69    
70  sub Inform {  sub Inform {
71          my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList) = @_;          my ($self, $DeviceId, $Event, $MaxEnvelopes, $CurrentTime, $RetryCount, $ParameterList, $headers) = @_;
72    
73          my $p;          my $p;
74    
75            #cluck dump( $daemon );
76            #warn dump( $headers );
77    
78            $ID = ( grep { $_->name eq 'ID' } @$headers )[0]->value;
79    
80          foreach ( @$ParameterList ) {          foreach ( @$ParameterList ) {
81                  $p->{ $_->{Name} } = $_->{Value};                  $p->{ $_->{Name} } = $_->{Value};
82          }          }
83    
84          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 );
85    
86            return SOAP::Data->name('MaxEnvelopes' => $MaxEnvelopes);
87    }
88    
89    sub GetParameterValuesResponse {
90            warn "GetParameterValuesResponse ",dump( @_ );
91    }
92    
93    sub empty_request {
94            my (undef, $self) = @_;
95    
96        $self->serializer->soapversion(SOAP::Lite->soapversion);
97        $self->serializer->xmlschema($SOAP::Constants::DEFAULT_XML_SCHEMA);
98    
99            my @results = (
100                    SOAP::Header->name('ID' => $ID)->prefix('cwmp')->mustUnderstand(1),
101                    SOAP::Data->name('GetParameterValues' =>
102                            'ParameterNames' => [
103                                    'InternetGatewayDevice.ManagementServer.',
104                                    'a.', 'a.b.', 'a.b.c.',
105                            ],
106                    )->prefix('cwmp'),
107            );
108    
109        my $result = $self->serializer
110    #      ->prefix('s') # distinguish generated element names between client and server
111    #      ->uri('urn:dslforum-org:cwmp-1-0')
112              ->ns('urn:dslforum-org:cwmp-1-0', 'cwmp')
113          ->envelope( freeform => @results );
114    
115            my $xml = $result;
116            $xml =~ s/</\n</gs;
117    
118            print "empty request result: $xml\n";
119    
120            return $result;
121  }  }
Legend:
Removed from v.2  
changed lines
  Added in v.12
  ViewVC Help
Powered by ViewVC 1.1.26