=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.17 retrieving revision 3.40 diff -u -p -r1.1.1.17 -r3.40 --- cvsweb/cvsweb.cgi 2000/12/29 09:20:45 1.1.1.17 +++ cvsweb/cvsweb.cgi 2000/11/22 19:26:11 3.40 @@ -43,7 +43,7 @@ # SUCH DAMAGE. # # $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $ -# $kId: cvsweb.cgi,v 1.49 2000/12/29 09:12:15 knu Exp $ +# $Id: cvsweb.cgi,v 3.40 2000/11/22 19:26:11 knu Exp $ # ### @@ -79,7 +79,7 @@ use vars qw ( $navigationHeaderColor $tableBorderColor $markupLogColor $tabstop $state $annTable $sel $curbranch @HideModules $module $use_descriptions %descriptions @mytz $dwhere $moddate - $use_moddate $has_zlib $gzip_open $allow_tar + $use_moddate $has_zlib $gzip_open $LOG_FILESEPARATOR $LOG_REVSEPARATOR ); @@ -122,7 +122,6 @@ sub toggleQuery($$); sub urlencode($); sub htmlquote($); sub htmlunquote($); -sub hrefquote($); sub http_header(;$); sub html_header($); sub html_footer(); @@ -229,10 +228,9 @@ $verbose = $v; $checkoutMagic = "~checkout~"; $pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : ''; $where = $pathinfo; -$where =~ tr|/|/|s; $doCheckout = ($where =~ /^\/$checkoutMagic/); $where =~ s|^/($checkoutMagic)?||; -$where =~ s|/$||; +$where =~ s|/+$||; $scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : ''; $scriptname =~ s|^/?|/|; $scriptname =~ s|/+$||; @@ -246,7 +244,7 @@ $is_mod_perl = defined($ENV{MOD_PERL}); # in lynx, it it very annoying to have two links # per file, so disable the link at the icon # in this case: -$Browser = $ENV{HTTP_USER_AGENT} || ''; +$Browser = $ENV{HTTP_USER_AGENT}; $is_links = ($Browser =~ m`^Links `); $is_lynx = ($Browser =~ m`^Lynx/`i); $is_w3m = ($Browser =~ m`^w3m/`i); @@ -279,7 +277,7 @@ $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING}) @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); if (-f $config) { - require $config + do $config || &fatal("500 Internal Error", sprintf('Error in loading configuration file: %s

%s
', $config, &htmlify($@))); @@ -296,7 +294,6 @@ $query = $ENV{QUERY_STRING}; if (defined($query) && $query ne '') { foreach (split(/&/, $query)) { - y/+/ /; s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted if (/(\S+)=(.*)/) { $input{$1} = $2 if ($2 ne ""); @@ -407,7 +404,7 @@ foreach $k (keys %ICONS) { my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}}; if ($ipath) { ${"${k}icon"} = sprintf('%s', - hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight) + htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight) } else { ${"${k}icon"} = $itxt; @@ -419,7 +416,7 @@ my $config_cvstree = "$config-$cvstree"; # Do some special configuration for cvstrees if (-f $config_cvstree) { - require $config_cvstree + do $config_cvstree || &fatal("500 Internal Error", sprintf('Error in loading configuration file: %s

%s
', $config_cvstree, &htmlify($@))); @@ -474,68 +471,10 @@ $module = $1; if ($module && &forbidden_module($module)) { &fatal("403 Forbidden", "Access to $where forbidden."); } - -# -# Handle tarball downloads before any headers are output. -# -if ($input{tarball}) { - &fatal("403 Forbidden", "Downloading tarballs is prohibited.") - unless $allow_tar; - $where =~ s,/[^/]*$,,; - $where =~ s,^/,,; - my($basedir) = ($where =~ m,([^/]+)$,); - - if ($basedir eq '' || $where eq '') { - &fatal("500 Internal Error", "You cannot download the top level directory."); - } - - my $tmpdir = "/tmp/.cvsweb.$$." . int(time); - - mkdir($tmpdir, 0700) - or &fatal("500 Internal Error", "Unable to make temporary directory: $!"); - - my $fatal = ''; - - do { - chdir $tmpdir - or $fatal = "500 Internal Error", "Unable to cd to temporary directory: $!" - && last; - - my @params = (exists $input{only_with_tag} && length $input{only_with_tag}) - ? ("-r", $input{only_with_tag}) : (); - - system "cvs", "-RlQd", $cvsroot, "co", @params, $where - and $fatal = "500 Internal Error","cvs co failure: $!: $where" - && last; - - chdir "$where/.." - or $fatal = "500 Internal Error","Cannot find expected directory in checkout" - && last; - - $| = 1; # Essential to get the buffering right. - - print "Content-type: application/x-gzip\r\n\r\n"; - - system "tar", "--ignore-failed-read", "--exclude", "CVS", "-zcf", "-", $basedir - and $fatal = "500 Internal Error","tar zc failure: $!: $basedir" - && last; - - chdir $tmpdir - or $fatal = "500 Internal Error","Unable to cd to temporary directory: $!" - && last; - } while (0); - - system "rm", "-rf", $tmpdir if -d $tmpdir; - - &fatal($fatal) if $fatal; - - exit; -} - ############################## # View a directory ############################### -if (-d $fullname) { +elsif (-d $fullname) { my $dh = do {local(*DH);}; opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!"); my @dir = readdir($dh); @@ -873,22 +812,6 @@ if (-d $fullname) { print "\n"; print "\n"; } - - if ($allow_tar) { - my($basefile) = ($where =~ m,(?:.*/)?([^/]+),); - - if ($basefile ne '') { - print "
\n", - "
", - &link("Download this directory in tarball", - # Mangle the filename so browsers show a reasonable - # filename to download. - "$basefile.tar.gz$query". - ($query ? "&" : "?")."tarball=1"), - "
"; - } - } - my $formwhere = $scriptwhere; $formwhere =~ s|Attic/?$|| if ($input{'hideattic'}); @@ -986,13 +909,13 @@ if (-d $fullname) { my $fh = do {local(*FH);}; my ($xtra, $module); # Assume it's a module name with a potential path following it. - $xtra = (($module = $where) =~ s|/.*||) ? $& : ''; + $xtra = $& if (($module = $where) =~ s|/.*||); # Is there an indexed version of modules? if (open($fh, "$cvsroot/CVSROOT/modules")) { while (<$fh>) { if (/^(\S+)\s+(\S+)/o && $module eq $1 - && -d "$cvsroot/$2" && $module ne $2) { - &redirect("$scriptname/$2$xtra"); + && -d "${cvsroot}/$2" && $module ne $2) { + &redirect($scriptname . '/' . $2 . $xtra); } } } @@ -1129,7 +1052,7 @@ sub htmlify($;$) { \#?) (\d+)\b }{ - $1 . &link($2, sprintf($prcgi, $2)) + $1 . &link($2, sprintf($prcgi, $2)) . $3 }egix; } $_; } while ($_ ne $prev); @@ -1138,7 +1061,7 @@ sub htmlify($;$) { s{ (\b$prcategories/(\d+)\b) }{ - &link($1, sprintf($prcgi, $2)) + &link($1, sprintf($prcgi, $2)) . $3 }egox; } $_; } @@ -1155,7 +1078,7 @@ sub htmlify($;$) { ) ) }{ - &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2)) + &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2)) . $5 }egx; } $_; } @@ -1197,7 +1120,7 @@ sub spacedHtmlText($;$) { sub link($$) { my($name, $where) = @_; - sprintf '%s', hrefquote($where), $name; + sprintf '%s', htmlquote($where), $name; } sub revcmp($$) { @@ -1566,11 +1489,6 @@ sub doCheckout($$) { open(STDERR, ">&STDOUT"); # Redirect stderr to stdout exec("cvs", "-Rld", $cvsroot, "co", "-p", $revopt, $where); } - - if (eof($fh)) { - &fatal("404 Not Found", - "$where is not (any longer) pertinent"); - } #=================================================================== #Checking out squid/src/ftp.c #RCS: /usr/src/CVS/squid/src/ftp.c,v @@ -1590,7 +1508,12 @@ sub doCheckout($$) { } if ($filename ne $where) { &fatal("500 Internal Error", - "Unexpected output from cvs co: $cvsheader"); + "Unexpected output from cvs co: $cvsheader" + . "

Check whether the directory $cvsroot/CVSROOT exists " + . "and the script has write-access to the CVSROOT/history " + . "file if it exists." + . "
The script needs to place lock files in the " + . "directory the file is in as well.
"); } $| = 1; @@ -1641,10 +1564,10 @@ sub cvswebMarkup($$$) { my $url = download_url($fileurl, $revision, $mimetype); print "


"; if ($mimetype =~ /^image/) { - printf '
', hrefquote("$url$barequery"); + printf '
', htmlquote("$url$barequery"); } elsif ($mimetype =~ m%^application/pdf%) { - printf '
', hrefquote("$url$barequery"); + printf '
', htmlquote("$url$barequery"); } else { print "
";
@@ -1857,58 +1780,55 @@ sub getDirLogs($$@) {
 again:
 	if ($state eq "head") {
 	    #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet)
-
-	    if (/^Working file: (.+)$/) {
-		$filename = $1;
-	    } elsif (/^head: (.+)$/) {
-		$head = $1;
-	    } elsif (/^branch: (.+)$/) {
-		$branch = $1 
-	    } elsif (/^symbolic names:/) {
-		$state = "tags";
-		($branch = $head) =~ s/\.\d+$// if (!defined($branch));
-		$branch =~ s/(\d+)$/0.$1/;
-		$symrev{MAIN} = $branch;
-		$symrev{HEAD} = $branch;
-		$alltags{MAIN} = 1;
-		$alltags{HEAD} = 1;
-		push (@filetags, "MAIN", "HEAD");
-	    } elsif (/$LOG_REVSEPARATOR/o) {
-		$state = "log";
-		$rev = undef;
-		$date = undef;
-		$log = "";
-		# Try to reconstruct the relative filename if RCS spits out a full path
-		$filename =~ s%^\Q$DirName\E/%%;
-	    }
+	    $filename = $1 if (/^Working file: (.+)$/);
+	    $head = $1 if (/^head: (.+)$/);
+	    $branch = $1 if (/^branch: (.+)$/);
+	}
+	if ($state eq "head" && /^symbolic names/) {
+	    $state = "tags";
+	    ($branch = $head) =~ s/\.\d+$// if (!defined($branch));
+	    $branch =~ s/(\.?)(\d+)$/${1}0.$2/;
+	    $symrev{MAIN} = $branch;
+	    $symrev{HEAD} = $branch;
+	    $alltags{MAIN} = 1;
+	    $alltags{HEAD} = 1;
+	    push (@filetags, "MAIN", "HEAD");
 	    next;
 	}
-	if ($state eq "tags") {
-	    if (/^\s+(.+):\s+([\d\.]+)\s+$/) {
-		push (@filetags, $1);
-		$symrev{$1} = $2;
-		$alltags{$1} = 1;
+	if ($state eq "tags" &&
+			    /^\s+(.+):\s+([\d\.]+)\s+$/) {
+	    push (@filetags, $1);
+	    $symrev{$1} = $2;
+	    $alltags{$1} = 1;
+	    next;
+	}
+	if ($state eq "tags" && /^\S/) {
+	    if (defined($tag) && (defined($symrev{$tag}) || $tag eq "HEAD")) {
+		$revwanted = $tag eq "HEAD" ? $symrev{"MAIN"} : $symrev{$tag};
+		($branch = $revwanted) =~ s/\.0\././;
+		($branchpoint = $branch) =~ s/\.?\d+$//;
+		$revwanted = undef if ($revwanted ne $branch);
+	    }
+	    elsif (defined($tag) && $tag ne "HEAD") {
+		print "Tag not found, skip this file" if ($verbose);
+		$state = "skip";
 		next;
-	    } elsif (/^\S/) {
-		if (defined($tag)) {
-		    if(defined($symrev{$tag}) || $tag eq "HEAD") {
-			$revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag};
-			($branch = $revwanted) =~ s/\b0\.//;
-			($branchpoint = $branch) =~ s/\.?\d+$//;
-			$revwanted = undef if ($revwanted ne $branch);
-		    } elsif ($tag ne "HEAD") {
-			print "Tag not found, skip this file" if ($verbose);
-			$state = "skip";
-			next;
-		    }
-		}
-		foreach my $tagfound (@filetags) {
-		    $tags{$tagfound} = 1;
-		}
-		$state = "head";
-		goto again;
 	    }
+	    foreach my $tagfound (@filetags) {
+		$tags{$tagfound} = 1;
+	    }
+	    $state = "head";
+	    goto again;
 	}
+	if ($state eq "head" && /$LOG_REVSEPARATOR/o) {
+	    $state = "log";
+	    $rev = undef;
+	    $date = undef;
+	    $log = "";
+	    # Try to reconstruct the relative filename if RCS spits out a full path
+	    $filename =~ s%^\Q$DirName\E/%%;
+	    next;
+	}
 	if ($state eq "log") {
 	    if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {
 		# End of a log entry.
@@ -2091,11 +2011,12 @@ sub readLog($;$) {
 # is the first commit listed on the appropriate branch.
 # This is not neccesary the same revision as marked as head in the RCS file.
 	my $headrev = $curbranch || "1";
-	($symrev{"MAIN"} = $headrev) =~ s/(\d+)$/0.$1/;
+	($symrev{"MAIN"} = $headrev) =~ s/(\.?)(\d+)$/${1}0.$2/;
+	revision:
 	foreach $rev (@revorder) {
 	    if ($rev =~ /^(\S*)\.\d+$/ && $headrev eq $1) {
 		$symrev{"HEAD"} = $rev;
-		last;
+		last revision;
 	    }
 	}
 	($symrev{"HEAD"} = $headrev) =~ s/\.\d+$//
@@ -2113,7 +2034,7 @@ sub readLog($;$) {
 
 	foreach (reverse sort keys %symrev) {
 	    $rev = $symrev{$_};
-	    if ($rev =~ /^((.*)\.)?\b0\.(\d+)$/) {
+	    if ($rev =~ /^((.*)\.)0\.(\d+)$/) {
 		push(@branchnames, $_);
 		#
 		# A revision number of A.B.0.D really translates into
@@ -2127,20 +2048,22 @@ sub readLog($;$) {
 		# it has no head to translate to if there is nothing on
 		# the branch, but I guess this can never happen?
 		#
-		# (the code below gracefully forgets about the branch
-		# if it should happen)
+		# Since some stupid people actually import/check in
+		# files with version 0.X we assume that the above cannot
+		# happen, and regard 0.X(.*) as a revision and not a branch.
 		#
 		$head = defined($2) ? $2 : "";
 		$branch = $3;
 		$branchrev = $head . ($head ne "" ? "." : "") . $branch;
 		my $regex;
-		$regex = quotemeta $branchrev;
+		($regex = $branchrev) =~ s/\./\\./g;
 		$rev = $head;
 
+		revision:
 		foreach my $r (@revorder) {
 		    if ($r =~ /^${regex}\b/) {
 			$rev = $branchrev;
-			last;
+			last revision;
 		    }
 		}
 		next if ($rev eq "");
@@ -2158,7 +2081,7 @@ sub readLog($;$) {
 	my ($onlyonbranch, $onlybranchpoint);
 	if ($onlyonbranch = $input{'only_with_tag'}) {
 	    $onlyonbranch = $symrev{$onlyonbranch};
-	    if ($onlyonbranch =~ s/\b0\.//) {
+	    if ($onlyonbranch =~ s/\.0\././) {
 		($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//;
 	    }
             else {
@@ -2715,10 +2638,9 @@ sub navigateHeader($$$$$) {
     my ($swhere,$path,$filename,$rev,$title) = @_;
     $swhere = "" if ($swhere eq $scriptwhere);
     $swhere = urlencode($filename) if ($swhere eq "");
-    print qq``;
+    print "<\!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">";
     print "\n\n";
-    print qq`\n`;
-    print '';
+    print '';
     print "\n$path$filename - $title - $rev\n";
     print  "$body_tag_for_src\n";
     print "";
@@ -2921,7 +2843,7 @@ sub fileSortCmp() {
 sub download_url($$;$) {
     my ($url,$revision,$mimetype) = @_;
 
-    $revision =~ s/\b0\.//;
+    $revision =~ s/\.0\././;
 
     if (defined($checkoutMagic)
 	&& (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) {
@@ -2941,7 +2863,7 @@ sub download_link($$$;$) {
     my ($url, $revision, $textlink, $mimetype) = @_;
     my ($fullurl) = download_url($url, $revision, $mimetype);
 
-    printf '$textlink";
@@ -3015,7 +2937,8 @@ sub urlencode($) {
 
     s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;
 
-    $_;
+
+       $_;
 }
 
 sub htmlquote($) {
@@ -3042,14 +2965,6 @@ sub htmlunquote($) {
     $_;
 }
 
-sub hrefquote($) {
-    local($_) = @_;
-
-    y/ /+/;
-
-    htmlquote($_)
-}
-
 sub http_header(;$) {
     my $content_type = shift || "text/html";
     if (defined($moddate)) {
@@ -3108,14 +3023,13 @@ sub http_header(;$) {
 
 sub html_header($) {
     my ($title) = @_;
-    my $version = '$zRevision: 1.104 $  $kRevision: 1.49 $'; #'
-    http_header(defined($charset) ? "text/html; charset=$charset" : "text/html");
+    my $version = '$zRevision: 1.104 $  $Revision: 3.40 $'; #'
+    http_header($charset ne "" ? "text/html; charset=$charset" : "text/html");
     print <
 
 
-
 $title