/[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 3 by andrew.betts, Mon Nov 20 17:59:30 2006 UTC revision 47 by knops.gerd, Mon Feb 4 21:06:42 2008 UTC
# Line 46  sub serveFileToClient { Line 46  sub serveFileToClient {
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);
50            
51          my $doc=$class->documentForPath($relPath);          my $doc=$class->documentForPath($relPath);
52                    
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                    &::syslog('info','',
59                            'document',
60                            $relPath,
61                            0,
62                            404
63                    );
64                                    
65                  return undef;                  return undef;
66          }          }
67                    
68          $doc->serveTo($client);          $doc->serveTo($client);
69                    
70            $::Statistics->{'documents_served'}++;
71            
72            &::syslog('info','',
73                    'document',
74                    $relPath,
75                    $doc->{'size'},
76                    200
77            );
78            
79          $doc;          $doc;
80  }  }
81    
# Line 64  sub emitHeaderToClient { Line 83  sub emitHeaderToClient {
83          my $self=shift;          my $self=shift;
84          my $client=shift;          my $client=shift;
85          my $status=shift;          my $status=shift;
86            my $length=shift;
87            my $contenttype=shift;
88            $length = 0 unless ($length);
89            $contenttype = "text/html" unless ($contenttype);
90                    
91          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;  
92                    
93          $client->write($header);          $client->write($header);
94  }  }
# Line 133  sub pathToAbsolute { Line 137  sub pathToAbsolute {
137          $relPath=~s/^[\/]*//;          $relPath=~s/^[\/]*//;
138          $relPath=~s/[\/]*$//;          $relPath=~s/[\/]*$//;
139                    
         # split into path components  
         my @pathComponents=split(/[\/]+/,$relPath);  
140                    
141          # Check components          # NOTE: With the right strings the code below triggers a bug in
142          foreach (@pathComponents)          # perl (5.8.6 currently) that will result in messages like
143            #
144            #       Attempt to free unreferenced scalar
145            #
146            # and an eventual crash.
147            #
148            # So it was replaced with the more naive code following this
149            # commented out code.
150            #
151            # # split into path components
152            # my @pathComponents=split(/[\/]+/,$relPath);
153            #
154            # # Check components
155            # foreach (@pathComponents)
156            # {
157            #       # Very strict: We only allow alphanumeric characters, dash and
158            #       # underscore, followed by any number of extensions that also
159            #       # only allow the above characters.
160            #       unless(/^[a-z0-9\-\_][a-z0-9\-\_\.]*$/i)
161            #       {
162            #               &::syslog('debug',
163            #                       "Meteor::Document: Rejecting path '%s' due to invalid component '%s'",
164            #                       $relPath,$_
165            #               );
166            #              
167            #               return undef;
168            #       }
169            # }
170            #
171            #my $path=$::CONF{'SubscriberDocumentRoot'}.'/'.join('/',@pathComponents);
172            
173            #
174            # Check for all alphanumeric or dash, underscore, dot and slash
175            #
176            unless($relPath=~/^[a-z0-9\-\_\.\/]*$/i)
177          {          {
178                  # Very strict: We only allow alphanumric characters, dash and                  &::syslog('debug',
179                  # underscore, followed by any number of extensions that also                          "Meteor::Document: Rejecting path '%s' due to invalid characters",
180                  # only allow the above characters.                          $relPath
181                  unless(/^[a-z0-9\-\_][a-z0-9\-\_\.]*$/i)                  );
182                  {                  
183                          &::syslog('debug',                  return undef;
184                                  "Meteor::Document: Rejecting path '%s' due to invalid component '%s'",          }
185                                  $relPath,$_          #
186                          );          # Don't allow '..'
187                                    #
188                          return undef;          if(index($relPath,'..')>=0)
189                  }          {
190                    &::syslog('debug',
191                            "Meteor::Document: Rejecting path '%s' due to invalid sequence '..'",
192                            $relPath
193                    );
194                    
195                    return undef;
196          }          }
197                    
198          my $path=$::CONF{'SubscriberDocumentRoot'}.'/'.join('/',@pathComponents);          my $path=$::CONF{'SubscriberDocumentRoot'}.'/'.$relPath;
199                    
200          # If it is a directory, append DirectoryIndex config value          # If it is a directory, append DirectoryIndex config value
201          $path.='/'.$::CONF{'DirectoryIndex'} if(-d $path);          $path.='/'.$::CONF{'DirectoryIndex'} if(-d $path);
# Line 206  sub newDocument { Line 248  sub newDocument {
248  sub serveTo {  sub serveTo {
249          my $self=shift;          my $self=shift;
250          my $client=shift;          my $client=shift;
251            my $ct = "text/html";
252            if ($self->{'path'} =~/\.(js)$/) {
253                    $ct = "text/javascript";
254            }
255                    
256          $self->emitHeaderToClient($client,'200 OK');          $self->emitHeaderToClient($client,'200 OK',$self->{'size'}, $ct);
257                    
258          $client->write($self->{'document'});          $client->write($self->{'document'});
259    
260  }  }
261    
262  sub path {  sub path {
# Line 217  sub path { Line 264  sub path {
264  }  }
265    
266  1;  1;
 ############################################################################EOF  
267    ############################################################################EOF
Legend:
Removed from v.3  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.26