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

diff --git a/lib/CWMP/Server.pm b/lib/CWMP/Server.pm
index 7634806..055e265 100644
--- a/lib/CWMP/Server.pm
+++ b/lib/CWMP/Server.pm
@@ -7,19 +7,26 @@ use warnings;
 use base qw/Class::Accessor/;
 __PACKAGE__->mk_accessors( qw/
 port
-store
-default_queue
+session
 background
 debug
+create_dump
 
 server
 / );
 
 use CWMP::Session;
+use CWMP::Queue;
 
 use Carp qw/confess/;
 use Data::Dump qw/dump/;
 
+use IO::Socket::INET;
+use File::Path qw/mkpath/;
+use File::Slurp;
+
+use URI::Escape;
+
 =head1 NAME
 
 CWMP::Server - description
@@ -30,8 +37,7 @@ CWMP::Server - description
 
   my $server = CWMP::Server->new({
   	port => 3333,
-	store => 'state.db',
-	default_queue => [ qw/GetRPCMethods GetParameterNames/ ],                                                           
+	session => { ... },
 	background => 1,
 	debug => 1
   });
@@ -44,15 +50,11 @@ Options:
 
 port to listen on
 
-=item store
+=item session
 
 hash with key C<module> with value C<DBMDeep> if L<CWMP::Store::DBMDeep>
 is used. Other parametars are optional.
 
-=item default_queue
-
-commands which will be issued to every CPE on connect
-
 =back
 
 =cut
@@ -63,22 +65,9 @@ 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;
 
-	$self->server(
-		CWMP::Server::Helper->new({
-			proto => 'tcp',
-			port => $self->port,
-			default_queue => $self->default_queue,
-			store => $self->store,
-			debug => $self->debug,
-			background => $self->background,
-		})
-	);
-
 	return $self;
 }
 
@@ -89,73 +78,106 @@ sub new {
 sub run {
 	my $self = shift;
 
-	$self->server->run;
-}
+	my $server = IO::Socket::INET->new(
+			Proto     => 'tcp',
+			LocalPort => $self->port,
+			Listen    => SOMAXCONN,
+			Reuse     => 1
+	) || die "can't start server on ", $self->port, ": $!";
 
-package CWMP::Server::Helper;
+	warn "ACS waiting for request on port ", $self->port, "\n";
 
-use warnings;
-use strict;
+	while (1) {
+		my $client = $server->accept() || next; # ALARM trickle us
 
-use base qw/Net::Server/;
-use Carp qw/confess/;
-use Data::Dump qw/dump/;
+		my $count = 0;
 
-sub options {
-	my $self     = shift;
-	my $prop     = $self->{'server'};
-	my $template = shift;
+		my $session = CWMP::Session->new( $self->session ) || confess "can't create sessision";
 
-	### setup options in the parent classes
-	$self->SUPER::options($template);
+		while ( $self->sock_session( $client, $session ) ) {
+			$count++;
+			warn "# finished request $count, waiting for next one\n";
+		}
 
-	# new single-value options
-	foreach my $p ( qw/ store debug / ) {
-		$prop->{ $p } ||= undef;
-		$template->{ $p } = \$prop->{ $p };
+		warn "# connection to ", $client->peerhost, " closed\n";
 	}
 
-	# new multi-value options
-	foreach my $p ( qw/ default_queue / ) {
-		$prop->{ $p } ||= [];
-		$template->{ $p } = $prop->{ $p };
-	}
 }
 
+my $dump_by_ip;
 
-=head2 process_request
+sub sock_session {
+	my ( $self, $sock, $session ) = @_;
 
-=cut
+	my $request = <$sock>;
+	return unless $request;
+	my $ip = $sock->peerhost;
 
-sub process_request {
-	my $self = shift;
+	my $headers;
+
+	while ( my $header = <$sock> ) {
+		$request .= $header;
+		chomp $header;
+		last if $header =~ m{^\s*$};
+		my ( $n, $v ) = split(/:\s*/, $header);
+		$v =~ s/[\r\n]+$//;
+		$headers->{ lc $n } = $v;
+	}
+
+	warn "<<<< $ip START\n$request\n";
+
+	return $sock->connected unless $headers;
+
+	warn "missing $_ header\n" foreach grep { ! defined $headers->{ lc $_ } } ( 'SOAPAction' );
 
-	my $prop = $self->{server};
-	confess "no server in ", ref( $self ) unless $prop;
-	my $sock = $prop->{client};
-	confess "no sock in ", ref( $self ) unless $sock;
+	my $body;
+	if ( my $len = $headers->{'content-length'} ) {
+		read( $sock, $body, $len );
+	} elsif ( $headers->{'transfer-encoding'} =~ m/^chunked/i ) {
+		while ( my $len = <$sock> ) {
+			$len =~ s/[\r\n]+$//;
+			$len = hex($len);
+			last if $len == 0;
+			read( $sock, my $chunk, $len );
+			$body .= $chunk;
+			my $padding = <$sock>;
+		}
+	} else {
+		warn "empty request\n";
+	}
 
-	warn "default CPE queue ( " . join(",",@{$prop->{default_queue}}) . " )\n" if defined($prop->{default_queue});
+	warn "$body\n<<<< $ip END\n";
 
-	eval  {
-		my $session = CWMP::Session->new({
-			sock => $sock,
-			queue => $prop->{default_queue},
-			store => $prop->{store},
-			debug => $prop->{debug},
-		}) || confess "can't create session";
 
-		while ( $session->process_request ) {
-			warn "...another one bites the dust...\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 );
 
-	if ($@) {
-		warn $@;
+	my $dump_nr = $dump_by_ip->{$ip}++;
+
+	if ( $self->create_dump ) {
+		mkpath "dump/$ip" unless -e "dump/$ip";
+		write_file( sprintf("dump/%s/%04d.request", $ip, $dump_nr), "$request\r\n$body" );
+		write_file( sprintf("dump/%s/%04d.response", $ip, $dump_nr ), $response );
 	}
 
-	warn "...returning to accepting new connections\n";
+	warn ">>>> $ip START\n$response\n>>>> $ip END\n";
+	print $sock $response;
+
+	return $sock->connected;
 
 }
 
+
 1;