#!/usr/bin/perl -w
#
# Web interface for vesta
#
# This CGI can run on any web server that has the repository mounted.
# If you want to use the checkin/out capabilites, it needs to be protected
# by at least HTTP basic auth.  Any other system that sets $REMOTE_USER will work.
# the web server should also be configured to resolve hostnames of requestors and
# set $REMOTE_HOST.  This is used for realm detection and assumes that realms are domains.
# Also, for the checkin/out system to work, the browser must be run from a vesta client system
# and have a MIME handler for type application/vesta-action.  vestaweb-action is a good one to choose.
#
# TODO (in no particular order):
# * -T clean wouldn't hurt vestaweb.cgi either.
# * read/scribble/checkout buttons by each file in a package.
#	requires file->application mapping for any checked-in file type
#
# Future Features (again in random order):
# * mkdir/vcreate
# * vupdate
# * builds?
# * all of the above might wait on having Vesta::ReposUI
#
# vestaweb uses some code from CVSweb available at:
# http://linux.fh-heilbronn.de/~zeller/cgi/cvsweb.cgi
# see below for CVSweb copyright and license notice.
#
# Copyright (C) 2000-2003 Scott Venier
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
# 
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);

#### here are a few config variables #####
my $vesta = "/vesta";
my $default_dir = "$vesta";
my $vestaweb = "http://www.example.com/cgi-bin/vestaweb";
my $pics = "http://www.example.com/images";
my $diff_cmd = "/usr/bin/diff"; #need gnu diff
my $vattrib = "/vesta-srv/bin/vattrib";
#### Colors for the pretty-printed diff output ####
my $diffcolorEmpty = "#cccccc";
my $diffcolorAdd = "#ccccff";
my $diffcolorRemove = "#ff9999";
my $diffcolorChange = "#99ff99";
my $diffcolorDarkChange = "#cccccc";
my $diffcolorHeading = "#cccccc";
#### end of config variables - see allow_checkout() down 9 more lines #####

#### prototype a few functions #####
sub htmlify($);
sub human_readable_diff(@);
sub remote_domain();
sub untaint($);
sub check_referer();
sub assert_checkouts_allowed();
sub allow_checkout()
{	#this is user configurable.
	#defaults to just allowing the local domain
	my $local_domain = `dnsdomainname`;
	chomp $local_domain;
	my $remote_domain = remote_domain();
	return 0 if !defined $remote_domain;
	$remote_domain =~ s/@//;
	return $local_domain eq $remote_domain;
	###example customization
	#|| $remote_domain eq "home";
}
sub safe_backtick(@);
sub URLescape($);
sub sort_versions;
sub extract_field(\%$);
sub attrib_button($$);
sub print_package($$$);
sub read_directory($);
sub cached_glob($$);
#### end of prototypes #####

my $query=new CGI;


my $request = untaint $query->param('path');
my $erequest = URLescape($request);

if( !defined $request || $request !~ /^$vesta/o ) {
	print $query->header;
	print $query->start_html($request);
	print "Keep it in the vesta repository.  Try <a href=\"$vestaweb?path=$default_dir\">here</a>\n";
	print "</body></html>\n";
	exit;
}
if($request =~ /\.\./o) {
	print $query->header.$query->start_html("Very funny");
	print "keep .. out of the path.\n";
	print "</body></html>\n";
	exit 0;
}

if(my $node = $query->param('attrib_h')) {
	print $query->header;
	print $query->start_html("Attribute history of $request/$node");
	my @hist = `$vattrib -h $request/$node`;
	print "<pre>\n";
	print @hist;
	print "</pre>\n";
	print "<a href=\"javascript:history.go(-1)\">Back to attributes</a><BR>\n";
	print "<a href=\"javascript:history.go(-2)\">Back to before attributes</a></body></html>\n";
	exit;
}

if(my $node = $query->param('attribs')) { #attrib mode!
	print $query->header;
	print $query->start_html("Atributes of $request/$node");
	my @attribs = `$vattrib $request/$node`;
	my $enode = URLescape($node);
	print "<pre>\n";
	print @attribs;
	print "</pre>\n";
	print "<a href=\"javascript:history.go(-1)\">Back</a> ";
	print "<a href=\"$vestaweb?path=$erequest&attrib_h=$enode\">history</a></body></html>\n";
	exit;
}

if(my $diff = $query->param('diff')) { #we're in diff mode
	print $query->header;
	print $query->start_html($request);
	my $diff_args = "-rN";
	my $human_readable = 0;
	$diff_args .= "u" if $diff eq "u";
	$diff_args .= "c" if $diff eq "c";
	$diff_args .= "y" if $diff eq "y";
	$diff_args .= "e" if $diff eq "e";
	$diff_args .= "u" if $diff eq "h";
	$human_readable = 1 if $diff eq "h";
	#add any other modes we might want someday...
	#if it's a letter we don't catch, it's the old fashioned diff output.
	#we use "o" for that in the menu.

	#make sure the versions requested are immutable directories in the repository
	my $ver_a = "$request/".$query->param('a');
	my $ver_b = "$request/".$query->param('b');
	unless( -d $ver_a && `$vattrib -T $ver_a` eq "immutableDirectory\n" &&
		 -d $ver_b && `$vattrib -T $ver_b` eq "immutableDirectory\n") {
		print "<h2>laaaahooooser</h2>\n";
		print "a was $ver_a<br>b was $ver_b</body></html>\n";
		exit;
	}

	#now let's run diff...
	my @diff_out = safe_backtick($diff_cmd, $diff_args, $ver_a, $ver_b);
	if($human_readable) {
		human_readable_diff(@diff_out);
	} else {
		print "<pre>\n";
		foreach my $line (@diff_out) {
			print htmlify $line;
		}
		print "</pre>\n";
	}
	print "</body></html>";
	exit 0;
}

if(my $result = $query->param('result')) {
	assert_checkouts_allowed();
	my $action = $query->param('action');
	my $version = untaint $query->param('version');
	my $path = URLescape($request);
	if($action eq "exclusive") {
		#we tried to checkout, so there should be a stub owned by us
		my $type = `$vattrib -T $request/$version`;
		my $owner = `$vattrib -g checkout-by $request/$version`;
		chomp $owner;
		if($type ne "stub\n" || $owner ne $query->remote_user() . remote_domain()) {
			print $query->header.$query->start_html("checkout failed: $path");
			print "Your attempt to checkout $request failed.<br>\n";
			print "Please go back to <a href=\"$vestaweb?path=$path\">the package page</a> for a clue why.</body></html>\n";
			exit 0;
		} else {
			print $query->header(-refresh=>"5;$vestaweb?path=$path");
			print $query->start_html("checkout succeded: $request");
			print "Your attempt to checkout $request succeded.<br>\n";
			print "You will be taken back to <a href=\"$vestaweb?path=$path\">the package page</a> in 5 seconds.</body></html>\n";
			exit 0;
		}
	} elsif($action eq "scribble") {
		#I'm just going to assume this worked, since there's no limit to the number of scribble sessions on a package.
		print $query->header(-refresh=>"0;$vestaweb?path=$path");
		exit 0;
	} elsif($action eq "checkin") {
		#our version should no longer be a stub and should be checked-in by us
		my $type = `$vattrib -T $request/$version`;
		my $owner = `$vattrib -g checkin-by $request/$version`;
		chomp $owner;
		if($type ne "immutableDirectory\n" || $owner ne $query->remote_user() . remote_domain()) {
			print $query->header.$query->start_html("$action failed: $request");
			print "Your attempt to checkin $request failed.<br>\n";
			print "Please go back to <a href=\"$vestaweb?path=$path\">the package page</a> for a clue why.</body></html>\n";
			exit 0;
		} else {
			print $query->header(-refresh=>"5;$vestaweb?path=$path");
			print $query->start_html("$action succeded: $request");
			print "Your attempt to checkin $request succeded.<br>\n";
			print "You will be taken back to <a href=\"$vestaweb?path=$path\">the package page</a> in 5 seconds.</body></html>\n";
			exit 0;
		}
	} else {
		print $query->header.$query->start_html("$action failed: $request");
		print "I don't know how to $action $request.<br>\n";
		print "Try something else.</body></html>\n";
		exit 0;
	}
	exit 0;
}

if(my $action = $query->param('action')) { #we're trying to do something with this in the repository
	#before we actually do anything, let's find out if it has a reasonable chance of working
	#I'm going to just assume exclusive checkouts just use numbers for versions and that you will only checkin exclusive checkouts
	#this WILL lead to problems if non-integer version names are used.
	assert_checkouts_allowed();
	check_referer();
	my $latest = readlink "$request/latest";
	$latest++;
	if($action eq "exclusive") {
		#make sure nobody else has it yet
		if(`$vattrib -T $request/$latest` eq "stub\n") {
			print $query->header.$query->start_html("ERROR: $request");
			print `$vattrib -g checkout-by $request/$latest`." has already reserved version $latest of $request<BR>\n";
			print "<a href=\"$vestaweb?path=$erequest\">Return to the page for $request</a>";
			print "</body></html>";
			exit 0;
		}
	} elsif($action eq "checkin") {
		#make sure that this user has it checked out
		my $owner = `$vattrib -g checkout-by $request/$latest`;
		chomp $owner;
		if($owner ne $query->remote_user() . remote_domain()) {
			print $query->header.$query->start_html("ERROR: $request");
			print "$owner has $request checked out, not you.  You are logged in as ".$query->remote_user() . remote_domain()."<br>\n";
			print "<a href=\"$vestaweb?path=$erequest\">Return to the page for $request</a>";
			print "</body></html>";
			exit 0;
		}
		print $query->header.$query->start_html("Checking in $request");
		print "<script type=\"text/javascript\">\n";
		print "<!-- hide from old browsers...\n";
		print "function my_submit() {\n";
		print "  if (document.my_form.modified.value == 1 && document.my_form.message.value.length > 0) { \n";
		print "    document.my_form.submit();\n";
		print "  } else {\n";
		print "    alert(\"You need to specify a checkin message.\");\n";
		print "    return false;\n";
		print "  }\n";
		print "}\n";
		print "function my_change() {\n";
		print "  if (document.my_form.modified.value == 0) {\n";
		print "    document.my_form.modified.value = 1;\n";
		print "    document.my_form.message.value = \"\";\n";
		print "  }\n";
		print "}\n";
		print "// end hiding from old browsers -->\n";
		print "</script>\n";
		print "You are trying to checkin $request<br>\n";
		print "<form method=\"POST\" action=\"$vestaweb\" name=\"my_form\">\n";
		print "<input type=\"hidden\" name=\"modified\" value=0>\n";
		print "<input type=\"hidden\" name=\"path\" value=\"$erequest\">\n";
		print "<input type=\"hidden\" name=\"action\" value=\"checkin2\">\n";
		print "<textarea wrap=hard name=\"message\" cols=80 rows=5 onFocus=\"my_change();\">Please enter your checkin message.</textarea><P>\n";
		print "<input type=\"button\" value=\"Checkin\" onClick=\"my_submit();\"> ";
		print "<input type=\"button\" value=\"Cancel\" onClick=\"window.location='$vestaweb?path=$erequest';\"></form>\n";
		print "</body></html>\n";
		exit 0;
	} elsif($action eq "checkin2") {
		$action = "checkin"; #this is what actually gets sent to the mime handler
	}

	print $query->header(-type=>'application/vesta-action',
				-refresh=>"1;$vestaweb?path=$erequest\&result=1\&action=$action\&version=$latest");
	print "action: $action\n";
	print "package: $request\n";
	print "user: ".$query->remote_user()."\n";
	print "version: $latest\n";
	if($action eq "checkin") {
		my $work_dir = `$vattrib -g work-dir $request`;
		chomp $work_dir;
		print "work_dir: $work_dir\n";
		print "\n";
		print $query->param('message')."\n";
	}
	exit 0;
}

my $old_dir = "";#this needs to go here to make cached_glob happy.
print $query->header.$query->start_html($request);
if(-d $request) {
	$request =~ s/\/$//o; #strip trailing /

	my @path = split(/\//, $request);
	shift @path;
	
	#print attrib_button("",1);
	my $acc = "";
	my $path_consistant = 0;
	foreach my $i (@path) {
		$acc .= "/".$i;
		print "/<a href=\"$vestaweb?path=".URLescape($acc)."\">$i</a>";
		$path_consistant = 1 if $acc eq $vesta;
	}
	(print "you put $vesta somewhere other than \$vesta.  why?\n</body></html>\n" && exit) unless $path_consistant;
	print attrib_button("/",1) . "<HR><BR><BR>\n";

	#first, lets find out of this is more tree or if it's an actual package
	if(`$vattrib -i type package $request` eq "true\n") {
		if(allow_checkout) {
			print "<script type=\"text/javascript\">\n";
			print "<!-- hide script from old browsers...\n";
			print "function my_confirm(action) {\n";
			print "  if(confirm(\"Are you sure you want to \" + action + \" $request?\")) {\n";
			print "    action=action==\"checkout\"?\"exclusive\":action;\n";
			print "    window.location=\"$vestaweb?path=$erequest\&action=\" + action;\n";
			print "  } else {\n";
			print "    return false;\n";
			print "  }\n";
			print "}\n";
			print "// stop hiding -->\n";
			print "</script>\n";
		}
		print "<form>";
		my $latest = readlink "$request/latest";
		
		print "<font size=\"+1\"><b><a href=\"$vestaweb?path=$erequest/$latest\">latest is version $latest</a></b></font>&nbsp;&nbsp;&nbsp;\n" if defined $latest;
		print "<input type=\"button\" value=\"scribble\" onClick=\"my_confirm('scribble');\"> <input type=\"button\" value=\"checkout\" onClick=\"my_confirm('checkout');\">\n" if allow_checkout;
		print "</form>";
		print "<form method=\"POST\" action=\"$vestaweb?path=$erequest\">\n";
		print "Clicking show will show you the diff to get from the version selected in A to the version selected in B.<P>\n";
		print "<select name=\"diff\"><option value=\"u\">Unified Diff<option value=\"c\">Context Diff";
		print "<option value=\"y\">Side-by-side diff<option value=\"e\">Ed script<option value=\"o\">\"classic\" diff";
		print "<option value=\"h\" selected>Colored diff</select>\n";
		print "<input type=hidden name=\"path\" value=\"$erequest\">";
		print "<input type=submit value=\"show\"><P><table border=1>\n";
		print "<tr><th>A</th><th>B</th><th>Version</th><th>checkin-time</th><th>checkin-by</th><th>comment</th></tr>\n";
		print_package("", "", "");
		print "</table><BR>\n";
		print "</form>\n";
		print "<a href=\"$vestaweb?path=$erequest/checkout\">click here for checkout versions</a>\n";
	} else { #not a package
		print "<table border=0>\n";
		my @contents = read_directory($request);
		foreach my $i (sort @contents) {
			my $path = URLescape("$request/$i");
			print "<tr><td><a href=\"$vestaweb?path=$path\">$i</a></td><td>" .
				attrib_button($i,1) . "</td></tr>\n";
		}
		print "</table>\n";
	}

	print "</body></html>\n";
} elsif(-r $request) {
	open FILE, $request or (print "Couldn't open $request even though it's readable.  funky.\n</body></html>\n" && exit);
	#print "in the next version this might have pretty colors and links...<hr>\n<pre>";
	print "<pre>\n";
	while(my $line=<FILE>){
		print htmlify $line;
	}
	print "</pre></body></html>\n";
} else {
	print "sorry, can't browse files that I can't read.\n";
	print "try <a href=\"$vestaweb?path=$default_dir\">here</a>\n</body></html>\n";
}
exit 0;

sub read_directory($) {
	opendir DIR, $_[0] or return ();
	my @contents = readdir DIR;
	closedir DIR;

	#strip . and .. from @contents
	my @tmpcontents;
	foreach my $c (@contents) {
		next if $c eq "." || $c eq "..";
		push @tmpcontents, $c;
	}
	#print "read \"" . join(" ", @tmpcontents) . "\" from $_[0]<br>\n";
	return  @tmpcontents;
}

sub print_package($$$) {
	my $base_version = $_[0];
	my $node = $_[1];
	my $pad_string = $_[2];

	my @contents = read_directory("$request/$node");
	my @opens = grep(/co|br|sc|sv/, $query->param());
	foreach my $i (@opens) {
		$i = URLescape($i);
	}
	my $expanded_string = (join "=1&", @opens)."=1";

	#now strip everything that we don't care about
	my @tmpcontents=();
	my %branches;
	foreach my $c (@contents) {
		my $type = `$vattrib -T $request/$node/$c`;
		if($type eq "immutableDirectory\n") {
			push @tmpcontents, $c;
		#FIXME check here for a replicator munged symlink
		} elsif($type eq "stub\n" && `$vattrib -q -G symlink-to $request/$node/$c` eq "" && $c ne "latest") {
			push @tmpcontents, $c;
		} elsif(`$vattrib -i type branch $request/$node/$c` eq "true\n") {
			$branches{$c} = 1;
		#} else {
			#print "tossing $c: $type<br>";
		}
	}
	@contents = @tmpcontents;
	my $first = $pad_string eq "";
	my $second = 0;
	foreach my $i (sort sort_versions @contents) {
		my $ei = URLescape($i);
		#first do branches - we do this so the branch appears above the version it was based on...
		#this keeps the logical flow of time going up the page
		my @br_matches = grep /^$i\./, keys %branches;
		# make sure if you change this loop, you do it for the leftover branches too
		foreach my $br_match (@br_matches) {
			delete $branches{$br_match};
			if($query->param("br$br_match")) {
				my $collasp_string = $expanded_string;
				$collasp_string =~ s/br$br_match=1&*//;
				print "<tr><td colspan=2></td><td><a href=\"$vestaweb?path=$erequest\&$collasp_string\">";
				print "<img src=\"$pics/expanded.gif\" border=0 alt=\"collasp\"><b>$br_match</b></a></td>";
				print "<td colspan=3><a href=\"$vestaweb?path=$erequest/$br_match\">view branch alone</td>";
				print "<td>" . attrib_button($br_match,0) . "</tr>\n";
				print_package($i, $br_match,$pad_string.$br_match."/");
			} else {
				print "<tr><td colspan=2></td><td>";
				print "<a href=\"$vestaweb?path=$erequest\&$expanded_string\&br$br_match=1\">";
				print "<img src=\"$pics/collasped.gif\" border=0 alt=\"expand\">$br_match</a></td>";
				print "<td colspan=3><a href=\"$vestaweb?path=$erequest/$br_match\">view branch alone</td>";
				print "<td>" . attrib_button($br_match,0) . "</tr>\n";
			}
		}
		#now we do the non-exclusive checkouts
		my @scribble_list = cached_glob("$request/$node/checkout", "$i.*");
		if(@scribble_list > 0 && !$query->param("sc$i")) {
			print "<tr><td colspan=2></td><td colspan=5>";
			print "<a href=\"$vestaweb?path=$erequest\&$expanded_string\&sc$ei=1\">";
			print "<img src=\"$pics/collasped.gif\" border=0 alt=\"expand\"><b>scribbles of $i</b>";
			print "</a></td></tr>\n";
		} elsif(@scribble_list > 0) {
			my $collasp_string = $expanded_string;
			$collasp_string =~ s/sc$i=1&*//;
			print "<tr><td colspan=2></td><td colspan=5>";
			print "<a href=\"$vestaweb?path=$erequest\&$collasp_string\">";
			print "<img src=\"$pics/expanded.gif\" border=0 alt=\"collasp\"><b>scribbles of $i</b>";
			print "</a></td></tr>\n";
			foreach my $scrib (@scribble_list) {
				$scrib =~ s:/vesta.*/::g;
				my $es = URLescape($scrib);
				if($query->param("sv$scrib")){ #open
					$collasp_string = $expanded_string;
					$collasp_string =~ s/sv$scrib=1&*//;
					print "<tr><td colspan=2></td><td colspan=4>";
					print "<a href=\"$vestaweb?path=$erequest\&$collasp_string\">";
					print "<img src=\"$pics/expanded.gif\" border=0 alt=\"collasp\">$scrib</a></td>";
					print "<td>" . attrib_button("checkout/$scrib",0) . "</td></tr>\n";
					my @arcs = read_directory("$request/checkout/$scrib/");
					foreach my $arc (sort sort_versions @arcs) {
						next if $arc eq "latest";
						print "<tr><td><input type=\"radio\" name=\"a\" value=\"checkout/$scrib/$arc\"></td>";
						print "<td><input type=\"radio\" name=\"b\" value=\"checkout/$scrib/$arc\"></td>";
						print "<td colspan=4><a href=\"$vestaweb?path=$erequest/checkout/$scrib/$arc\">checkout/$scrib/$arc</a></td>";
						print "<td>" . attrib_button("checkout/$scrib/$arc",0) . "</td></tr>\n";
					}
				} else { #closed
					print "<tr><td colspan=2></td><td colspan=4>";
					my @dir_contents = read_directory("$request/checkout/$scrib/");
					if($#dir_contents >= 0) {
						print "<a href=\"$vestaweb?path=$erequest\&$expanded_string\&sv$scrib=1\">";
						print "<img src=\"$pics/collasped.gif\" border=0 alt=\"expand\">checkout/$scrib</a></td>";
					} else {
						print "checkout/$scrib&nbsp;&nbsp;&nbsp;<font size=-1>directory is empty</font></td>";
					}
					print "<td>" . attrib_button("checkout/$scrib",0) . "</td></tr>\n";
				}
			}
		}
		#now do the version itself
		print "<tr><td>".'<input type="radio" name="a" value="'."$node/$ei".'"';
		print " checked" if $second && $second--;
		print '></td>';
		print "<td>".'<input type="radio" name="b" value="'."$node/$ei".'"';
		print " checked" if $first;
		print '></td>';
		my $type = `$vattrib -T $request/$node/$i`;
		chomp $type;
		my $inout = ($type eq "stub") ? "out" : "in";
		my $time = `$vattrib -g check$inout-time $request/$node/$i`;
		my $by = `$vattrib -g check$inout-by $request/$node/$i`;
		chomp $time;
		chomp $by;
		print "<td><a href=\"$vestaweb?path=$erequest/$node/$ei\">$pad_string$i</a></td>";
		if($inout eq "out") {
			print "<td colspan=3><font color=\"red\">";
			if((allow_checkout && $query->remote_user() . remote_domain()) eq $by) {
				print "<input type=\"button\" value=\"checkin\" onClick=\"my_confirm('checkin');\">\n";
			} else {
				print "checked out by $by at $time\n";
			}
			print "</font>";
		} else {
			print "<td>$time</td><td>$by</td><td>\n";
			my @comment = `$vattrib -g message $request/$node/$i`;
			# strip a trailing blank line from the comment
			$#comment-- if $comment[$#comment] eq "\n";
			foreach my $c (@comment) {
				$c = htmlify($c);
				$c =~ s/$/<br>/o;
				print $c;
			}
		}
		print "</td><td>" . attrib_button($i,0). "</td></tr>\n";

		#now offer the checkouts for this version
		#are we expanded or collasped?
		if($query->param("co$i")) {
			my @checkouts = read_directory("$request/$node/checkout/$i");
			print "<tr><td colspan=2></td><td colspan=4>";
			my $collasp_string = $expanded_string;
			$collasp_string =~ s/co$ei=1&*//;
			print "<a href=\"$vestaweb?path=$erequest\&$collasp_string\">";
			print "<img src=\"$pics/expanded.gif\" border=0 alt=\"collasp\"><b>checkout/$i</b></a></td><td>";
			print attrib_button("checkout/$i",0) . "</tr>\n";
			foreach my $j (sort sort_versions @checkouts) {
				#FIXME check for an actual symlink
				next if $j eq "latest";
				my $ej = URLescape($j);
				print "<tr><td><input type=\"radio\" name=\"a\" value=\"checkout/$ei/$ej\"></td>";
				print "<td><input type=\"radio\" name=\"b\" value=\"checkout/$ei/$ej\"></td>";
				print "<td colspan=4><a href=\"$vestaweb?path=$erequest/checkout/$ei/$ej\">checkout/$i/$j</a></td>\n";
				print "<td>" . attrib_button("checkout/$i/$j",0) . "</td></tr>\n";
			}
		} else {
			if(-d "$request/$node/checkout/$i") {
				print "<tr><td colspan=2></td><td colspan=4>";
				print "<a href=\"$vestaweb?path=$erequest\&$expanded_string\&co$ei=1\">";
				print "<img src=\"$pics/collasped.gif\" border=0 alt=\"expand\"><b>checkout/$i</b>";
				print "</a>";
				print "</td><td>" . attrib_button("checkout/$i",0) . "</td></tr>\n";
			}
		}
		
		if($first) {
			$first = 0;
			$second = 1;
		}
	}
	# leftover branches are just like matched ones...  in fact, it's cut and paste.
	foreach my $br_match (keys %branches) {
		delete $branches{$br_match};
		if($query->param("br$br_match")) {
			my $collasp_string = $expanded_string;
			$collasp_string =~ s/br$br_match=1&*//;
			print "<tr><td colspan=2></td><td><a href=\"$vestaweb?path=$erequest\&$collasp_string\">";
			print "<img src=\"$pics/expanded.gif\" border=0 alt=\"collasp\"><b>$br_match</b></a></td>";
			print "<td colspan=3><a href=\"$vestaweb?path=$erequest/$br_match\">view branch alone</td>";
			print "<td>" . attrib_button($br_match,0) . "</tr>\n";
			print_package("", $br_match,$pad_string.$br_match."/");
		} else {
			print "<tr><td colspan=2></td><td>";
			print "<a href=\"$vestaweb?path=$erequest\&$expanded_string\&br$br_match=1\">";
			print "<img src=\"$pics/collasped.gif\" border=0 alt=\"expand\">$br_match</a></td>";
			print "<td colspan=3><a href=\"$vestaweb?path=$erequest/$br_match\">view branch alone</td>";
			print "<td>" . attrib_button($br_match,0) . "</tr>\n";
		}
	}
}

sub attrib_button($$) {
	my $enode = URLescape($_[0]);
	my $pad = $_[1];
	return ($pad ? "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;" : "") .
		"<a href=\"$vestaweb?path=$erequest&attribs=$enode\"><font size=\"-1\">attribs</a></font>";
}

my @dir_contents_cache;
sub cached_glob($$) {
	my $dir = $_[0];
	my $pattern = $_[1];
	if($old_dir ne $dir) {
		$old_dir = $dir;
		opendir DIR, $dir;
		@dir_contents_cache = readdir DIR;
		closedir DIR;
	}
	# turn the glob string into a regexp
	$pattern =~ s/\./\\./g;
	$pattern =~ s/\?/./g;
	$pattern =~ s/\*/.*/g;
	return grep {/$pattern/} @dir_contents_cache;
}

sub htmlify($) {
	my $line = $_[0];
	$line =~ s/&/&amp;/go;
	$line =~ s/</&lt;/go;
	$line =~ s/>/&gt;/go;
	return $line;
}

sub remote_domain() {
	my $remote_domain = $ENV{REMOTE_HOST};
	return undef if !defined $remote_domain;
	$remote_domain =~ s/[-a-zA-Z0-9]+\.(.*)/\@$1/o;
	return $remote_domain;
}

sub untaint($) {
	my $str = shift;
	if($str =~ /^([-\/\.\w+]+)$/o) {
		return $1;
	} else {
		return undef;
	}
}

sub check_referer() {
	my $referer = $ENV{HTTP_REFERER};
	if($referer !~ /^$vestaweb/) {
		print $query->header.$query->start_html("nice try");
		print "you cannot link directly to an action.<br>\n";
		print "try <a href=\"$vestaweb?path=$erequest\">the package page</a>\n";
		print "</body></html>\n";
		exit 0;
	}
}

sub assert_checkouts_allowed() {
	if( ! allow_checkout) {
		print $query->header.$query->start_html("nice try");
		print "checkouts are disabled on this vestaweb.<br>\n";
		print "try <a href=\"$vestaweb?path=$erequest\">the package page</a>\n";
		print "</body></html>\n";
		exit 0;
	}
}


sub safe_backtick(@) {
	my $pid = open(KID_TO_READ, "-|");
	unless (defined $pid) {
		warn "cannot fork: $!";
	}
	if ($pid) {   # parent
		my @ret = <KID_TO_READ>;
		close(KID_TO_READ);#we could care, but real backticks don't || warn "kid exited $?";
		return @ret;
	} else {      # child
		exec {$_[0]} @_ or die "can't exec program: $!";
		# NOTREACHED
	}
}

sub URLescape($) {
	#lifted from CGI::Util version 1.1 then hacked.
	my $foo = $_[0];
	$foo =~ s/([^\/a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
	return $foo;
}

# make the sort order look something like this:
# 1 2 2.foo 3 3.14 3.14-15 3.14-15-foo
sub sort_versions {
	if( $a =~ /^\d+$/ && $b =~ /^\d+$/) {
		return $b <=> $a;
	} elsif( $a =~ /^\d+$/ && $b =~ /^(\d+)/) {
		return 1 if $1 == $a;
		return $1 <=> $a;
	} elsif( $b =~ /^\d+$/ && $a =~ /^(\d+)/) {
		return -1 if $1 == $b;
		return $b <=> $1;
	} elsif( $a =~ /^[[:alpha:]]+$/ && $b =~ /^[[:alpha:]]+$/) {
		return $b cmp $a;
	} else {
		my @l = split(/[[:^alnum:]]/, $b);
		my @r = split(/[[:^alnum:]]/, $a);
		my $l = shift @l;
		my $r = shift @r;
		return 1 if !defined $r;
		return -1 if !defined $l;
		while($l eq $r) {
			$l = shift @l;
			$r = shift @r;
			return 0 if !defined $l && !defined $r;
		}
		#at this point I know I've found the left-most field that's not equal
		while(1) {
			my (%lhash, %rhash) = ();
			$lhash{orig} = $l;
			$rhash{orig} = $r;
			if( extract_field(%lhash, "^([[:digit:]]+)(.*)") && extract_field(%rhash, "^([[:digit:]]+)(.*)")) {
				if($lhash{lead} == $rhash{lead}) {
					return 1 if $lhash{new} ne "" && $rhash{new} eq "";
					return -1 if $lhash{new} eq "" && $rhash{new} ne "";
					$l = $lhash{new};
					$r = $rhash{new};
					next;
				}
				return $lhash{lead} <=> $rhash{lead};
			} elsif( extract_field(%lhash, "^([[:alpha:]]+)(.*)") && extract_field(%rhash, "^([[:alpha:]]+)(.*)")) {
				if($lhash{lead} eq $rhash{lead}) {
					return 1 if $lhash{new} ne "" && $rhash{new} eq "";
					return -1 if $lhash{new} eq "" && $rhash{new} ne "";
					$l = $lhash{new};
					$r = $rhash{new};
					next;
				}
				return $lhash{lead} cmp $rhash{lead};
			} else { #one is a digit, one is a letter.  I deem the letter bigger.
				return 1 if !defined $r;
				return -1 if !defined $l;
				return 1 if $l =~ /^[[:alpha:]]/;
				return -1 if $r =~ /^[[:alpha:]]/;
				print STDERR "neither $l or $r begins with a letter!\n";
				return 0; # gotta return SOMETHING
			}
		}
	}
}

sub extract_field(\%$) {
	my $hashref = $_[0];
	my $ret = ($$hashref{orig} =~ /$_[1]/) ? 1 : 0;
	$$hashref{lead} = $1;
	$$hashref{new} = $2;
	return $ret;
}

# The remainder of this file was lifted from CVSweb (RCS id 1.93) and slightly modified.  It is
# Copyright (c) 1996-1998 Bill Fenner
#           (c) 1998-1999 Henner Zeller
#           (c) 1999      Henrik Nordstrm
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

##
# Function to generate Human readable diff-files
# human_readable_diff(String revision_to_return_to);
##

sub flush_diff_rows ($$$$);
my $state;

sub human_readable_diff(@){
	my ($i,$difftxt, $filename);
	my @diff = @_;
	my ($date1, $date2, $r1d, $r2d, $r1r, $r2r, $rev1, $rev2, $sym1, $sym2);
	my (@rightCol, @leftCol);

	NEWFILE: #jump back here for the next file in a multi-file diff.
	# Read header to pick up read revision and date, if possible
	$diff[1] =~ /\s(.*?)\s(.*)/;
	$r1r = $1;
	$r1d = $2;
	$r1r =~ s/$request\/+(.+)\/(.+)/$1/o;
	$filename = $2;
	$diff[2] =~ /\s(.*?)\s(.*)/;
	$r2d = $2;
	$r2r = $1;
	$r2r =~ s/$request\/+(.+)\/.+/$1/o;

	if (defined($r1r)) {
		($rev1 = $r1r) =~ s/\/$//o;
		$date1 = $r1d;
	}
	if (defined($r2r)) {
		($rev2 = $r2r) =~ s/\/$//o;
		$date2 = $r2d;
	}
	
	print "<h3 align=center>Diff for $filename between version $rev1 and $rev2</h3>\n";

	print "<table border=0 cellspacing=0 cellpadding=0 width=\"100%\">\n";
	print "<tr bgcolor=\"#ffffff\">\n";
	print "<th width=\"50%\" valign=TOP>";
	print "version $rev1";
	print ", $date1" if (defined($date1));
	print "<br>Tag: $sym1\n" if ($sym1);
	print "</th>\n";
	print "<th width=\"50%\" valign=TOP>";
	print "version $rev2";
	print ", $date2" if (defined($date2));
	print "<br>Tag: $sym2\n" if ($sym1);
	print "</th>\n";

	my $fs = "<font face=\"courier,arial\">";
	my $fe = "</font>";

	my $leftRow = 0;
	my $rightRow = 0;
	my ($oldline, $newline, $funname, $diffcode, $rest);

	# Process diff text
	# The diffrows are could make excellent use of
	# cascading style sheets because we've to set the
	# font and color for each row. anyone ...?
	####
	for(my $itr=3; $itr < @diff; $itr++) {
		$difftxt = $diff[$itr];

		if ($difftxt =~ /^@@/) {
			($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
			print  "<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">";
			print "<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $oldline</b>";
			print "&nbsp;<font size=-1>$funname</font></td></tr></table>";
			print "</td><td width=\"50%\">";
			print "<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $newline</b>";
			print "&nbsp;<font size=-1>$funname</font></td></tr></table>";
			print "</td>\n";
			$state = "dump";
			$leftRow = 0;
			$rightRow = 0;
		} elsif ($difftxt =~ /^diff /) {
			flush_diff_rows(\@leftCol, \@rightCol, $leftRow, $rightRow) if $leftRow !=0 || $rightRow != 0;
			@diff = @diff[$itr ... $#diff];
			print "</table>\n";
			goto NEWFILE;
		} else {
			($diffcode,$rest) = $difftxt =~ /^([-+ ])(.*)/;
			$_ = spacedHtmlText ($rest);

			# Add fontface, size
			$_ = "$fs&nbsp;$_$fe";
			
			#########
			# little state machine to parse unified-diff output (Hen, zeller@think.de)
			# in order to get some nice 'ediff'-mode output
			# states:
			#  "dump"             - just dump the value
			#  "PreChangeRemove"  - we began with '-' .. so this could be the start of a 'change' area or just remove
			#  "PreChange"        - okey, we got several '-' lines and moved to '+' lines -> this is a change block
			##########

			if ($diffcode eq '+') {
				if ($state eq "dump") {  # 'change' never begins with '+': just dump out value
					print  "<tr><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td><td bgcolor=\"$diffcolorAdd\">$_</td></tr>\n";
				} else {                   # we got minus before
					$state = "PreChange";
					$rightCol[$rightRow++] = $_;
				}
			} elsif ($diffcode eq '-') {
				$state = "PreChangeRemove";
				$leftCol[$leftRow++] = $_;
			} else {  # empty diffcode
				flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;
				print  "<tr><td>$_</td><td>$_</td></tr>\n";
				$state = "dump";
				$leftRow = 0;
				$rightRow = 0;
			}
		}
	}
	flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;

	# state is empty if we didn't have any change
	if (!$state) {
		print "<tr><td colspan=2>&nbsp;</td></tr>";
		print "<tr bgcolor=\"$diffcolorEmpty\" >";
		print "<td colspan=2 align=center><b>- No viewable Change -</b></td></tr>";
	}
	print  "</table>";

	print "<br><hr noshade width=\"100%\">\n";

	print "<table border=0>";

	print "<tr><td>";
	# print legend
	print "<table border=1><tr><td>";
	print  "Legend:<br><table border=0 cellspacing=0 cellpadding=1>\n";
	print  "<tr><td align=center bgcolor=\"$diffcolorRemove\">Removed from v.$rev1</td><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td></tr>";
	print  "<tr bgcolor=\"$diffcolorChange\"><td align=center colspan=2>changed lines</td></tr>";
	print  "<tr><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td><td align=center bgcolor=\"$diffcolorAdd\">Added in v.$rev2</td></tr>";
	print  "</table></td></tr></table>\n";
	print "</tr></table>";
}

sub flush_diff_rows ($$$$)
{
    my $j;
    my ($leftColRef,$rightColRef,$leftRow,$rightRow) = @_;
    if ($state eq "PreChangeRemove") {          # we just got remove-lines before
      for ($j = 0 ; $j < $leftRow; $j++) {
          print  "<tr><td bgcolor=\"$diffcolorRemove\">@$leftColRef[$j]</td>";
          print  "<td bgcolor=\"$diffcolorEmpty\">&nbsp;</td></tr>\n";
      }
    }
    elsif ($state eq "PreChange") {             # state eq "PreChange"
      # we got removes with subsequent adds
      for ($j = 0; $j < $leftRow || $j < $rightRow ; $j++) {  # dump out both cols
          print  "<tr>";
          if ($j < $leftRow) {
	      print  "<td bgcolor=\"$diffcolorChange\">@$leftColRef[$j]</td>";
	  }
          else {
	      print  "<td bgcolor=\"$diffcolorDarkChange\">&nbsp;</td>";
	  }
          if ($j < $rightRow) {
	      print  "<td bgcolor=\"$diffcolorChange\">@$rightColRef[$j]</td>";
	  }
          else {
	      print  "<td bgcolor=\"$diffcolorDarkChange\">&nbsp;</td>";
	  }
          print  "</tr>\n";
      }
    }
}

sub spacedHtmlText {
	my($string, $pr) = @_;

	# Cut trailing spaces
	s/\s+$//i if defined $_;

	# Expand tabs
	#$string =~ s/\t+/' ' x (length($&) * $tabstop - length($`) % $tabstop)/e if (defined($tabstop));

	# replace <tab> and <space> ( is to protect us from htmlify)
	# gzip can make excellent use of this repeating pattern :-)
	$string =~ s//%/g; #protect our & substitute
	#if ($hr_breakable) {
	#    # make every other space 'breakable'
	#    $string =~ s/	/ nbsp; nbsp; nbsp; nbsp;/g;    # <tab>
	#    $string =~ s/  / nbsp;/g;                              # 2 * <space>
	#    # leave single space as it is
	#}
	#else {
	    $string =~ s/	/nbsp;nbsp;nbsp;nbsp;nbsp;nbsp;nbsp;nbsp;/g; 
	    $string =~ s/ /nbsp;/g;
	#}

	$string = htmlify($string);

	# unescape
	$string =~ s/([^%])/&$1/g;
	$string =~ s/%//g;

	return $string;
}
