--- test/comma/cgi-bin/comma-cvslog.cgi	2005/03/11 11:51:06	1.1
+++ test/comma/cgi-bin/comma-cvslog.cgi	2005/03/12 01:08:31	1.3
@@ -1,34 +1,17 @@
 #!/usr/bin/perl 
 
-use strict;
-
 ## NOTE: This script must not be called other than from mod_rewrite
+use strict;
 
 my $path = $ENV{QUERY_STRING};
 $path =~ s#^uri=##;
 $path =~ s#,[^,]+$##;
 $path =~ s/\#.*\z//s;
 $path =~ s/\?.*\z//s;
-$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;
-}
+$path = decode_path (canon_path ($path));
 
 my $file;
-my $root = '/home/httpd/html/';
-if ($path =~ s#^/~(hero|wakaba)/##) {
+if ($path =~ s#^/~(hero|wakaba|fuyu)/##) {
   $file = qq'/home/$1/public_html/' . $path;
 } else {
   $file = '/home/httpd/html' . $path;
@@ -66,13 +49,56 @@
   }
 }
 
-unless ($cvsuri) {
-  ## Bug: Status 404
-  print "Location: /error/404\n";
-  print "\n";
-  exit;
-}
+err_not_found () unless $cvsuri;
 
 print "Status: 301 Found\n";
 print "Location: http://suika.fam.cx$cvsuri\n";
 print "\n";
+
+exit;
+
+sub err_not_found {
+  print "Status: 404 Not Found\n";
+  print "Content-Type: text/plain; charset=us-ascii\n";
+  print "\n";
+  print "Not found.";
+  exit;
+}
+
+sub decode_path ($) {
+  my $path = shift;
+  if ($path =~ /%2F/) {
+    err_not_found;
+  }
+  $path =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
+  if ($path =~ /[^\x21-\x7E]/) {
+    err_not_found;
+  }
+  $path;
+}
+
+sub canon_path ($) {
+  my $path = '/' . remove_dot_segments (shift or '');
+  $path =~ s#//+#/#g;
+  $path;
+}
+
+sub remove_dot_segments ($) {
+  my $input = shift;
+  my @output;
+  $input =~ s/%2E/./g;  ## No semantical side effect since "." is unreserved
+  while (length $input) {
+    if ($input =~ s#^\.\.?/##g or $input =~ s#^/\.(?:/|(?![^/]))#/#g) {
+      # 
+    } elsif ($input =~ s#^/\.\.(?:/|(?![^/]))#/#) {
+      pop @output;
+    } elsif ($input eq '.' or $input eq '..') {
+      last;
+    } elsif ($input =~ s#^(/?[^/]*)##) {
+      push @output, $1;
+    } else {
+      die;
+    }
+  }
+  join '', @output;
+}