=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.26 retrieving revision 3.40 diff -u -p -r1.1.1.26 -r3.40 --- cvsweb/cvsweb.cgi 2001/06/05 10:56:15 1.1.1.26 +++ cvsweb/cvsweb.cgi 2000/11/22 19:26:11 3.40 @@ -1,4 +1,4 @@ -#!/usr/bin/perl -wT +#!/usr/bin/perl5 -ws # # cvsweb - a CGI interface to CVS trees. # @@ -18,7 +18,7 @@ # Copyright (c) 1996-1998 Bill Fenner # (c) 1998-1999 Henner Zeller # (c) 1999 Henrik Nordstrom -# (c) 2000-2001 Akinori MUSHA +# (c) 2000 Akinori MUSHA # All rights reserved. # # Redistribution and use in source and binary forms, with or without @@ -42,25 +42,21 @@ # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # -# $zId: cvsweb.cgi,v 1.106 2001/03/10 01:16:27 hnordstrom Exp $ -# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.74 2001/06/05 04:46:21 knu Exp $ +# $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $ +# $Id: cvsweb.cgi,v 3.40 2000/11/22 19:26:11 knu Exp $ # ### -require 5.000; - use strict; use vars qw ( - $cvsweb_revision - $mydir $uname $config $allow_version_select $verbose - @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr - %MIRRORS %DEFAULTVALUE %ICONS %MTYPES + $config $allow_version_select $verbose + %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted %symrev %revsym @allrevisions %date %author @revdisplayorder @revisions %state %difflines %log %branchpoint @revorder - $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi + $prcgi @prcategories $prcategories $mancgi $checkoutMagic $doCheckout $scriptname $scriptwhere $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars %funcline_regexp $is_mod_perl @@ -68,8 +64,7 @@ use vars qw ( %input $query $barequery $sortby $bydate $byrev $byauthor $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot $mimetype $charset $defaultTextPlain $defaultViewable - $command_path %CMD $allow_compress - $backicon $diricon $fileicon + $allow_compress $GZIPBIN $backicon $diricon $fileicon $fullname $newname $cvstreedefault $body_tag $body_tag_for_src $logo $defaulttitle $address $long_intro $short_instruction $shortLogLen @@ -80,12 +75,11 @@ use vars qw ( $difffontsize $inputTextSize $mime_types $allow_annotate $allow_markup $use_java_script $open_extern_window $extern_window_width $extern_window_height $edit_option_form - $show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v + $show_subdir_lastmod $show_log_in_markup $v $navigationHeaderColor $tableBorderColor $markupLogColor $tabstop $state $annTable $sel $curbranch @HideModules $module $use_descriptions %descriptions @mytz $dwhere $moddate $use_moddate $has_zlib $gzip_open - $allow_tar @tar_options @gzip_options @cvs_options $LOG_FILESEPARATOR $LOG_REVSEPARATOR ); @@ -101,7 +95,6 @@ sub revcmp($$); sub fatal($$); sub redirect($); sub safeglob($); -sub search_path($); sub getMimeTypeFromSuffix($); sub head($;$); sub scan_directives(@); @@ -129,7 +122,6 @@ sub toggleQuery($$); sub urlencode($); sub htmlquote($); sub htmlunquote($); -sub hrefquote($); sub http_header(;$); sub html_header($); sub html_footer(); @@ -137,26 +129,16 @@ sub link_tags($); sub forbidden_module($); ##### Start of Configuration Area ######## -delete $ENV{PATH}; +use Cwd; -$cvsweb_revision = '1.106' . '.' . (split(/ /, - q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.74 2001/06/05 04:46:21 knu Exp $ -))[2]; - -use File::Basename; - -($mydir) = (dirname($0) =~ /(.*)/); # untaint - # == EDIT this == # Locations to search for user configuration, in order: for ( - "$mydir/cvsweb.conf", - '/usr/local/etc/cvsweb/cvsweb.conf' + $ENV{CVSWEB_CONFIG}, + '/usr/local/etc/cvsweb.conf', + getcwd() . '/cvsweb.conf' ) { - if (defined($_) && -r $_) { - $config = $_; - last; - } + $config = $_ if defined($_) && -r $_; } # == Configuration defaults == @@ -168,8 +150,7 @@ $allow_version_select = 1; ######## Configuration variables ######### # These are defined to allow checking with perl -cw -@CVSrepositories = @CVSROOT = %CVSROOT = -%MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES = +%CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES = %tags = %alltags = @tabcolors = (); $cvstreedefault = $body_tag = $body_tag_for_src = $logo = $defaulttitle = $address = @@ -247,29 +228,23 @@ $verbose = $v; $checkoutMagic = "~checkout~"; $pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : ''; $where = $pathinfo; -$doCheckout = ($where =~ m|^/$checkoutMagic/|); -$where =~ s|^/$checkoutMagic/|/|; -$where =~ s|^/||; +$doCheckout = ($where =~ /^\/$checkoutMagic/); +$where =~ s|^/($checkoutMagic)?||; +$where =~ s|/+$||; $scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : ''; -$scriptname =~ s|^/*|/|; - -# Let's workaround thttpd's stupidity.. -if ($scriptname =~ m|/$|) { - $pathinfo .= '/'; - my $re = quotemeta $pathinfo; - $scriptname =~ s/$re$//; +$scriptname =~ s|^/?|/|; +$scriptname =~ s|/+$||; +$scriptwhere = $scriptname; +if ($where) { + $scriptwhere .= '/' . urlencode($where); } -$scriptwhere = $scriptname; -$scriptwhere .= '/' . urlencode($where); -$where = '/' if ($where eq ''); - $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); @@ -302,14 +277,16 @@ $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($@))); } else { &fatal("500 Internal Error", 'Configuration not found. Set the variable $config ' - . 'in cvsweb.cgi to your cvsweb.conf configuration file first.'); + . 'in cvsweb.cgi, or the environment variable ' + . 'CVSWEB_CONFIG, to your cvsweb.conf ' + . 'configuration file first.'); } undef %input; @@ -317,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 ""); @@ -376,10 +352,6 @@ else { } undef @barequery; -if (defined($input{path})) { - redirect("$scriptname/$input{path}$query"); -} - # get actual parameters $sortby = $input{"sortby"}; $bydate = 0; @@ -407,22 +379,7 @@ $defaultDiffType = $input{'f'}; $logsort = $input{'logsort'}; -my @tmp = @CVSrepositories; -my @pair; -while (@pair = splice(@tmp, 0, 2)) { - my($key, $val) = @pair; - my($descr, $cvsroot) = @$val; - - next if !-d $cvsroot; - - $CVSROOTdescr{$key} = $descr; - $CVSROOT{$key} = $cvsroot; - push @CVSROOT, $key; -} -undef @tmp; -undef @pair; - ## Default CVS-Tree if (!defined($CVSROOT{$cvstreedefault})) { &fatal("500 Internal Error", @@ -447,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; @@ -459,45 +416,49 @@ 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($@))); } undef $config_cvstree; -$re_prcategories = '(?:' . join('|', @prcategories) . ')' if @prcategories; -$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword); +$prcategories = '(?:' . join('|', @prcategories) . ')'; $prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/; -$fullname = "$cvsroot/$where"; +$fullname = $cvsroot . '/' . $where; $mimetype = &getMimeTypeFromSuffix ($fullname); $defaultTextPlain = ($mimetype eq "text/plain"); $defaultViewable = $allow_markup && viewable($mimetype); -my $rewrite = 0; - -if ($pathinfo =~ m|//|) { - $pathinfo =~ y|/|/|s; - $rewrite = 1; +# search for GZIP if compression allowed +# We've to find out if the GZIP-binary exists .. otherwise +# ge get an Internal Server Error if we try to pipe the +# output through the nonexistent gzip .. +# any more elegant ways to prevent this are welcome! +if ($allow_compress && $maycompress && !$has_zlib) { + foreach (split(/:/, $ENV{PATH})) { + if (-x "$_/gzip") { + $GZIPBIN = "$_/gzip"; + last; + } + } } -if (-d $fullname && $pathinfo !~ m|/$|) { - $pathinfo .= '/'; - $rewrite = 1; +if (-d $fullname) { + # + # ensure, that directories always end with (exactly) one '/' + # to allow relative URL's. If they're not, make a redirect. + ## + if (!($pathinfo =~ m|/$|) || ($pathinfo =~ m |/{2,}$|)) { + redirect ($scriptwhere . '/' . $query); + } + else { + $where .= '/'; + $scriptwhere .= '/'; + } } -if (!-d $fullname && $pathinfo =~ m|/$|) { - chop $pathinfo; - $rewrite = 1; -} - -if ($rewrite) { - redirect($scriptname . urlencode($pathinfo) . $query); -} - -undef $rewrite; - if (!-d $cvsroot) { &fatal("500 Internal Error",'$CVSROOT not found!

The server on which the CVS tree lives is probably down. Please try again in a few minutes.'); } @@ -510,58 +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; - my($module) = ($where =~ m,^/?(.*),); # untaint - $module =~ s,/[^/]*$,,; - my($basedir) = ($module =~ m,([^/]+)$,); - - if ($basedir eq '' || $module 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 = ''; - - while (1) { - my $tag = (exists $input{only_with_tag} && length $input{only_with_tag}) - ? $input{only_with_tag} : "HEAD"; - - system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag, '-d', "$tmpdir/$basedir", $module - and $fatal = "500 Internal Error","cvs co failure: $!: $module" - && last; - - $| = 1; # Essential to get the buffering right. - - print "Content-type: application/x-gzip\r\n\r\n"; - - system "$CMD{tar} @tar_options -cf - -C $tmpdir $basedir | $CMD{gzip} @gzip_options -c" - and $fatal = "500 Internal Error","tar zc failure: $!: $basedir" - && last; - - last; - } - - system $CMD{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); @@ -736,8 +649,7 @@ if (-d $fullname) { if ($_ eq '..' || -d "$fullname/$_") { next if ($_ eq '..' && $where eq '/'); - my ($rev,$date,$log,$author,$filename); - ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}} + my ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}} if (defined($fileinfo{$_})); printf '', $tabcolors[$dirrow % 2] if $dirtable; if ($_ eq '..') { @@ -748,10 +660,10 @@ if (-d $fullname) { else { print &link($backicon, $url); } - print " ", &link("Parent Directory", $url); + print " ", &link("Previous Directory", $url); } else { - $url = './' . urlencode($_) . "/$query"; + $url = urlencode($_) . "/$query"; print ""; if ($nofilelinks) { print $diricon; @@ -814,7 +726,7 @@ if (-d $fullname) { } elsif (s/,v$//) { $fileurl = ($attic ? "Attic/" : "") . urlencode($_); - $url = './' . $fileurl . $query; + $url = $fileurl . $query; my $rev = ''; my $date = ''; my $log = ''; @@ -897,27 +809,9 @@ if (-d $fullname) { ">$tag\n"; } print "\n"; - print " Module path or alias:\n"; - printf "\n", htmlquote($where); print "\n"; print "\n"; } - - if ($allow_tar) { - my($basefile) = ($where =~ m,(?:.*/)?([^/]+),); - - if (defined($basefile) && $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'}); @@ -1001,7 +895,7 @@ if (-d $fullname) { # The file has been removed and is in the Attic. # Send a redirect pointing to the file in the Attic. (my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|; - redirect("$newplace$query"); + &redirect($newplace); exit; } elsif (0 && (my @files = &safeglob($fullname . ",v"))) { @@ -1015,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")) { + 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$query"); + && -d "${cvsroot}/$2" && $module ne $2) { + &redirect($scriptname . '/' . $2 . $xtra); } } } @@ -1106,11 +1000,11 @@ sub findLastModifiedSubdirs(@) { sub htmlify_sub(&$) { (my $proc, local $_) = @_; - my @a = split(m`(]+>[^<]*)`i); + local @_ = split(m`(]+>[^<]*)`i); my $linked; my $result = ''; - while (($_, $linked) = splice(@a, 0, 2)) { + while (($_, $linked) = splice(@_, 0, 2)) { &$proc(); $result .= $_ if defined($_); $result .= $linked if defined($linked); @@ -1142,7 +1036,7 @@ sub htmlify($;$) { if ($extra) { # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn" - if (defined($prcgi) && defined($re_prcategories) && defined($re_prkeyword)) { + if (defined($prcgi)) { my $prev; do { @@ -1150,7 +1044,7 @@ sub htmlify($;$) { $_ = htmlify_sub { s{ - (\b$re_prkeyword[:\#]?\s* + (\bPR[:\#]?\s* (?: \#? \d+[,\s]\s* @@ -1158,16 +1052,16 @@ sub htmlify($;$) { \#?) (\d+)\b }{ - $1 . &link($2, sprintf($prcgi, $2)) + $1 . &link($2, sprintf($prcgi, $2)) . $3 }egix; } $_; } while ($_ ne $prev); $_ = htmlify_sub { s{ - (\b$re_prcategories/(\d+)\b) + (\b$prcategories/(\d+)\b) }{ - &link($1, sprintf($prcgi, $2)) + &link($1, sprintf($prcgi, $2)) . $3 }egox; } $_; } @@ -1176,7 +1070,7 @@ sub htmlify($;$) { if (defined($mancgi)) { $_ = htmlify_sub { s{ - (\b([a-zA-Z][\w.]+) + (\b([a-zA-Z][\w_.]+) (?: \( ([0-9n]) \)\B | @@ -1184,7 +1078,7 @@ sub htmlify($;$) { ) ) }{ - &link($1, sprintf($mancgi, defined($3) ? $3 : $4, $2)) + &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2)) . $5 }egx; } $_; } @@ -1224,11 +1118,9 @@ sub spacedHtmlText($;$) { } sub link($$) { - my($name, $url) = @_; + my($name, $where) = @_; - $url =~ s/:/sprintf("%%%02x", ord($&))/eg if $url =~ /^[^a-z]/; # relative - - sprintf '%s', hrefquote($url), $name; + sprintf '%s', htmlquote($where), $name; } sub revcmp($$) { @@ -1305,23 +1197,11 @@ sub safeglob($) { push(@results, "$dirname/" .$_); } } - closedir($dh); } @results; } -sub search_path($) { - my($command) = @_; - my $d; - - for $d (split(/:/, $command_path)) { - return "$d/$command" if -x "$d/$command"; - } - - $command; -} - sub getMimeTypeFromSuffix($) { my ($fullname) = @_; my ($mimetype, $suffix); @@ -1395,7 +1275,7 @@ sub doAnnotate($$) { my $reader = do {local(*FH);}; my $writer = do {local(*FH);}; - # make sure the revisions are wellformed, for security + # make sure the revisions a wellformed, for security # reasons .. if ($rev =~ /[^\w.]/) { &fatal("404 Not Found", @@ -1414,8 +1294,8 @@ sub doAnnotate($$) { # the public domain. # we could abandon the use of rlog, rcsdiff and co using # the cvsserver in a similiar way one day (..after rewrite) - $pid = open2($reader, $writer, $CMD{cvs}, @cvs_options, "server") - || fatal ("500 Internal Error", "Fatal Error - unable to open cvs for annotation"); + $pid = open2($reader, $writer, "cvs -Rl server") || fatal ("500 Internal Error", + "Fatal Error - unable to open cvs for annotation"); # OK, first send the request to the server. A simplified example is: # Root /home/kingdon/zwork/cvsroot @@ -1606,14 +1486,9 @@ sub doCheckout($$) { # # Safely for a child process to read from. if (! open($fh, "-|")) { # child - open(STDERR, ">&STDOUT"); # Redirect stderr to stdout - exec($CMD{cvs}, @cvs_options, '-d', $cvsroot, 'co', '-p', $revopt, $where); + 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 @@ -1633,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; @@ -1684,12 +1564,12 @@ 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"); } - elsif ($preformat_in_markup) { + else { print "
";
 
 	# prefetch several lines
@@ -1704,13 +1584,6 @@ sub cvswebMarkup($$$) {
 	}
 	print "
"; } - else { - print "
";
-	while (<$filehandle>) {
-	    print htmlquote($_);
-	}
-	print "
"; - } } sub viewable($) { @@ -1776,7 +1649,7 @@ sub doDiff($$$$$$) { while (($re1, $re2) = each %funcline_regexp) { if ($fullname =~ /$re1/) { - push @difftype, '-F', $re2; + push @difftype, '-F', '$re2'; last; } } @@ -1791,7 +1664,7 @@ sub doDiff($$$$$$) { } if (! open($fh, "-|")) { # child open(STDERR, ">&STDOUT"); # Redirect stderr to stdout - exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname); + exec("rcsdiff",@difftype,"-r$rev1","-r$rev2",$fullname); } if ($human_readable) { http_header(); @@ -1872,30 +1745,32 @@ sub getDirLogs($$@) { return; } - if (defined($tag)) { + if ($tag) { #can't use -r as - is allowed in tagnames, but misinterpreated by rlog.. if (! open($fh, "-|")) { - open(STDERR, '>/dev/null'); # rlog may complain; ignore. - exec($CMD{rlog}, @files); + open(STDERR, '>/dev/null'); # rlog may complain; ignore. + exec('rlog', @files); } } else { - if (! open($fh, "-|")) { - open(STDERR, '>/dev/null'); # rlog may complain; ignore. - exec($CMD{rlog}, '-r', @files); + my $kidpid = open($fh, "-|"); + if (! $kidpid) { + open(STDERR, '>/dev/null'); # rlog may complain; ignore. + exec('rlog', '-r', @files); } } $state = "start"; while (<$fh>) { if ($state eq "start") { #Next file. Initialize file variables - $rev = ''; - $revwanted = ''; - $branch = ''; - $branchpoint = ''; - $filename = ''; - $log = ''; - $revision = ''; + $rev = undef; + $revwanted = undef; + $branch = undef; + $branchpoint = undef; + $filename = undef; + $log = undef; + $revision = undef; + $branch = undef; %symrev = (); @filetags = (); #jump to head state @@ -1905,74 +1780,71 @@ 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 $branch eq ''; - $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 = ''; - $date = ''; - $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 = '' 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. - my $revbranch = $rev; - $revbranch =~ s/\.\d+$//; + my $revbranch; + ($revbranch = $rev) =~ s/\.\d+$//; print "$filename $rev Wanted: $revwanted ", "Revbranch: $revbranch Branch: $branch ", "Branchpoint: $branchpoint\n" if ($verbose); - if ($revwanted eq '' && $branch ne '' + if (!defined($revwanted) && defined($branch) && $branch eq $revbranch || !defined($tag)) { print "File revision $rev found for branch $branch\n" if ($verbose); $revwanted = $rev; } - if ($revwanted ne '' ? $rev eq $revwanted : - $branchpoint ne '' ? $rev eq $branchpoint : + if (defined($revwanted) ? $rev eq $revwanted : + defined($branchpoint) ? $rev eq $branchpoint : 0 && ($rev eq $head)) { # Don't think head is needed here.. print "File info $rev found for $filename\n" if ($verbose); my @finfo = ($rev,$date,$log,$author,$filename); @@ -1981,11 +1853,11 @@ again: $fileinfo{$name} = [ @finfo ]; $state = "done" if ($rev eq $revwanted); } - $rev = ''; - $date = ''; - $log = ''; + $rev = undef; + $date = undef; + $log = ""; } - elsif ($date eq '' && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) { + elsif (!defined($date) && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) { my $yr = $1; # damn 2-digit year routines :-) if ($yr > 100) { @@ -1997,7 +1869,7 @@ again: $log = ''; next; } - elsif ($rev eq '' && /^revision (.*)$/) { + elsif (!defined($rev) && m/^revision (.*)$/) { $rev = $1; next; } @@ -2012,7 +1884,7 @@ again: } if ($. == 0) { fatal("500 Internal Error", - "Failed to spawn GNU rlog on '".join(", ", @files)."'

Did you set the \$command_path in your configuration file correctly ? (Currently '$command_path'"); + "Failed to spawn GNU rlog on '".join(", ", @files)."'

did you set the \$ENV{PATH} in your configuration file correctly ?"); } close($fh); } @@ -2040,12 +1912,12 @@ sub readLog($;$) { print("Going to rlog '$fullname'\n") if ($verbose); if (! open($fh, "-|")) { # child - if ($revision ne '') { - exec($CMD{rlog}, $revision, $fullname); - } - else { - exec($CMD{rlog}, $fullname); - } + if ($revision ne '') { + exec("rlog",$revision,$fullname); + } + else { + exec("rlog",$fullname); + } } while (<$fh>) { print if ($verbose); @@ -2139,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+$// @@ -2161,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 @@ -2175,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 ""); @@ -2206,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 { @@ -2405,18 +2280,18 @@ sub printLog($;$) { if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) { my ($i,$nextmain); for ($i = 0; $i < $#revorder && $revorder[$i] ne $_; $i++){} - my @tmp2 = split(/\./, $_); + my (@tmp2) = split(/\./, $_); for ($nextmain = ""; $i > 0; $i--) { - my $next = $revorder[$i-1]; - my @tmp1 = split(/\./, $next); - if (@tmp1 < @tmp2) { + my ($next) = $revorder[$i-1]; + my (@tmp1) = split(/\./, $next); + if ($#tmp1 < $#tmp2) { $nextmain = $next; last; } # Only the highest version on a branch should have # a diff for the "next main". - last if (@tmp1 - 1 <= @tmp2 && - join(".",@tmp1[0..$#tmp1-1]) eq join(".",@tmp2[0..$#tmp1-1])); + last if (join(".",@tmp1[0..$#tmp1-1]) + eq join(".",@tmp2[0..$#tmp1-1])); } if (!defined($diffrev{$nextmain})) { $diffrev{$nextmain} = 1; @@ -2645,8 +2520,8 @@ sub human_readable_diff($){ print "
Tag: $sym2\n" if ($sym1); print "\n"; - my $fs = ""; - my $fe = ""; + my $fs = ""; + my $fe = ""; my $leftRow = 0; my $rightRow = 0; @@ -2668,7 +2543,6 @@ sub human_readable_diff($){ if ($difftxt =~ /^@@/) { ($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/; - $funname = htmlquote($funname); print ""; print "
Line $oldline"; print " $funname
"; @@ -2763,22 +2637,16 @@ sub human_readable_diff($){ sub navigateHeader($$$$$) { my ($swhere,$path,$filename,$rev,$title) = @_; $swhere = "" if ($swhere eq $scriptwhere); - $swhere = './' . urlencode($filename) if ($swhere eq ""); - - print < - - - - -$path$filename - $title - $rev -$body_tag_for_src - -
-EOF - + $swhere = urlencode($filename) if ($swhere eq ""); + print "<\!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">"; + print "\n\n"; + print ''; + print "\n$path$filename - $title - $rev\n"; + print "$body_tag_for_src\n"; + print ""; + print ""; print ""; @@ -2886,7 +2754,13 @@ sub clickablePath($$) { } sub chooseCVSRoot() { - if (2 <= @CVSROOT) { + my @foo; + foreach (sort keys %CVSROOT) { + if (-d $CVSROOT{$_}) { + push(@foo, $_); + } + } + if (@foo > 1) { my ($k); print "\n"; foreach $k (keys %input) { @@ -2901,26 +2775,19 @@ sub chooseCVSRoot() { print ""; - print ""; + print "
"; print &link($backicon, "$swhere$query#rev$rev"); - print "Return to ", &link($filename,"$swhere$query#rev$rev")," CVS log"; + print " Return to ", &link("$filename","$swhere$query#rev$rev")," CVS log"; print " $fileicon$diricon Up to ", &clickablePath($path, 1), "
\n\n"; + print "
"; } else { # no choice .. print "CVS Root: [$cvstree]"; } - - print " Module path or alias:\n"; - print "\n"; - print ""; - - if (2 <= @CVSROOT) { - print "
"; - } } sub chooseMirror() { @@ -2976,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")) { @@ -2996,10 +2863,8 @@ sub download_link($$$;$) { my ($url, $revision, $textlink, $mimetype) = @_; my ($fullurl) = download_url($url, $revision, $mimetype); - $fullurl =~ s/:/sprintf("%%%02x", ord($&))/eg; + printf '$textlink"; @@ -3072,7 +2937,8 @@ sub urlencode($) { s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge; - $_; + + $_; } sub htmlquote($) { @@ -3099,20 +2965,8 @@ sub htmlunquote($) { $_; } -sub hrefquote($) { - local($_) = @_; - - y/ /+/; - - htmlquote($_) -} - sub http_header(;$) { my $content_type = shift || "text/html"; - - $content_type .= "; charset=$charset" - if $content_type =~ m,^text/, && defined($charset) && $charset; - if (defined($moddate)) { if ($is_mod_perl) { Apache->request->header_out("Last-Modified" => scalar gmtime($moddate) . " GMT"); @@ -3128,7 +2982,7 @@ sub http_header(;$) { print "Content-type: $content_type\r\n"; } if ($allow_compress && $maycompress) { - if ($has_zlib || (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} -1 -c"))) { + if ($has_zlib || (defined($GZIPBIN) && open(GZIP, "|$GZIPBIN -1 -c"))) { if ($is_mod_perl) { Apache->request->content_encoding("x-gzip"); Apache->request->header_out(Vary => "Accept-Encoding"); @@ -3154,7 +3008,7 @@ sub http_header(;$) { else { print "\r\n"; # Close headers } - print "Unable to find gzip binary in the \$command_path ($command_path) to compress output
"; + print "Unable to find gzip binary in the \$PATH to compress output
"; } } else { @@ -3169,15 +3023,15 @@ sub http_header(;$) { sub html_header($) { my ($title) = @_; - http_header("text/html"); + my $version = '$zRevision: 1.104 $ $Revision: 3.40 $'; #' + http_header($charset ne "" ? "text/html; charset=$charset" : "text/html"); print < - $title - + $body_tag $logo

$title

@@ -3194,7 +3048,7 @@ sub link_tags($) { my ($fileurl,$filename); ($filename = $where) =~ s/^.*\///; - $fileurl = './' . urlencode($filename); + $fileurl = urlencode($filename); foreach my $sym (split(", ", $tags)) { $ret .= ",\n" if ($ret ne "");