===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.12
retrieving revision 1.1.1.17
diff -u -p -r1.1.1.12 -r1.1.1.17
--- cvsweb/cvsweb.cgi	2000/11/04 19:19:48	1.1.1.12
+++ cvsweb/cvsweb.cgi	2000/12/29 09:20:45	1.1.1.17
@@ -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.39 2000/11/04 15:32:17 knu Exp $
+# $kId: cvsweb.cgi,v 1.49 2000/12/29 09:12:15 knu Exp $
 #
 ###
 
@@ -63,10 +63,10 @@ use vars qw (
     $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased
     %input $query $barequery $sortby $bydate $byrev $byauthor
     $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot
-    $mimetype $defaultTextPlain $defaultViewable $allow_compress
-    $GZIPBIN $backicon $diricon $fileicon $fullname $newname
-    $cvstreedefault $body_tag $body_tag_for_src
-    $logo $defaulttitle $address
+    $mimetype $charset $defaultTextPlain $defaultViewable
+    $allow_compress $GZIPBIN $backicon $diricon $fileicon
+    $fullname $newname $cvstreedefault
+    $body_tag $body_tag_for_src $logo $defaulttitle $address
     $long_intro $short_instruction $shortLogLen
     $show_author $dirtable $tablepadding $columnHeaderColorDefault
     $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite
@@ -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
+    $use_moddate $has_zlib $gzip_open $allow_tar
     $LOG_FILESEPARATOR $LOG_REVSEPARATOR
 );
 
@@ -122,6 +122,7 @@ sub toggleQuery($$);
 sub urlencode($);
 sub htmlquote($);
 sub htmlunquote($);
+sub hrefquote($);
 sub http_header(;$);
 sub html_header($);
 sub html_footer();
@@ -228,9 +229,10 @@ $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|/+$||;
@@ -244,7 +246,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);
@@ -277,7 +279,7 @@ $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING})
 @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);
 
 if (-f $config) {
-   do $config
+   require $config
      || &fatal("500 Internal Error",
 	       sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>',
 		       $config, &htmlify($@)));
@@ -294,6 +296,7 @@ $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 "");
@@ -404,7 +407,7 @@ foreach $k (keys %ICONS) {
     my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}};
     if ($ipath) {
 	${"${k}icon"} = sprintf('<IMG SRC="%s" ALT="%s" BORDER="0" WIDTH="%d" HEIGHT="%d">',
-				htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight)
+				hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight)
     }
     else {
 	${"${k}icon"} = $itxt;
@@ -416,7 +419,7 @@ my $config_cvstree = "$config-$cvstree";
 
 # Do some special configuration for cvstrees
 if (-f $config_cvstree) {
-   do $config_cvstree
+   require $config_cvstree
      || &fatal("500 Internal Error",
 	       sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>',
 		       $config_cvstree, &htmlify($@)));
@@ -471,10 +474,68 @@ $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
 ###############################
-elsif (-d $fullname) {
+if (-d $fullname) {
 	my $dh = do {local(*DH);};
 	opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!");
 	my @dir = readdir($dh);
@@ -812,6 +873,22 @@ elsif (-d $fullname) {
 	    print "<INPUT TYPE=SUBMIT VALUE=\"Go\">\n";
 	    print "</FORM>\n";
 	}
+
+	if ($allow_tar) {
+	    my($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
+
+	    if ($basefile ne '') {
+		print "<HR NOSHADE>\n",
+		  "<DIV align=center>",
+		    &link("Download this directory in tarball",
+			  # Mangle the filename so browsers show a reasonable
+			  # filename to download.
+			  "$basefile.tar.gz$query".
+			  ($query ? "&" : "?")."tarball=1"),
+			    "</DIV>";
+	    }
+	}
+
 	my $formwhere = $scriptwhere;
 	$formwhere =~ s|Attic/?$|| if ($input{'hideattic'});
 
@@ -909,13 +986,13 @@ elsif (-d $fullname) {
 	my $fh = do {local(*FH);};
 	my ($xtra, $module);
 	# Assume it's a module name with a potential path following it.
-	$xtra = $& if (($module = $where) =~ s|/.*||);
+	$xtra = (($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");
 		}
 	    }
 	}
@@ -1052,7 +1129,7 @@ sub htmlify($;$) {
 		       \#?)
 		      (\d+)\b
 		     }{
-			 $1 . &link($2, sprintf($prcgi, $2)) . $3
+			 $1 . &link($2, sprintf($prcgi, $2))
 		     }egix;
 		} $_;
 	    } while ($_ ne $prev);
@@ -1061,7 +1138,7 @@ sub htmlify($;$) {
 		s{
 		  (\b$prcategories/(\d+)\b)
 		 }{
-		     &link($1, sprintf($prcgi, $2)) . $3
+		     &link($1, sprintf($prcgi, $2))
 		 }egox;
 	    } $_;
 	}
@@ -1078,7 +1155,7 @@ sub htmlify($;$) {
 		   )
 		  )
 		 }{
-		     &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2)) . $5
+		     &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2))
 		 }egx;
 	    } $_;
 	}
@@ -1120,7 +1197,7 @@ sub spacedHtmlText($;$) {
 sub link($$) {
 	my($name, $where) = @_;
 
-	sprintf '<A HREF="%s">%s</A>', htmlquote($where), $name;
+	sprintf '<A HREF="%s">%s</A>', hrefquote($where), $name;
 }
 
 sub revcmp($$) {
@@ -1489,6 +1566,11 @@ 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
@@ -1508,12 +1590,7 @@ sub doCheckout($$) {
     }
     if ($filename ne $where) {
 	&fatal("500 Internal Error",
-	       "Unexpected output from cvs co: $cvsheader"
-	       . "<p><b>Check whether the directory $cvsroot/CVSROOT exists "
-	       . "and the script has write-access to the CVSROOT/history "
-	       . "file if it exists."
-	       . "<br>The script needs to place lock files in the "
-	       . "directory the file is in as well.</b>");
+	       "Unexpected output from cvs co: $cvsheader");
     }
     $| = 1;
 
@@ -1564,10 +1641,10 @@ sub cvswebMarkup($$$) {
     my $url = download_url($fileurl, $revision, $mimetype);
     print "<HR noshade>";
     if ($mimetype =~ /^image/) {
-	printf '<IMG SRC="%s"><BR>', htmlquote("$url$barequery");
+	printf '<IMG SRC="%s"><BR>', hrefquote("$url$barequery");
     }
     elsif ($mimetype =~ m%^application/pdf%) {
-	printf '<EMBED SRC="%s" WIDTH="100%"><BR>', htmlquote("$url$barequery");
+	printf '<EMBED SRC="%s" WIDTH="100%"><BR>', hrefquote("$url$barequery");
     }
     else {
 	print "<PRE>";
@@ -1780,55 +1857,58 @@ sub getDirLogs($$@) {
 again:
 	if ($state eq "head") {
 	    #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet)
-	    $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");
+
+	    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/%%;
+	    }
 	    next;
 	}
-	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";
+	if ($state eq "tags") {
+	    if (/^\s+(.+):\s+([\d\.]+)\s+$/) {
+		push (@filetags, $1);
+		$symrev{$1} = $2;
+		$alltags{$1} = 1;
 		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.
@@ -2011,12 +2091,11 @@ 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+)$/${1}0.$2/;
-	revision:
+	($symrev{"MAIN"} = $headrev) =~ s/(\d+)$/0.$1/;
 	foreach $rev (@revorder) {
 	    if ($rev =~ /^(\S*)\.\d+$/ && $headrev eq $1) {
 		$symrev{"HEAD"} = $rev;
-		last revision;
+		last;
 	    }
 	}
 	($symrev{"HEAD"} = $headrev) =~ s/\.\d+$//
@@ -2034,7 +2113,7 @@ sub readLog($;$) {
 
 	foreach (reverse sort keys %symrev) {
 	    $rev = $symrev{$_};
-	    if ($rev =~ /^((.*)\.)0\.(\d+)$/) {
+	    if ($rev =~ /^((.*)\.)?\b0\.(\d+)$/) {
 		push(@branchnames, $_);
 		#
 		# A revision number of A.B.0.D really translates into
@@ -2048,22 +2127,20 @@ sub readLog($;$) {
 		# it has no head to translate to if there is nothing on
 		# the branch, but I guess this can never 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.
+		# (the code below gracefully forgets about the branch
+		# if it should happen)
 		#
 		$head = defined($2) ? $2 : "";
 		$branch = $3;
 		$branchrev = $head . ($head ne "" ? "." : "") . $branch;
 		my $regex;
-		($regex = $branchrev) =~ s/\./\\./g;
+		$regex = quotemeta $branchrev;
 		$rev = $head;
 
-		revision:
 		foreach my $r (@revorder) {
 		    if ($r =~ /^${regex}\b/) {
 			$rev = $branchrev;
-			last revision;
+			last;
 		    }
 		}
 		next if ($rev eq "");
@@ -2081,7 +2158,7 @@ sub readLog($;$) {
 	my ($onlyonbranch, $onlybranchpoint);
 	if ($onlyonbranch = $input{'only_with_tag'}) {
 	    $onlyonbranch = $symrev{$onlyonbranch};
-	    if ($onlyonbranch =~ s/\.0\././) {
+	    if ($onlyonbranch =~ s/\b0\.//) {
 		($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//;
 	    }
             else {
@@ -2638,9 +2715,10 @@ sub navigateHeader($$$$$) {
     my ($swhere,$path,$filename,$rev,$title) = @_;
     $swhere = "" if ($swhere eq $scriptwhere);
     $swhere = urlencode($filename) if ($swhere eq "");
-    print "<\!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">";
+    print qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`;
     print "<HTML>\n<HEAD>\n";
-    print '<!-- CVSweb $zRevision: 1.104 $  $kRevision: 1.39 $ -->';
+    print qq`<META name="robots" content="nofollow">\n`;
+    print '<!-- CVSweb $zRevision: 1.104 $  $kRevision: 1.49 $ -->';
     print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";
     print  "$body_tag_for_src\n";
     print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">";
@@ -2843,7 +2921,7 @@ sub fileSortCmp() {
 sub download_url($$;$) {
     my ($url,$revision,$mimetype) = @_;
 
-    $revision =~ s/\.0\././;
+    $revision =~ s/\b0\.//;
 
     if (defined($checkoutMagic)
 	&& (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) {
@@ -2863,7 +2941,7 @@ sub download_link($$$;$) {
     my ($url, $revision, $textlink, $mimetype) = @_;
     my ($fullurl) = download_url($url, $revision, $mimetype);
 
-    printf '<A HREF="%s"', htmlquote("$fullurl$barequery");
+    printf '<A HREF="%s"', hrefquote("$fullurl$barequery");
 
     if ($open_extern_window && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) {
 	print ' target="cvs_checkout"';
@@ -2897,7 +2975,7 @@ sub download_link($$$;$) {
 	      if (defined($extern_window_height));
 
 	    printf q` onClick="window.open('%s','cvs_checkout','%s');"`,
-	      htmlquote($fullurl), join(',', @attr);
+	      hrefquote($fullurl), join(',', @attr);
 	}
     }
     print "><b>$textlink</b></A>";
@@ -2937,8 +3015,7 @@ sub urlencode($) {
 
     s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;
 
-
-       $_;
+    $_;
 }
 
 sub htmlquote($) {
@@ -2965,6 +3042,14 @@ sub htmlunquote($) {
     $_;
 }
 
+sub hrefquote($) {
+    local($_) = @_;
+
+    y/ /+/;
+
+    htmlquote($_)
+}
+
 sub http_header(;$) {
     my $content_type = shift || "text/html";
     if (defined($moddate)) {
@@ -2999,7 +3084,7 @@ sub http_header(;$) {
 	    }
 	    select(GZIP);
 	    $gzip_open = 1;
-#	    print "<!-- gzipped -->" if ($content_type eq "text/html");
+#	    print "<!-- gzipped -->" if ($content_type =~ m|^text/html\b|);
 	}
 	else {
 	    if ($is_mod_perl) {
@@ -3023,12 +3108,14 @@ sub http_header(;$) {
 
 sub html_header($) {
     my ($title) = @_;
-    my $version = '$zRevision: 1.104 $  $kRevision: 1.39 $'; #'
-    http_header();
+    my $version = '$zRevision: 1.104 $  $kRevision: 1.49 $'; #'
+    http_header(defined($charset) ? "text/html; charset=$charset" : "text/html");
     print <<EOH;
 <!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"
  "http://www.w3.org/TR/REC-html40/loose.dtd">
 <html>
+<head>
+<meta name="robots" content="nofollow">
 <title>$title</title>
 <!-- CVSweb $version -->
 </head>