/[suikacvs]/test/comma/cgi-bin/comma-cvslog.cgi
Suika

Diff of /test/comma/cgi-bin/comma-cvslog.cgi

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

revision 1.1 by wakaba, Fri Mar 11 11:51:06 2005 UTC revision 1.3 by wakaba, Sat Mar 12 01:08:31 2005 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2    
 use strict;  
   
3  ## NOTE: This script must not be called other than from mod_rewrite  ## NOTE: This script must not be called other than from mod_rewrite
4    use strict;
5    
6  my $path = $ENV{QUERY_STRING};  my $path = $ENV{QUERY_STRING};
7  $path =~ s#^uri=##;  $path =~ s#^uri=##;
8  $path =~ s#,[^,]+$##;  $path =~ s#,[^,]+$##;
9  $path =~ s/\#.*\z//s;  $path =~ s/\#.*\z//s;
10  $path =~ s/\?.*\z//s;  $path =~ s/\?.*\z//s;
11  $path = '/' . $path;  $path = decode_path (canon_path ($path));
 $path =~ s#//+#/#g;  
 $path ||= '/';  
 if ($path =~ /%2F/) {  
   print "Status: 404 Not Found\n";  
   print "\n";  
   print "Not found";  
   exit;  
 }  
 $path =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;  
 if ($path =~ m#/\.\.?/# or $path =~ m#/\.\.?$# or $path =~ /[^\x21-\x7E]/) {  
   ## BUG: Status 404  
   print "Location: /error/404\n";  
   print "\n";  
   exit;  
 }  
12    
13  my $file;  my $file;
14  my $root = '/home/httpd/html/';  if ($path =~ s#^/~(hero|wakaba|fuyu)/##) {
 if ($path =~ s#^/~(hero|wakaba)/##) {  
15    $file = qq'/home/$1/public_html/' . $path;    $file = qq'/home/$1/public_html/' . $path;
16  } else {  } else {
17    $file = '/home/httpd/html' . $path;    $file = '/home/httpd/html' . $path;
# Line 66  if (-d $dir . '/CVS') { Line 49  if (-d $dir . '/CVS') {
49    }    }
50  }  }
51    
52  unless ($cvsuri) {  err_not_found () unless $cvsuri;
   ## Bug: Status 404  
   print "Location: /error/404\n";  
   print "\n";  
   exit;  
 }  
53    
54  print "Status: 301 Found\n";  print "Status: 301 Found\n";
55  print "Location: http://suika.fam.cx$cvsuri\n";  print "Location: http://suika.fam.cx$cvsuri\n";
56  print "\n";  print "\n";
57    
58    exit;
59    
60    sub err_not_found {
61      print "Status: 404 Not Found\n";
62      print "Content-Type: text/plain; charset=us-ascii\n";
63      print "\n";
64      print "Not found.";
65      exit;
66    }
67    
68    sub decode_path ($) {
69      my $path = shift;
70      if ($path =~ /%2F/) {
71        err_not_found;
72      }
73      $path =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
74      if ($path =~ /[^\x21-\x7E]/) {
75        err_not_found;
76      }
77      $path;
78    }
79    
80    sub canon_path ($) {
81      my $path = '/' . remove_dot_segments (shift or '');
82      $path =~ s#//+#/#g;
83      $path;
84    }
85    
86    sub remove_dot_segments ($) {
87      my $input = shift;
88      my @output;
89      $input =~ s/%2E/./g;  ## No semantical side effect since "." is unreserved
90      while (length $input) {
91        if ($input =~ s#^\.\.?/##g or $input =~ s#^/\.(?:/|(?![^/]))#/#g) {
92          #
93        } elsif ($input =~ s#^/\.\.(?:/|(?![^/]))#/#) {
94          pop @output;
95        } elsif ($input eq '.' or $input eq '..') {
96          last;
97        } elsif ($input =~ s#^(/?[^/]*)##) {
98          push @output, $1;
99        } else {
100          die;
101        }
102      }
103      join '', @output;
104    }
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24