/[meteor]/googlecode.com/svn/trunk/Meteor/Document.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 /googlecode.com/svn/trunk/Meteor/Document.pm

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

revision 10 by andrew.betts, Thu Dec 14 10:45:43 2006 UTC revision 38 by knops.gerd, Fri Feb 1 21:54:05 2008 UTC
# Line 45  sub serveFileToClient { Line 45  sub serveFileToClient {
45          my $class=shift;          my $class=shift;
46          my $relPath=shift;          my $relPath=shift;
47          my $client=shift;          my $client=shift;
48            
49          &::syslog('debug',"Meteor::Document: Request received for '%s'",$relPath);          &::syslog('debug',"Meteor::Document: Request received for '%s'",$relPath);
50                    
51          my $doc=$class->documentForPath($relPath);          my $doc=$class->documentForPath($relPath);
# Line 53  sub serveFileToClient { Line 53  sub serveFileToClient {
53          unless(defined($doc))          unless(defined($doc))
54          {          {
55                  $class->emitHeaderToClient($client,'404 Not Found');                  $class->emitHeaderToClient($client,'404 Not Found');
56                    $::Statistics->{'documents_not_found'}++;
57                                    
58                  return undef;                  return undef;
59          }          }
60                    
61          $doc->serveTo($client);          $doc->serveTo($client);
62                    
63            $::Statistics->{'documents_served'}++;
64            
65          $doc;          $doc;
66  }  }
67    
# Line 66  sub emitHeaderToClient { Line 69  sub emitHeaderToClient {
69          my $self=shift;          my $self=shift;
70          my $client=shift;          my $client=shift;
71          my $status=shift;          my $status=shift;
72            my $length=shift;
73            my $contenttype=shift;
74            $length = 0 unless ($length);
75            $contenttype = "text/html" unless ($contenttype);
76                    
77          my $header=$::CONF{'DocumentHeaderTemplate'};          my $header="HTTP/1.1 ".$status."\r\nServer: ".$::PGM."\r\nContent-Type: ".$contenttype."; charset=utf-8\r\nPragma: no-cache\r\nCache-Control: no-cache, no-store, must-revalidate\r\nExpires: Thu, 1 Jan 1970 00:00:00 GMT\r\nContent-length: ".$length."\r\n\r\n";
           
         $header=~s/~([^~]+)~/  
                 if(!defined($1) || $1 eq '')  
                 {  
                         '~';  
                 }  
                 elsif($1 eq 'server')  
                 {  
                         $::PGM;  
                 }  
                 elsif($1 eq 'status')  
                 {  
                         $status;  
                 }  
                 else  
                 {  
                         '';  
                 }  
         /gex;  
78                    
79          $client->write($header);          $client->write($header);
80  }  }
# Line 135  sub pathToAbsolute { Line 123  sub pathToAbsolute {
123          $relPath=~s/^[\/]*//;          $relPath=~s/^[\/]*//;
124          $relPath=~s/[\/]*$//;          $relPath=~s/[\/]*$//;
125                    
         # split into path components  
         my @pathComponents=split(/[\/]+/,$relPath);  
126                    
127          # Check components          # NOTE: With the right strings the code below triggers a bug in
128          foreach (@pathComponents)          # perl (5.8.6 currently) that will result in messages like
129            #
130            #       Attempt to free unreferenced scalar
131            #
132            # and an eventual crash.
133            #
134            # So it was replaced with the more naive code following this
135            # commented out code.
136            #
137            # # split into path components
138            # my @pathComponents=split(/[\/]+/,$relPath);
139            #
140            # # Check components
141            # foreach (@pathComponents)
142            # {
143            #       # Very strict: We only allow alphanumeric characters, dash and
144            #       # underscore, followed by any number of extensions that also
145            #       # only allow the above characters.
146            #       unless(/^[a-z0-9\-\_][a-z0-9\-\_\.]*$/i)
147            #       {
148            #               &::syslog('debug',
149            #                       "Meteor::Document: Rejecting path '%s' due to invalid component '%s'",
150            #                       $relPath,$_
151            #               );
152            #              
153            #               return undef;
154            #       }
155            # }
156            #
157            #my $path=$::CONF{'SubscriberDocumentRoot'}.'/'.join('/',@pathComponents);
158            
159            #
160            # Check for all alphanumeric or dash, underscore, dot and slash
161            #
162            unless($relPath=~/^[a-z0-9\-\_\.\/]*$/i)
163          {          {
164                  # Very strict: We only allow alphanumric characters, dash and                  &::syslog('debug',
165                  # underscore, followed by any number of extensions that also                          "Meteor::Document: Rejecting path '%s' due to invalid characters",
166                  # only allow the above characters.                          $relPath
167                  unless(/^[a-z0-9\-\_][a-z0-9\-\_\.]*$/i)                  );
168                  {                  
169                          &::syslog('debug',                  return undef;
170                                  "Meteor::Document: Rejecting path '%s' due to invalid component '%s'",          }
171                                  $relPath,$_          #
172                          );          # Don't allow '..'
173                                    #
174                          return undef;          if(index($relPath,'..')>=0)
175                  }          {
176                    &::syslog('debug',
177                            "Meteor::Document: Rejecting path '%s' due to invalid sequence '..'",
178                            $relPath
179                    );
180                    
181                    return undef;
182          }          }
183                    
184          my $path=$::CONF{'SubscriberDocumentRoot'}.'/'.join('/',@pathComponents);          my $path=$::CONF{'SubscriberDocumentRoot'}.'/'.$relPath;
185                    
186          # If it is a directory, append DirectoryIndex config value          # If it is a directory, append DirectoryIndex config value
187          $path.='/'.$::CONF{'DirectoryIndex'} if(-d $path);          $path.='/'.$::CONF{'DirectoryIndex'} if(-d $path);
# Line 208  sub newDocument { Line 234  sub newDocument {
234  sub serveTo {  sub serveTo {
235          my $self=shift;          my $self=shift;
236          my $client=shift;          my $client=shift;
237            my $ct = "text/html";
238            if ($self->{'path'} =~/\.(js)$/) {
239                    $ct = "text/javascript";
240            }
241                    
242          $self->emitHeaderToClient($client,'200 OK');          $self->emitHeaderToClient($client,'200 OK',$self->{'size'}, $ct);
243                    
244          $client->write($self->{'document'});          $client->write($self->{'document'});
245    
246  }  }
247    
248  sub path {  sub path {
Legend:
Removed from v.10  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26