X-Git-Url: http://git.rot13.org/?p=perl-cwmp.git;a=blobdiff_plain;f=lib%2FCWMP%2FServer.pm;h=055e265dad014e3e6c7954949dd005c85f290c61;hp=f69ece6d40f9d6a26da0083f4d7c509de0142e24;hb=5a913f2c18fe1894cda0144870684e9d559352d2;hpb=7b15acb7d67a6679a3c498850a4fffa1459eb0b9

diff --git a/lib/CWMP/Server.pm b/lib/CWMP/Server.pm
index f69ece6..055e265 100644
--- 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,15 +85,18 @@ 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
 
+		my $count = 0;
+
 		my $session = CWMP::Session->new( $self->session ) || confess "can't create sessision";
 
 		while ( $self->sock_session( $client, $session ) ) {
-			warn "# another one\n";
+			$count++;
+			warn "# finished request $count, waiting for next one\n";
 		}
 
 		warn "# connection to ", $client->peerhost, " closed\n";
@@ -125,8 +128,6 @@ sub sock_session {
 
 	return $sock->connected unless $headers;
 
-warn dump( $headers );
-
 	warn "missing $_ header\n" foreach grep { ! defined $headers->{ lc $_ } } ( 'SOAPAction' );
 
 	my $body;
@@ -134,16 +135,12 @@ warn dump( $headers );
 		read( $sock, $body, $len );
 	} elsif ( $headers->{'transfer-encoding'} =~ m/^chunked/i ) {
 		while ( my $len = <$sock> ) {
-warn "chunked ",dump($len);
 			$len =~ s/[\r\n]+$//;
 			$len = hex($len);
 			last if $len == 0;
-warn "reading $len bytes\n";
 			read( $sock, my $chunk, $len );
-warn "|$chunk| $len == ", length($chunk);
 			$body .= $chunk;
 			my $padding = <$sock>;
-warn "padding ",dump($padding);
 		}
 	} else {
 		warn "empty request\n";
@@ -151,6 +148,20 @@ warn "padding ",dump($padding);
 
 	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}++;