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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Fri Mar 11 11:51:06 2005 UTC (19 years, 8 months ago) by wakaba
Branch: MAIN
Comma tools: new

1 wakaba 1.1 #!/usr/bin/perl
2    
3     use strict;
4    
5     ## NOTE: This script must not be called other than from mod_rewrite
6    
7     my $path = $ENV{QUERY_STRING};
8     $path =~ s#^uri=##;
9     $path =~ s#,[^,]+$##;
10     $path =~ s/\#.*\z//s;
11     $path =~ s/\?.*\z//s;
12     $path = '/' . $path;
13     $path =~ s#//+#/#g;
14     $path ||= '/';
15     if ($path =~ /%2F/) {
16     print "Status: 404 Not Found\n";
17     print "\n";
18     print "Not found";
19     exit;
20     }
21     $path =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
22     if ($path =~ m#/\.\.?/# or $path =~ m#/\.\.?$# or $path =~ /[^\x21-\x7E]/) {
23     ## BUG: Status 404
24     print "Location: /error/404\n";
25     print "\n";
26     exit;
27     }
28    
29     my $file;
30     my $root = '/home/httpd/html/';
31     if ($path =~ s#^/~(hero|wakaba)/##) {
32     $file = qq'/home/$1/public_html/' . $path;
33     } else {
34     $file = '/home/httpd/html' . $path;
35     }
36    
37     my $dir = $file;
38     my $file_name = '';
39     $dir =~ s#/$##;
40     unless (-d $dir) {
41     $dir =~ s#/([^/]+)$##;
42     $file_name = $1 if -f $file;
43     }
44    
45    
46    
47     my $cvsuri = '';
48     if (-d $dir . '/CVS') {
49     if (-f $dir . '/CVS/Root') {
50     open my $root, '<', $dir . '/CVS/Root';
51     ## NOTE: Branch is not supported
52     if (<$root> =~ m#^(/home/cvs|/home/wakaba/pub/cvs)/?$#) {
53     my $rpath = $1;
54     if (-f $dir . '/CVS/Repository') {
55     open my $repo, '<', $dir . '/CVS/Repository';
56     my $reppath = <$repo>;
57     $reppath =~ tr/\x0A\x0D//d;
58     if ($reppath) {
59     $cvsuri = qq{/gate/cvs/$reppath/$file_name@{[
60     {q[/home/cvs] => '',
61     q[/home/wakaba/pub/cvs] => '?cvsroot=Wakaba'}->{$rpath}
62     ]}};
63     }
64     }
65     }
66     }
67     }
68    
69     unless ($cvsuri) {
70     ## Bug: Status 404
71     print "Location: /error/404\n";
72     print "\n";
73     exit;
74     }
75    
76     print "Status: 301 Found\n";
77     print "Location: http://suika.fam.cx$cvsuri\n";
78     print "\n";

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24