#!/usr/bin/perl 

use strict;

## NOTE: This script must not be called other than from mod_rewrite

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;
}

my $file;
my $root = '/home/httpd/html/';
if ($path =~ s#^/~(hero|wakaba)/##) {
  $file = qq'/home/$1/public_html/' . $path;
} else {
  $file = '/home/httpd/html' . $path;
} 

my $dir = $file;
my $file_name = '';
$dir =~ s#/$##;
unless (-d $dir) {
  $dir =~ s#/([^/]+)$##;
  $file_name = $1 if -f $file;
}



my $cvsuri = '';
if (-d $dir . '/CVS') {
  if (-f $dir . '/CVS/Root') {
    open my $root, '<', $dir . '/CVS/Root';
    ## NOTE: Branch is not supported
    if (<$root> =~ m#^(/home/cvs|/home/wakaba/pub/cvs)/?$#) {
      my $rpath = $1;
      if (-f $dir . '/CVS/Repository') {
        open my $repo, '<', $dir . '/CVS/Repository';
        my $reppath = <$repo>;
        $reppath =~ tr/\x0A\x0D//d;
        if ($reppath) {
          $cvsuri = qq{/gate/cvs/$reppath/$file_name@{[
                         {q[/home/cvs] => '',
                          q[/home/wakaba/pub/cvs] => '?cvsroot=Wakaba'}->{$rpath}
                       ]}};
        }
      }
    }
  }
}

unless ($cvsuri) {
  ## Bug: Status 404
  print "Location: /error/404\n";
  print "\n";
  exit;
}

print "Status: 301 Found\n";
print "Location: http://suika.fam.cx$cvsuri\n";
print "\n";