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

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

revision 43 by dpavlin, Tue Jun 19 18:50:28 2007 UTC revision 48 by dpavlin, Tue Jun 19 20:02:36 2007 UTC
# Line 61  sub run { Line 61  sub run {
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    
# Line 77  sub process_request { Line 85  sub process_request {
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 150  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->send(join("",          $sock->send(join("\r\n",
162                  $self->status(200,'OK'),                  '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->send( "Set-Cookie: ID=" . $state->{ID} . "; path=/\r\n" ) if ( $state->{ID} );          $sock->send( "Set-Cookie: ID=" . $state->{ID} . "; path=/\r\n" ) if ( $state->{ID} );
# Line 174  sub process_request { Line 182  sub process_request {
182          }          }
183    
184          $sock->send( "Content-Length: " . length( $xml ) . "\r\n\r\n" );          $sock->send( "Content-Length: " . length( $xml ) . "\r\n\r\n" );
185          $sock->send( "$xml\r\n\r\n" ) 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;
# Line 197  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 207  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->send( $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->send("HTTP/1.1 $number\r\n");    warn "Error - $number - $msg\n";
242    return 1;    return 0;     # close connection
243  }  }
244    
245  1;  1;
Legend:
Removed from v.43  
changed lines
  Added in v.48
  ViewVC Help
Powered by ViewVC 1.1.26