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

diff --git a/lib/CWMP/Server.pm b/lib/CWMP/Server.pm
index ff2611c..f69ece6 100644
--- a/lib/CWMP/Server.pm
+++ b/lib/CWMP/Server.pm
@@ -10,6 +10,7 @@ port
 session
 background
 debug
+create_dump
 
 server
 / );
@@ -20,6 +21,10 @@ use CWMP::Queue;
 use Carp qw/confess/;
 use Data::Dump qw/dump/;
 
+use IO::Socket::INET;
+use File::Path qw/mkpath/;
+use File::Slurp;
+
 =head1 NAME
 
 CWMP::Server - description
@@ -63,16 +68,6 @@ sub new {
 	$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,
-			session => $self->session,
-			debug => $self->debug,
-			background => $self->background,
-		})
-	);
-
 	return $self;
 }
 
@@ -83,70 +78,95 @@ 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 "listen on ", $server->sockhost, ":", $server->sockport, "\n";
 
-use warnings;
-use strict;
+	while (1) {
+		my $client = $server->accept() || next; # ALARM trickle us
 
-#use base qw/Net::Server/;
-use base qw/Net::Server::Fork/;
-use Carp qw/confess/;
-use Data::Dump qw/dump/;
+		my $session = CWMP::Session->new( $self->session ) || confess "can't create sessision";
 
-sub options {
-	my $self     = shift;
-	my $prop     = $self->{'server'};
-	my $template = shift;
-
-	### setup options in the parent classes
-	$self->SUPER::options($template);
+		while ( $self->sock_session( $client, $session ) ) {
+			warn "# another one\n";
+		}
 
-	# new single-value options
-	foreach my $p ( qw/ session 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;
 
-	my $prop = $self->{server};
-	confess "no server in ", ref( $self ) unless $prop;
-	my $sock = $prop->{client};
-	confess "no sock in ", ref( $self ) unless $sock;
+	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;
+	}
 
-	my $sess = $prop->{session} || confess "no session";
+	warn "<<<< $ip START\n$request\n";
+
+	return $sock->connected unless $headers;
+
+warn dump( $headers );
+
+	warn "missing $_ header\n" foreach grep { ! defined $headers->{ lc $_ } } ( 'SOAPAction' );
+
+	my $body;
+	if ( my $len = $headers->{'content-length'} ) {
+		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";
+	}
 
-	eval  {
-		$sess->{sock} = $sock;
-		$sess->{debug} = $prop->{debug};
+	warn "$body\n<<<< $ip END\n";
 
-		my $session = CWMP::Session->new( $sess ) || confess "can't create session from ",dump( $sess );
+	my $response = $session->process_request( $ip, $body );
 
-		while ( $session->process_request ) {
-			warn "...waiting for next request from CPE...\n" if $prop->{debug};
-		}
-	};
+	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 "ERROR: $@\n" if $@;
+	warn ">>>> $ip START\n$response\n>>>> $ip END\n";
+	print $sock $response;
 
-	warn "...returning to accepting new connections\n" if $prop->{debug};
+	return $sock->connected;
 
 }
 
+
 1;