=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.27 retrieving revision 1.1.1.28 diff -u -p -r1.1.1.27 -r1.1.1.28 --- cvsweb/cvsweb.cgi 2001/07/06 09:54:57 1.1.1.27 +++ cvsweb/cvsweb.cgi 2001/08/01 10:24:01 1.1.1.28 @@ -42,8 +42,8 @@ # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # -# $zId: cvsweb.cgi,v 1.110 2001/06/29 09:29:36 hnordstrom Exp $ -# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.78 2001/07/06 09:49:01 knu Exp $ +# $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $ +# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.82 2001/08/01 09:54:52 knu Exp $ # ### @@ -82,11 +82,12 @@ use vars qw ( $extern_window_width $extern_window_height $edit_option_form $show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v $navigationHeaderColor $tableBorderColor $markupLogColor - $tabstop $state $annTable $sel $curbranch @HideModules + $tabstop $state $annTable $sel $curbranch @HideModules @ForbiddenFiles $module $use_descriptions %descriptions @mytz $dwhere $moddate $use_moddate $has_zlib $gzip_open $allow_tar @tar_options @gzip_options @zip_options @cvs_options $LOG_FILESEPARATOR $LOG_REVSEPARATOR + $tmpdir ); sub printDiffSelect($); @@ -134,29 +135,29 @@ sub http_header(;$); sub html_header($); sub html_footer(); sub link_tags($); +sub forbidden_file($); sub forbidden_module($); ##### Start of Configuration Area ######## delete $ENV{PATH}; -$cvsweb_revision = '1.110' . '.' . (split(/ /, - q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.78 2001/07/06 09:49:01 knu Exp $ +$cvsweb_revision = + '1.112' . '.' . ( + split (/ /, + q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.82 2001/08/01 09:54:52 knu Exp $ ))[2]; use File::Basename; -($mydir) = (dirname($0) =~ /(.*)/); # untaint +($mydir) = (dirname($0) =~ /(.*)/); # untaint # == EDIT this == # Locations to search for user configuration, in order: -for ( - "$mydir/cvsweb.conf", - '/usr/local/etc/cvsweb/cvsweb.conf' - ) { - if (defined($_) && -r $_) { - $config = $_; - last; - } +for ("$mydir/cvsweb.conf", '/usr/local/etc/cvsweb/cvsweb.conf') { + if (defined($_) && -r $_) { + $config = $_; + last; + } } # == Configuration defaults == @@ -168,69 +169,67 @@ $allow_version_select = 1; ######## Configuration variables ######### # These are defined to allow checking with perl -cw -@CVSrepositories = @CVSROOT = %CVSROOT = -%MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES = -%tags = %alltags = @tabcolors = %fileinfo = (); -$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 = -$hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove = -$diffcolorChange = $diffcolorAdd = $diffcolorDarkChange = $difffontface = -$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 = $v = -$navigationHeaderColor = $tableBorderColor = $markupLogColor = -$tabstop = $use_moddate = $moddate = $gzip_open = undef; +@CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = + %MTYPES = %tags = %alltags = @tabcolors = %fileinfo = (); +$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 = + $hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove = + $diffcolorChange = $diffcolorAdd = $diffcolorDarkChange = $difffontface = + $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 = $v = $navigationHeaderColor = + $tableBorderColor = $markupLogColor = $tabstop = $use_moddate = $moddate = + $gzip_open = undef; +$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp"; $LOG_FILESEPARATOR = q/^={77}$/; -$LOG_REVSEPARATOR = q/^-{28}$/; +$LOG_REVSEPARATOR = q/^-{28}$/; @DIFFTYPES = qw(h H u c s); @DIFFTYPES{@DIFFTYPES} = ( - { - 'descr' => 'colored', - 'opts' => [ '-u' ], - 'colored' => 1, - }, - { - 'descr' => 'long colored', - 'opts' => [ '--unified=15' ], - 'colored' => 1, - }, - { - 'descr' => 'unified', - 'opts' => [ '-u' ], - 'colored' => 0, - }, - { - 'descr' => 'context', - 'opts' => [ '-c' ], - 'colored' => 0, - }, - { - 'descr' => 'side by side', - 'opts' => [ '--side-by-side', '--width=164' ], - 'colored' => 0, - }, - ); + { + 'descr' => 'colored', + 'opts' => ['-u'], + 'colored' => 1, + }, + { + 'descr' => 'long colored', + 'opts' => ['--unified=15'], + 'colored' => 1, + }, + { + 'descr' => 'unified', + 'opts' => ['-u'], + 'colored' => 0, + }, + { + 'descr' => 'context', + 'opts' => ['-c'], + 'colored' => 0, + }, + { + 'descr' => 'side by side', + 'opts' => ['--side-by-side', '--width=164'], + 'colored' => 0, + }, +); @LOGSORTKEYS = qw(cvs date rev); @LOGSORTKEYS{@LOGSORTKEYS} = ( - { - 'descr' => 'Not sorted', - }, - { - 'descr' => 'Commit date', - }, - { - 'descr' => 'Revision', - }, - ); + { + 'descr' => 'Not sorted', + }, + { + 'descr' => 'Commit date', + }, + { + 'descr' => 'Revision', + }, +); - ##### End of configuration variables ##### use Time::Local; @@ -238,15 +237,13 @@ use IPC::Open2; # Check if the zlib C library interface is installed, and if yes # we can avoid using the extra gzip process. -eval { - require Compress::Zlib; -}; +eval { require Compress::Zlib; }; $has_zlib = !$@; -$verbose = $v; +$verbose = $v; $checkoutMagic = "~checkout~"; -$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : ''; -$where = $pathinfo; +$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : ''; +$where = $pathinfo; $doCheckout = ($where =~ m|^/$checkoutMagic/|); $where =~ s|^/$checkoutMagic/|/|; $where =~ s|^/||; @@ -255,9 +252,9 @@ $scriptname =~ s|^/*|/|; # Let's workaround thttpd's stupidity.. if ($scriptname =~ m|/$|) { - $pathinfo .= '/'; - my $re = quotemeta $pathinfo; - $scriptname =~ s/$re$//; + $pathinfo .= '/'; + my $re = quotemeta $pathinfo; + $scriptname =~ s/$re$//; } $scriptwhere = $scriptname; @@ -270,10 +267,10 @@ $is_mod_perl = defined($ENV{MOD_PERL}); # per file, so disable the link at the icon # in this case: $Browser = $ENV{HTTP_USER_AGENT} || ''; -$is_links = ($Browser =~ m`^Links `); -$is_lynx = ($Browser =~ m`^Lynx/`i); -$is_w3m = ($Browser =~ m`^w3m/`i); -$is_msie = ($Browser =~ m`MSIE`); +$is_links = ($Browser =~ m`^Links `); +$is_lynx = ($Browser =~ m`^Lynx/`i); +$is_w3m = ($Browser =~ m`^w3m/`i); +$is_msie = ($Browser =~ m`MSIE`); $is_mozilla3 = ($Browser =~ m`^Mozilla/[3-9]`); $is_textbased = ($is_links || $is_lynx || $is_w3m); @@ -289,11 +286,10 @@ $nofilelinks = $is_textbased; # display garbage then :-/ # Turn off gzip if running under mod_perl and no zlib is available, # piping does not work as expected inside the server. -$maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING}) - && $ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`) - || $is_mozilla3) - && !$is_msie - && !($is_mod_perl && !$has_zlib)); +$maycompress = + (((defined($ENV{HTTP_ACCEPT_ENCODING}) + && $ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`) || $is_mozilla3) && !$is_msie + && !($is_mod_perl && !$has_zlib)); # put here the variables we need in order # to hold our state - they will be added (with @@ -302,30 +298,34 @@ $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING}) @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); if (-f $config) { - require $config - || &fatal("500 Internal Error", - sprintf('Error in loading configuration file: %s

%s
', - $config, &htmlify($@))); + require $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.'); + &fatal("500 Internal Error", + 'Configuration not found. Set the variable $config ' + . 'in cvsweb.cgi to your cvsweb.conf configuration file first.' + ); } undef %input; $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 ""); + foreach (split (/&/, $query)) { + y/+/ /; + s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted + if (/(\S+)=(.*)/) { + $input{$1} = $2 if ($2 ne ""); + } else { + $input{$_}++; + } } - else { - $input{$_}++; - } - } } # For backwards compability, set only_with_tag to only_on_branch if set. @@ -334,74 +334,77 @@ $input{only_with_tag} = $input{only_on_branch} $DEFAULTVALUE{'cvsroot'} = $cvstreedefault; -foreach (keys %DEFAULTVALUE) -{ - # replace not given parameters with the default parameters - if (!defined($input{$_}) || $input{$_} eq "") { - # Empty Checkboxes in forms return -- nothing. So we define a helper - # variable in these forms (copt) which indicates that we just set - # parameters with a checkbox - if (!defined($input{"copt"})) { - # 'copt' isn't defined --> empty input is not the result - # of empty input checkbox --> set default - $input{$_} = $DEFAULTVALUE{$_} if (defined($DEFAULTVALUE{$_})); +foreach (keys %DEFAULTVALUE) { + + # replace not given parameters with the default parameters + if (!defined($input{$_}) || $input{$_} eq "") { + + # Empty Checkboxes in forms return -- nothing. So we define a helper + # variable in these forms (copt) which indicates that we just set + # parameters with a checkbox + if (!defined($input{"copt"})) { + + # 'copt' isn't defined --> empty input is not the result + # of empty input checkbox --> set default + $input{$_} = $DEFAULTVALUE{$_} + if (defined($DEFAULTVALUE{$_})); + } else { + + # 'copt' is defined -> the result of empty input checkbox + # -> set to zero (disable) if default is a boolean (0|1). + $input{$_} = 0 + if (defined($DEFAULTVALUE{$_}) + && ($DEFAULTVALUE{$_} eq "0" + || $DEFAULTVALUE{$_} eq "1")); + } } - else { - # 'copt' is defined -> the result of empty input checkbox - # -> set to zero (disable) if default is a boolean (0|1). - $input{$_} = 0 - if (defined($DEFAULTVALUE{$_}) - && ($DEFAULTVALUE{$_} eq "0" || $DEFAULTVALUE{$_} eq "1")); - } - } } $barequery = ""; my @barequery; foreach (@stickyvars) { - # construct a query string with the sticky non default parameters set - if (defined($input{$_}) && $input{$_} ne '' && - !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) { - push @barequery, join('=', urlencode($_), urlencode($input{$_})); - } + + # construct a query string with the sticky non default parameters set + if (defined($input{$_}) && $input{$_} ne '' + && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) + { + push @barequery, + join ('=', urlencode($_), urlencode($input{$_})); + } } + # is there any query ? if (@barequery) { - $barequery = join('&', @barequery); - $query = "?$barequery"; - $barequery = "&$barequery"; + $barequery = join ('&', @barequery); + $query = "?$barequery"; + $barequery = "&$barequery"; +} else { + $query = ""; } -else { - $query = ""; -} undef @barequery; if (defined($input{path})) { - redirect("$scriptname/$input{path}$query"); + redirect("$scriptname/$input{path}$query"); } # get actual parameters -$sortby = $input{"sortby"}; -$bydate = 0; -$byrev = 0; +$sortby = $input{"sortby"}; +$bydate = 0; +$byrev = 0; $byauthor = 0; -$bylog = 0; -$byfile = 0; +$bylog = 0; +$byfile = 0; if ($sortby eq "date") { - $bydate = 1; + $bydate = 1; +} elsif ($sortby eq "rev") { + $byrev = 1; +} elsif ($sortby eq "author") { + $byauthor = 1; +} elsif ($sortby eq "log") { + $bylog = 1; +} else { + $byfile = 1; } -elsif ($sortby eq "rev") { - $byrev = 1; -} -elsif ($sortby eq "author") { - $byauthor = 1; -} -elsif ($sortby eq "log") { - $bylog = 1; -} -else { - $byfile = 1; -} $defaultDiffType = $input{'f'}; @@ -411,31 +414,31 @@ my @tmp = @CVSrepositories; my @pair; while (@pair = splice(@tmp, 0, 2)) { - my($key, $val) = @pair; - my($descr, $cvsroot) = @$val; + my ($key, $val) = @pair; + my ($descr, $cvsroot) = @$val; - next if !-d $cvsroot; + next if !-d $cvsroot; - $CVSROOTdescr{$key} = $descr; - $CVSROOT{$key} = $cvsroot; - push @CVSROOT, $key; + $CVSROOTdescr{$key} = $descr; + $CVSROOT{$key} = $cvsroot; + push @CVSROOT, $key; } undef @tmp; undef @pair; ## Default CVS-Tree if (!defined($CVSROOT{$cvstreedefault})) { - &fatal("500 Internal Error", - "\$cvstreedefault points to a repository " - . "not defined in %CVSROOT " - . "(edit your configuration file $config)"); + &fatal("500 Internal Error", + "\$cvstreedefault points to a repository ($cvstreedefault) " + . "not defined in %CVSROOT " + . "(edit your configuration file $config)"); } # alternate CVS-Tree, configured in cvsweb.conf if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) { - $cvstree = $input{'cvsroot'}; + $cvstree = $input{'cvsroot'}; } else { - $cvstree = $cvstreedefault; + $cvstree = $cvstreedefault; } $cvsroot = $CVSROOT{$cvstree}; @@ -443,15 +446,16 @@ $cvsroot = $CVSROOT{$cvstree}; # create icons out of description my $k; foreach $k (keys %ICONS) { - no strict 'refs'; - my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}}; - if ($ipath) { - ${"${k}icon"} = sprintf('%s', - hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight) - } - else { - ${"${k}icon"} = $itxt; - } + no strict 'refs'; + my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}}; + if ($ipath) { + ${"${k}icon"} = + sprintf( + '%s', + hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight) + } else { + ${"${k}icon"} = $itxt; + } } undef $k; @@ -459,47 +463,53 @@ my $config_cvstree = "$config-$cvstree"; # Do some special configuration for cvstrees if (-f $config_cvstree) { - require $config_cvstree - || &fatal("500 Internal Error", - sprintf('Error in loading configuration file: %s

%s
', - $config_cvstree, &htmlify($@))); + require $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_prcategories = '(?:' . join ('|', @prcategories) . ')' if @prcategories; $re_prkeyword = quotemeta($prkeyword) if defined($prkeyword); $prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/; -$fullname = "$cvsroot/$where"; -$mimetype = &getMimeTypeFromSuffix ($fullname); +$fullname = "$cvsroot/$where"; +$mimetype = &getMimeTypeFromSuffix($fullname); $defaultTextPlain = ($mimetype eq "text/plain"); -$defaultViewable = $allow_markup && viewable($mimetype); +$defaultViewable = $allow_markup && viewable($mimetype); my $rewrite = 0; if ($pathinfo =~ m|//|) { - $pathinfo =~ y|/|/|s; - $rewrite = 1; + $pathinfo =~ y|/|/|s; + $rewrite = 1; } if (-d $fullname && $pathinfo !~ m|/$|) { - $pathinfo .= '/'; - $rewrite = 1; + $pathinfo .= '/'; + $rewrite = 1; } if (!-d $fullname && $pathinfo =~ m|/$|) { - chop $pathinfo; - $rewrite = 1; + chop $pathinfo; + $rewrite = 1; } if ($rewrite) { - redirect($scriptname . urlencode($pathinfo) . $query); + 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.'); + &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.' + ); } # @@ -508,204 +518,259 @@ if (!-d $cvsroot) { $where =~ m:([^/]*):; $module = $1; if ($module && &forbidden_module($module)) { - &fatal("403 Forbidden", "Access to $where forbidden."); + &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($ext) = ($1 =~ /(\.tar\.gz|\.zip)$/); - my($basedir) = ($module =~ m,([^/]+)$,); + &fatal("403 Forbidden", "Downloading tarballs is prohibited.") + unless $allow_tar; + my ($module) = ($where =~ m,^/?(.*),); # untaint + $module =~ s,/([^/]*)$,,; + my ($ext) = ($1 =~ /(\.tar\.gz|\.zip)$/); + my ($basedir) = ($module =~ m,([^/]+)$,); - if ($basedir eq '' || $module eq '') { - &fatal("500 Internal Error", "You cannot download the top level directory."); - } + if ($basedir eq '' || $module eq '') { + &fatal("500 Internal Error", + "You cannot download the top level directory."); + } - my $tmpdir = "/tmp/.cvsweb.$$." . int(time); + my $tmpdir = "/tmp/.cvsweb.$$." . int(time); - mkdir($tmpdir, 0700) - or &fatal("500 Internal Error", "Unable to make temporary directory: $!"); + mkdir($tmpdir, 0700) + or &fatal("500 Internal Error", + "Unable to make temporary directory: $!"); - my @fatal; + my @fatal; - my $tag = (exists $input{only_with_tag} && length $input{only_with_tag}) - ? $input{only_with_tag} : "HEAD"; + my $tag = + (exists $input{only_with_tag} && length $input{only_with_tag}) ? + $input{only_with_tag} : "HEAD"; - if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag, '-d', "$tmpdir/$basedir", $module) { - @fatal = ("500 Internal Error", "cvs co failure: $!: $module"); - } else { - $| = 1; # Essential to get the buffering right. + if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', + $tag, '-d', "$tmpdir/$basedir", $module) + { + @fatal = ("500 Internal Error", "cvs co failure: $!: $module"); + } else { + $| = 1; # Essential to get the buffering right. - if ($ext eq '.tar.gz') { - print "Content-type: application/x-gzip\r\n\r\n"; + if ($ext eq '.tar.gz') { + 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"); - } elsif ($ext eq '.zip' && $CMD{zip}) { - print "Content-type: application/zip\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"); + } elsif ($ext eq '.zip' && $CMD{zip}) { + print "Content-type: application/zip\r\n\r\n"; - system "cd $tmpdir && $CMD{zip} @zip_options -r - $basedir" - and @fatal = ("500 Internal Error", "zip failure: $!: $basedir"); - } else { - @fatal = ("500 Internal Error", "unsupported file type"); + system + "cd $tmpdir && $CMD{zip} @zip_options -r - $basedir" + and @fatal = + ("500 Internal Error", "zip failure: $!: $basedir"); + } else { + @fatal = + ("500 Internal Error", "unsupported file type"); + } } - } - system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir; + system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir; - &fatal(@fatal) if @fatal; + &fatal(@fatal) if @fatal; - exit; + exit; } ############################## # View a directory ############################### if (-d $fullname) { - my $dh = do {local(*DH);}; - opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!"); + my $dh = do { local (*DH); }; + opendir($dh, $fullname) || &fatal("404 Not Found", "$where: $!"); my @dir = readdir($dh); closedir($dh); my @subLevelFiles = findLastModifiedSubdirs(@dir) if ($show_subdir_lastmod); - getDirLogs($cvsroot,$where,@subLevelFiles); + getDirLogs($cvsroot, $where, @subLevelFiles); if ($where eq '/') { - html_header($defaulttitle); - $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g; - print $long_intro; + html_header($defaulttitle); + $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g; + print $long_intro; + } else { + html_header($where); + print $short_instruction; } - else { - html_header($where); - print $short_instruction; - } my $descriptions; - if (($use_descriptions) && open (DESC, "<$cvsroot/CVSROOT/descriptions")) { - while () { - chomp; - my ($dir,$description) = /(\S+)\s+(.*)/; - $descriptions{$dir} = $description; - } + if (($use_descriptions) && open(DESC, "<$cvsroot/CVSROOT/descriptions")) + { + while () { + chomp; + my ($dir, $description) = /(\S+)\s+(.*)/; + $descriptions{$dir} = $description; + } } print "

\n"; + # give direct access to dirs if ($where eq '/') { - chooseMirror(); - chooseCVSRoot(); - } - else { - print "

Current directory: ", &clickablePath($where,0), "\n"; + chooseMirror (); + chooseCVSRoot (); + } else { + print "

Current directory: ", &clickablePath($where, 0), + "\n"; - print "

Current tag: ", $input{only_with_tag}, "\n" if - $input{only_with_tag}; + print "

Current tag: ", $input{only_with_tag}, "\n" + if $input{only_with_tag}; } - print "


\n"; + # Using in this manner violates the HTML2.0 spec but # provides the results that I want in most browsers. Another # case of layout spooging up HTML. my $infocols = 0; if ($dirtable) { - if (defined($tableBorderColor)) { - # Can't this be done by defining the border for the inner table? - print "
"; - } - print "\n"; - $infocols++; - printf '"; - # do not display the other column-headers, if we do not have any files - # with revision information: - if (scalar(%fileinfo)) { - $infocols++; - printf '
', - $byfile ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($byfile) { - print 'File'; - } else { - print &link('File', sprintf('./%s#dirlist', - &toggleQuery("sortby", "file"))); - } - print "', - $byrev ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($byrev) { - print 'Rev.'; - } else { - print &link('Rev.', sprintf('./%s#dirlist', - &toggleQuery("sortby", "rev"))); + if (defined($tableBorderColor)) { + + # Can't this be done by defining the border for the inner table? + print + "
"; } - print ""; + print + "\n"; $infocols++; - printf '"; - if ($show_author) { - $infocols++; - printf '"; + + # do not display the other column-headers, if we do not have any files + # with revision information: + if (scalar(%fileinfo)) { + $infocols++; + printf '"; + $infocols++; + printf '"; + + if ($show_author) { + $infocols++; + printf '"; + } + $infocols++; + printf '"; + } elsif ($use_descriptions) { + printf '"; - } - elsif ($use_descriptions) { - printf '\n"; + print "\n"; + } else { + print "\n"; } - else { - print "\n"; - } my $dirrow = 0; my $i; lookingforattic: - for ($i = 0; $i <= $#dir; $i++) { + for ($i = 0 ; $i <= $#dir ; $i++) { if ($dir[$i] eq "Attic") { - last lookingforattic; + last lookingforattic; } } - if (!$input{'hideattic'} && ($i <= $#dir) && - opendir($dh, $fullname . "/Attic")) { - splice(@dir, $i, 1, - grep((s|^|Attic/|,!m|/\.|), readdir($dh))); - closedir($dh); + + if (!$input{'hideattic'} && ($i <= $#dir) + && opendir($dh, $fullname . "/Attic")) + { + splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), readdir($dh))); + closedir($dh); } - my $hideAtticToggleLink = $input{'hideattic'} ? '' : - &link('[Hide]', sprintf('./%s#dirlist', - &toggleQuery ("hideattic"))); + my $hideAtticToggleLink = + $input{'hideattic'} ? '' : + &link('[Hide]', sprintf('./%s#dirlist', &toggleQuery("hideattic"))); # Sort without the Attic/ pathname. # place directories first @@ -717,282 +782,323 @@ if (-d $fullname) { my $filesfound; foreach (sort { &fileSortCmp } @dir) { - if ($_ eq '.') { - next; - } - # ignore CVS lock and stale NFS files - next if (/^#cvs\.|^,|^\.nfs/); + if ($_ eq '.') { + next; + } - # Check whether to show the CVSROOT path - next if ($input{'hidecvsroot'} && ($_ eq 'CVSROOT')); + # ignore CVS lock and stale NFS files + next if (/^#cvs\.|^,|^\.nfs/); - # Check whether the module is in the restricted list - next if ($_ && &forbidden_module($_)); + # Check whether to show the CVSROOT path + next if ($input{'hidecvsroot'} && ($_ eq 'CVSROOT')); - # Ignore non-readable files - next if ($input{'hidenonreadable'} && !(-r "$fullname/$_")); + # Check whether the module is in the restricted list + next if ($_ && &forbidden_module($_)); - if (s|^Attic/||) { - $attic = " (in the Attic) " . $hideAtticToggleLink; - } - else { - $attic = ""; - } + # Ignore non-readable files + next if ($input{'hidenonreadable'} && !(-r "$fullname/$_")); - if ($_ eq '..' || -d "$fullname/$_") { - next if ($_ eq '..' && $where eq '/'); - my ($rev,$date,$log,$author,$filename); - ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}} - if (defined($fileinfo{$_})); - printf '\n"; + } else { + print "
\n"; + } + $dirrow++; + } elsif (s/,v$//) { + $fileurl = ($attic ? "Attic/" : "") . urlencode($_); + $url = './' . $fileurl . $query; + my $rev = ''; + my $date = ''; + my $log = ''; + my $author = ''; + $filesexists++; + next if (!defined($fileinfo{$_})); + ($rev, $date, $log, $author) = @{$fileinfo{$_}}; + $filesfound++; + printf '" if ($dirtable); + print(($dirtable) ? "" : "
"); + $dirrow++; } - if ($dirtable) { - print "\n"; - } - else { - print "
\n"; - } - $dirrow++; - } - elsif (s/,v$//) { - $fileurl = ($attic ? "Attic/" : "") . urlencode($_); - $url = './' . $fileurl . $query; - my $rev = ''; - my $date = ''; - my $log = ''; - my $author = ''; - $filesexists++; - next if (!defined($fileinfo{$_})); - ($rev,$date,$log,$author) = @{$fileinfo{$_}}; - $filesfound++; - printf '" if ($dirtable); - print (($dirtable) ? "" : "
"); - $dirrow++; - } - print "\n"; + print "\n"; } + if ($dirtable && defined($tableBorderColor)) { - print "
', - $bydate ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($bydate) { - print 'Age'; + printf '
', + $byfile ? $columnHeaderColorSorted : + $columnHeaderColorDefault; + + if ($byfile) { + print 'File'; } else { - print &link('Age', sprintf('./%s#dirlist', - &toggleQuery("sortby", "date"))); + print &link( + 'File', + sprintf( + './%s#dirlist', + &toggleQuery("sortby", "file") + ) + ); } print "', - $byauthor ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($byauthor) { - print 'Author'; - } else { - print &link('Author', sprintf('./%s#dirlist', - &toggleQuery("sortby", "author"))); - } - print "', + $byrev ? $columnHeaderColorSorted : + $columnHeaderColorDefault; + + if ($byrev) { + print 'Rev.'; + } else { + print &link( + 'Rev.', + sprintf( + './%s#dirlist', + &toggleQuery("sortby", "rev") + ) + ); + } + print "', + $bydate ? $columnHeaderColorSorted : + $columnHeaderColorDefault; + + if ($bydate) { + print 'Age'; + } else { + print &link( + 'Age', + sprintf( + './%s#dirlist', + &toggleQuery("sortby", "date") + ) + ); + } + print "', + $byauthor ? $columnHeaderColorSorted : + $columnHeaderColorDefault; + + if ($byauthor) { + print 'Author'; + } else { + print &link( + 'Author', + sprintf( + './%s#dirlist', + &toggleQuery( + "sortby", + "author" + ) + ) + ); + } + print "', + $bylog ? $columnHeaderColorSorted : + $columnHeaderColorDefault; + + if ($bylog) { + print 'Last log entry'; + } else { + print &link( + 'Last log entry', + sprintf( + './%s#dirlist', + &toggleQuery("sortby", "log") + ) + ); + } + print "', + $columnHeaderColorDefault; + print "Description"; + $infocols++; } - $infocols++; - printf '', - $bylog ? $columnHeaderColorSorted : $columnHeaderColorDefault; - if ($bylog) { - print 'Last log entry'; - } else { - print &link('Last log entry', sprintf('./%s#dirlist', - &toggleQuery("sortby", "log"))); - } - print "', $columnHeaderColorDefault; - print "Description"; - $infocols++; - } - print "
', $tabcolors[$dirrow % 2] if $dirtable; - if ($_ eq '..') { - $url = "../$query"; - if ($nofilelinks) { - print $backicon; - } - else { - print &link($backicon, $url); - } - print " ", &link("Parent Directory", $url); + if (s|^Attic/||) { + $attic = " (in the Attic) " . $hideAtticToggleLink; + } else { + $attic = ""; } - else { - $url = './' . urlencode($_) . "/$query"; - print ""; - if ($nofilelinks) { - print $diricon; - } - else { - print &link($diricon, $url); - } - print " ", &link("$_/", $url), $attic; - if ($_ eq "Attic") { - print "  "; - print &link("[Don't hide]", sprintf('./%s#dirlist', - &toggleQuery ("hideattic"))); - } - } - # Show last change in dir - if ($filename) { - print "  " if ($dirtable); - if ($date) { - print " ", readableTime(time() - $date,0), ""; - } - if ($show_author) { + + if ($_ eq '..' || -d "$fullname/$_") { + next if ($_ eq '..' && $where eq '/'); + my ($rev, $date, $log, $author, $filename); + ($rev, $date, $log, $author, $filename) = + @{$fileinfo{$_}} + if (defined($fileinfo{$_})); + printf '
', $tabcolors[$dirrow % 2] + if $dirtable; + + if ($_ eq '..') { + $url = "../$query"; + if ($nofilelinks) { + print $backicon; + } else { + print &link($backicon, $url); + } + print " ", &link("Parent Directory", $url); + } else { + $url = './' . urlencode($_) . "/$query"; + print ""; + + if ($nofilelinks) { + print $diricon; + } else { + print &link($diricon, $url); + } + print " ", &link("$_/", $url), $attic; + + if ($_ eq "Attic") { + print "  "; + print &link( + "[Don't hide]", + sprintf( + './%s#dirlist', + &toggleQuery( + "hideattic") + ) + ); + } + } + + # Show last change in dir + if ($filename) { + print "  " + if ($dirtable); + if ($date) { + print " ", + readableTime(time() - $date, 0), + ""; + } + + if ($show_author) { + print " " if ($dirtable); + print $author; + } + print " " if ($dirtable); + $filename =~ s%^[^/]+/%%; + print "$filename/$rev"; + print "
" if ($dirtable); + + if ($log) { + print " ", &htmlify( + substr($log, 0, $shortLogLen)); + if (length $log > 80) { + print "..."; + } + print ""; + } + } else { + my ($dwhere) = + ($where ne "/" ? $where : "") . $_; + + if ($use_descriptions + && defined $descriptions{$dwhere}) + { + print "
 " + if $dirtable; + print $descriptions{$dwhere}; + } elsif ($dirtable && $infocols > 1) { + + # close the row with the appropriate number of + # columns, so that the vertical seperators are visible + my ($cols) = $infocols; + while ($cols > 1) { + print " "; + $cols--; + } + } + } + + if ($dirtable) { + print "
', $tabcolors[$dirrow % 2] + if $dirtable; + print ""; + + if ($nofilelinks) { + print $fileicon; + } else { + print &link($fileicon, $url); + } + print " ", &link($_, $url), $attic; print " " if ($dirtable); - print $author; - } - print " " if ($dirtable); - $filename =~ s%^[^/]+/%%; - print "$filename/$rev"; - print "
" if ($dirtable); - if ($log) { - print " ", - &htmlify(substr($log,0,$shortLogLen)); - if (length $log > 80) { - print "..."; + download_link($fileurl, $rev, $rev, + $defaultViewable ? "text/x-cvsweb-markup" : + undef); + print "
 " if ($dirtable); + + if ($date) { + print " ", readableTime(time() - $date, 0), + ""; } - print ""; - } - } - else { - my ($dwhere) = ($where ne "/" ? $where : "") . $_; - if ($use_descriptions && defined $descriptions{$dwhere}) { - print " " if $dirtable; - print $descriptions{$dwhere}; - } elsif ($dirtable && $infocols > 1) { - # close the row with the appropriate number of - # columns, so that the vertical seperators are visible - my($cols) = $infocols; - while ($cols > 1) { - print " "; - $cols--; + if ($show_author) { + print " " if ($dirtable); + print $author; } - } + print " " if ($dirtable); + + if ($log) { + print " ", + &htmlify(substr($log, 0, $shortLogLen)); + if (length $log > 80) { + print "..."; + } + print ""; + } + print "
', $tabcolors[$dirrow % 2] if $dirtable; - print ""; - if ($nofilelinks) { - print $fileicon; - } - else { - print &link($fileicon,$url); - } - print " ", &link($_, $url), $attic; - print " " if ($dirtable); - download_link($fileurl, - $rev, $rev, - $defaultViewable ? "text/x-cvsweb-markup" : undef); - print " " if ($dirtable); - if ($date) { - print " ", readableTime(time() - $date,0), ""; - } - if ($show_author) { - print " " if ($dirtable); - print $author; - } - print " " if ($dirtable); - if ($log) { - print " ", &htmlify(substr($log,0,$shortLogLen)); - if (length $log > 80) { - print "..."; - } - print ""; - } - print "
"; + print "
"; } - print( $dirtable == 1 ? "
\n" : "\n" ); + print($dirtable == 1 ? "
\n" : "
\n"); if ($filesexists && !$filesfound) { - print "

NOTE: There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n"; + print + "

NOTE: There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n"; } - if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) { - %tags = %alltags + if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) + { + %tags = %alltags } - if (scalar %tags - || $input{only_with_tag} - || $edit_option_form - || defined($input{"options"})) { - print "


"; + + if (scalar %tags || $input{only_with_tag} || $edit_option_form + || defined($input{"options"})) + { + print "
"; } if (scalar %tags || $input{only_with_tag}) { - print "
\n"; - foreach my $var (@stickyvars) { - print "\n" - if (defined($input{$var}) - && (!defined($DEFAULTVALUE{$var}) + print "\n"; + foreach my $var (@stickyvars) { + print + "\n" + if (defined($input{$var}) + && (!defined($DEFAULTVALUE{$var}) || $input{$var} ne $DEFAULTVALUE{$var}) - && $input{$var} ne "" - && $var ne "only_with_tag"); - } - print "Show only files with tag:\n"; - print "\n"; - print " Module path or alias:\n"; - printf "\n", htmlquote($where); - print "\n"; - print "
\n"; + && $input{$var} ne "" && $var ne "only_with_tag"); + } + print "Show only files with 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,(?:.*/)?([^/]+),); + my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),); - if (defined($basefile) && $basefile ne '') { - print "
\n", - "
Download this directory in "; - # Mangle the filename so browsers show a reasonable - # filename to download. - print &link("tarball", - "./$basefile.tar.gz$query". - ($query ? "&" : "?")."tarball=1"); - if ($CMD{zip}) { - print " or ", - &link("zip archive", - "./$basefile.zip$query". - ($query ? "&" : "?")."tarball=1"); + if (defined($basefile) && $basefile ne '') { + print "
\n", + "
Download this directory in "; + + # Mangle the filename so browsers show a reasonable + # filename to download. + print &link("tarball", "./$basefile.tar.gz$query" + . ($query ? "&" : "?") . "tarball=1"); + if ($CMD{zip}) { + print " or ", + &link("zip archive", "./$basefile.zip$query" + . ($query ? "&" : "?") . "tarball=1"); + } + print "
"; } - print "
"; - } } my $formwhere = $scriptwhere; $formwhere =~ s|Attic/?$|| if ($input{'hideattic'}); if ($edit_option_form || defined($input{"options"})) { - print "
\n"; - print "\n"; - if ($cvstree ne $cvstreedefault) { - print "\n"; - } - print "
"; - print ""; - print ""; - print ""; - print ""; - print "\n"; - print "
Preferences
Sort files by Sort log by: "; - printLogSortSelect(0); - print "
Diff format: "; - printDiffSelect(0); - print "Show Attic files: "; - print "
"; - print "
\n"; + print "
\n"; + print "\n"; + if ($cvstree ne $cvstreedefault) { + print + "\n"; + } + print "
"; + print + ""; + print ""; + print ""; + print ""; + print "\n"; + print + "
Preferences
Sort files by Sort log by: "; + printLogSortSelect(0); + print "
Diff format: "; + printDiffSelect(0); + print "Show Attic files: "; + print "
"; + print "
\n"; } print &html_footer; print "\n"; - } +} ############################### # View Files ############################### - elsif (-f $fullname . ',v') { +elsif (-f $fullname . ',v') { if (defined($input{'rev'}) || $doCheckout) { - &doCheckout($fullname, $input{'rev'}); - gzipclose(); - exit; + &doCheckout($fullname, $input{'rev'}); + gzipclose(); + exit; } + if (defined($input{'annotate'}) && $allow_annotate) { - &doAnnotate($input{'annotate'}); - gzipclose(); - exit; + &doAnnotate($input{'annotate'}); + gzipclose(); + exit; } + if (defined($input{'r1'}) && defined($input{'r2'})) { - &doDiff($fullname, $input{'r1'}, $input{'tr1'}, - $input{'r2'}, $input{'tr2'}, $input{'f'}); - gzipclose(); - exit; + &doDiff( + $fullname, $input{'r1'}, + $input{'tr1'}, $input{'r2'}, + $input{'tr2'}, $input{'f'} + ); + gzipclose(); + exit; } print("going to dolog($fullname)\n") if ($verbose); &doLog($fullname); -############################## -# View Diff -############################## - } - elsif ($fullname =~ s/\.diff$// && -f $fullname . ",v" && - $input{'r1'} && $input{'r2'}) { + ############################## + # View Diff + ############################## +} elsif ($fullname =~ s/\.diff$// && -f $fullname . ",v" && $input{'r1'} + && $input{'r2'}) +{ + # $where-diff-removal if 'cvs rdiff' is used # .. but 'cvs rdiff'doesn't support some options # rcsdiff does (-w and -p), so it is disabled @@ -1002,165 +1108,170 @@ if (-d $fullname) { # so that browsers that default to the URL # for a save filename don't save diff's as # e.g. foo.c - &doDiff($fullname, $input{'r1'}, $input{'tr1'}, - $input{'r2'}, $input{'tr2'}, $input{'f'}); + &doDiff( + $fullname, $input{'r1'}, $input{'tr1'}, $input{'r2'}, + $input{'tr2'}, $input{'f'} + ); gzipclose(); exit; - } - elsif (($newname = $fullname) =~ s|/([^/]+)$|/Attic/$1| && - -f $newname . ",v") { +} elsif (($newname = $fullname) =~ s|/([^/]+)$|/Attic/$1| && -f $newname . ",v") +{ + # 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"); exit; - } - elsif (0 && (my @files = &safeglob($fullname . ",v"))) { +} elsif (0 && (my @files = &safeglob($fullname . ",v"))) { http_header("text/plain"); print "You matched the following files:\n"; - print join("\n", @files); + print join ("\n", @files); + # Find the tags from each file # Display a form offering diffs between said tags - } - else { - my $fh = do {local(*FH);}; +} else { + my $fh = do { local (*FH); }; my ($xtra, $module); + # Assume it's a module name with a potential path following it. $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$query"); + while (<$fh>) { + if (/^(\S+)\s+(\S+)/o && $module eq $1 + && -d "$cvsroot/$2" && $module ne $2) + { + redirect("$scriptname/$2$xtra$query"); + } } - } } - &fatal("404 Not Found","$where: no such file or directory"); - } + &fatal("404 Not Found", "$where: no such file or directory"); +} gzipclose(); + ## End MAIN sub printDiffSelect($) { - my ($use_java_script) = @_; - my $f = $input{'f'}; + my ($use_java_script) = @_; + my $f = $input{'f'}; - print ''; - local $_; - for (@DIFFTYPES) { - printf('