/[cwmp]/google/trunk/lib/CWMP/Session.pm
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/trunk/lib/CWMP/Session.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 41 by dpavlin, Tue Jun 19 18:11:37 2007 UTC revision 48 by dpavlin, Tue Jun 19 20:02:36 2007 UTC
# Line 53  sub run { Line 53  sub run {
53                  warn "connection from ", $sock->peerhost, "\n";                  warn "connection from ", $sock->peerhost, "\n";
54    
55                  $self->sock( $sock );   # FIXME this will not work for multiple clients                  $self->sock( $sock );   # FIXME this will not work for multiple clients
56                  $self->process_request( $sock );                  while ( $self->process_request ) {
57                            warn "...another one bites a dust...\n";
58                    }
59    
60                  warn "...another one bites a dust...\n";                  warn "...returning to accepting new connections\n";
                 sleep 1;  
61          }          }
62  }  }
63    
64    =head2 process_request
65    
66    One request from client/response from server cycle. Call multiple times to
67    facilitate brain-dead concept of adding state to stateless protocol like
68    HTTP.
69    
70    =cut
71    
72  sub process_request {  sub process_request {
73          my $self = shift;          my $self = shift;
74    
75          my $sock = shift || die "no sock?";          my $sock = $self->sock || die "no sock?";
76    
77          die "not IO::Socket::INET but ", ref( $sock ) unless ( ref($sock) eq 'IO::Socket::INET' );          die "not IO::Socket::INET but ", ref( $sock ) unless ( ref($sock) eq 'IO::Socket::INET' );
78    
79            if ( ! $sock->connected ) {
80                    warn "SOCKET NOT CONNECTED";
81                    return 0;
82            }
83    
84          $sock->autoflush( 1 );          $sock->autoflush( 1 );
85          $sock->blocking( 1 );          $sock->blocking( 1 );
86    
87          ### read the first line of response          ### read the first line of response
88          my $line = $sock->getline; # || $self->error(400, "No Data");          my $line = $sock->getline || return $self->error(400, "No Data");
89    
90          $line =~ s/[\r\n]+$//;          $line =~ s/[\r\n]+$//;
91          if ($line !~ /^ (\w+) \ + (\S+) \ + (HTTP\/1.\d) $ /x) {          if ($line !~ /^ (\w+) \ + (\S+) \ + (HTTP\/1.\d) $ /x) {
# Line 81  sub process_request { Line 95  sub process_request {
95          warn "<<<< ",join(" ", time, $method, $req)."\n";          warn "<<<< ",join(" ", time, $method, $req)."\n";
96    
97          ### read in other headers          ### read in other headers
98          $self->read_headers($sock) || return $self->error(400, "Strange headers");          $self->read_headers || return $self->error(400, "Strange headers");
99    
100          ### do we support the type          ### do we support the type
101  #       if ($method !~ /GET|POST|HEAD/) {  #       if ($method !~ /GET|POST|HEAD/) {
# Line 144  sub process_request { Line 158  sub process_request {
158    
159          my $response = CWMP::Response->new({ debug => $self->debug });          my $response = CWMP::Response->new({ debug => $self->debug });
160    
161          $sock->print(          $sock->send(join("\r\n",
162                  $self->status(200),                  'HTTP/1.1 200 OK',
163                  $self->content_type('text/xml; charset="utf-8"'),                  'Content-Type: text/xml; charset="utf-8"',
164                  "Server: AcmeCWMP/42\r\n",                  'Server: AcmeCWMP/42',
165                  "SOAPServer: AcmeCWMP/42\r\n"                  'SOAPServer: AcmeCWMP/42',
166          );          ));
167    
168          $sock->print( "Set-Cookie: ID=" , $state->{ID}, "; path=/\r\n" ) if ( $state->{ID} );          $sock->send( "Set-Cookie: ID=" . $state->{ID} . "; path=/\r\n" ) if ( $state->{ID} );
169                    
170          my $xml = '';          my $xml = '';
171    
# Line 167  sub process_request { Line 181  sub process_request {
181                  warn ">>> empty response\n";                  warn ">>> empty response\n";
182          }          }
183    
184          $sock->print( "Content-length: ", length( $xml ), "\r\n\r\n" );          $sock->send( "Content-Length: " . length( $xml ) . "\r\n\r\n" );
185          $sock->print( $xml ) or die "can't send response";          $sock->send( $xml ) or die "can't send response";
186    
187          warn "### request over";          warn "### request over";
188    
189  };  };
190    
191    =head2 read_headers
192    
193    parse headers from request
194    
195    =cut
196    
197  sub read_headers {  sub read_headers {
198    my $self = shift;    my $self = shift;
199    
         my $sock = shift || die "no sock?";  
   
200    $self->{headers} = {};    $self->{headers} = {};
201    
202    while (defined($_ = $sock->getline)) {    while (defined($_ = $self->sock->getline)) {
203      s/[\r\n]+$//;      s/[\r\n]+$//;
204      last unless length $_;      last unless length $_;
205          warn "-- $_\n";          warn "-- $_\n";
# Line 193  sub read_headers { Line 210  sub read_headers {
210    return 1;    return 1;
211  }  }
212    
213    =head2 header
214    
215    Getter for specific header
216    
217      $self->header('Cookies');
218    
219    =cut
220    
221  sub header {  sub header {
222          my $self = shift;          my $self = shift;
223          my $header = shift || die "no header?";          my $header = shift || die "no header?";
# Line 203  sub header { Line 228  sub header {
228          }          }
229  }  }
230    
231  sub content_type {  =head2 error
   my ($self, $type) = @_;  
   $self->http_header;  
   return "Content-type: $type\r\n";  
 }  
232    
233  sub error{    return $self->error( 501, 'System error' );
   my ($self, $number, $msg) = @_;  
   $self->sock->print( $self->status($number, $msg), "\r\n" );  
   warn "Error - $number - $msg\n";  
 }  
234    
235  sub status {  =cut
   my ($self, $number, $msg) = @_;  
   $msg = '' if ! defined $msg;  
   return if $self->http_header($number);  
   return "Status $number: $msg\r\n";  
 }  
236    
237  sub http_header {  sub error {
238    my $self = shift;    my ($self, $number, $msg) = @_;
239    my $number = shift || 200;    $msg ||= 'ERROR';
240    return if ! delete $self->{needs_header};    $self->sock->send( "HTTP/1.1 $number $msg\r\n" );
241    $self->sock->Print("HTTP/1.0 $number\r\n");    warn "Error - $number - $msg\n";
242    return 1;    return 0;     # close connection
243  }  }
244    
245  1;  1;
Legend:
Removed from v.41  
changed lines
  Added in v.48
  ViewVC Help
Powered by ViewVC 1.1.26