re-enable all_parameteres collection of first connect

[perl-cwmp.git] / lib / CWMP / Server.pm

diff --git a/lib/CWMP/Server.pm b/lib/CWMP/Server.pm
index eaf6c06..055e265 100644 (file)
--- a/lib/CWMP/Server.pm
+++ b/lib/CWMP/Server.pm
@@ -25,6 +25,8 @@ use IO::Socket::INET;
 use File::Path qw/mkpath/;
 use File::Slurp;
 
+use URI::Escape;
+
 =head1 NAME
 
 CWMP::Server - description
@@ -63,8 +65,6 @@ sub new {
 
        warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
 
-       warn "ACS waiting for request on port ", $self->port, "\n";
-
        $self->debug( 0 ) unless $self->debug;
        warn "## debug level: ", $self->debug, "\n" if $self->debug;
 
@@ -85,7 +85,7 @@ sub run {
                        Reuse     => 1
        ) || die "can't start server on ", $self->port, ": $!";
 
-       warn "listen on ", $server->sockhost, ":", $server->sockport, "\n";
+       warn "ACS waiting for request on port ", $self->port, "\n";
 
        while (1) {
                my $client = $server->accept() || next; # ALARM trickle us
@@ -148,6 +148,20 @@ sub sock_session {
 
        warn "$body\n<<<< $ip END\n";
 
+
+       # XXX evil security hole to eval code over web to inspect it
+       if ( $self->debug && $headers->{'user-agent'} =~ m{Mozilla} ) {
+               my $out = '';
+               if ( $request =~ m{^GET /(\$.+) HTTP/} ) {
+                       my $eval = uri_unescape $1;
+                       $out = dump( eval $eval );
+                       $out .= "ERROR: $@\n" if $@;
+                       warn "EVAL $eval = $out\n";
+               }
+               print $sock "HTTP/1.1 200 OK\r\nContent-type: text/plain\r\nConnection: close\r\n\r\n$out";
+               return 0;
+       }
+
        my $response = $session->process_request( $ip, $body );
 
        my $dump_nr = $dump_by_ip->{$ip}++;