=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.32 retrieving revision 1.7 diff -u -p -r1.1.1.32 -r1.7 --- cvsweb/cvsweb.cgi 2002/07/07 04:31:41 1.1.1.32 +++ cvsweb/cvsweb.cgi 1997/04/30 18:25:05 1.7 @@ -1,3745 +1,627 @@ -#!/usr/bin/perl -wT +#!/usr/bin/perl -s # -# cvsweb - a CGI interface to CVS trees. +# cvsweb - a CGI interface to the CVS tree. # -# Written in their spare time by -# Bill Fenner (original work) -# extended by Henner Zeller , -# Henrik Nordstrom -# Ken Coar -# Dick Balaska -# Akinori MUSHA -# Jens-Uwe Mager -# Ville Skyttä +# Written by Bill Fenner on his own time. +# Insert BSD copyright here. # -# Based on: -# * Bill Fenners cvsweb.cgi revision 1.28 available from: -# http://www.FreeBSD.org/cgi/cvsweb.cgi/www/en/cgi/cvsweb.cgi +#HTTP_USER_AGENT: Mozilla/1.1N (X11; I; SunOS 4.1.3_U1 sun4m) via proxy gateway CERN-HTTPD/3.0 libwww/2.17 +#SERVER_NAME: www.freebsd.org +#QUERY_STRING: baz +#SCRIPT_FILENAME: /usr/local/www/cgi-bin/env.pl +#SERVER_PORT: 80 +#HTTP_ACCEPT: */*, image/gif, image/x-xbitmap, image/jpeg +#SERVER_PROTOCOL: HTTP/1.0 +#HTTP_COOKIE: s=beta26429821397802167 +#PATH_INFO: /foo/bar +#REMOTE_ADDR: 13.1.64.94 +#DOCUMENT_ROOT: /usr/local/www/data/ +#PATH: /sbin:/bin:/usr/sbin:/usr/bin +#PATH_TRANSLATED: /usr/local/www/data//foo/bar +#GATEWAY_INTERFACE: CGI/1.1 +#REQUEST_METHOD: GET +#SCRIPT_NAME: /cgi-bin/env.pl +#SERVER_SOFTWARE: Apache/1.0.0 +#REMOTE_HOST: beta.xerox.com +#SERVER_ADMIN: webmaster@freebsd.org # -# Copyright (c) 1996-1998 Bill Fenner -# (c) 1998-1999 Henner Zeller -# (c) 1999 Henrik Nordstrom -# (c) 2000-2002 Akinori MUSHA -# (c) 2002 Ville Skyttä -# 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. -# -# $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.112 2002/07/06 18:15:19 scop Exp $ -# $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $ -# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $ -# -### +require 'timelocal.pl'; +require 'ctime.pl'; -require 5.000; +$hsty_base = ""; +require 'cgi-style.pl'; -use strict; +$cvsroot = '/home/ncvs'; +$intro = " +This is a WWW interface to the FreeBSD CVS tree. +You can browse the file hierarchy by picking directories +(which have slashes after them, e.g. src/). +If you pick a file, you will see the revision history +for that file. +Selecting a revision number will download that revision of +the file. There is a link at each revision to display +diffs between that revision and the previous one, and +a form at the bottom of the page that allows you to +display diffs between arbitrary revisions. +

+If you would like to use this CGI script on your own web server and +CVS tree, see +the CVSWeb distribution site. +

+Please send any suggestions, comments, etc. to +Bill Fenner <fenner@freebsd.org> +"; +$shortinstr = " +Click on a directory to enter that directory. Click on a file to display +its revision history and to get a +chance to display diffs between revisions. +"; -use vars qw ( - $cvsweb_revision - $mydir $uname $config $allow_version_select $verbose - @CVSrepositories @CVSROOT %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 - $checkoutMagic $doCheckout $scriptname $scriptwhere - $where $pathinfo $Browser $nofilelinks $maycompress - @stickyvars @unsafevars - %funcline_regexp $is_mod_perl - $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased - %input $query $barequery $sortby $bydate $byrev $byauthor - $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot - $mimetype $charset $output_filter $defaultTextPlain $defaultViewable - $command_path %CMD $allow_compress - $backicon $diricon $fileicon - $fullname $newname $cvstreedefault - $body_tag $body_tag_for_src $logo $defaulttitle $address - $long_intro $short_instruction $shortLogLen - $show_author $dirtable $tablepadding $columnHeaderColorDefault - $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite - $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove - $diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface - $difffontsize $inputTextSize $mime_types - $allow_annotate $allow_markup - $allow_log_extra $allow_dir_extra $allow_source_extra - $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 - $navigationHeaderColor $tableBorderColor $markupLogColor - $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 $HTML_DOCTYPE $HTML_META -); +$verbose = $v; +($where = $ENV{'PATH_INFO'}) =~ s|^/||; +$where =~ s|/$||; +$fullname = $cvsroot . '/' . $where; +($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|; +$scriptname =~ s|/$||; +$scriptwhere = $scriptname . '/' . $where; +$scriptwhere =~ s|/$||; -sub printDiffSelect($); -sub printDiffLinks($$); -sub printLogSortSelect($); -sub findLastModifiedSubdirs(@); -sub htmlify_sub(&$); -sub htmlify($;$); -sub spacedHtmlText($;$); -sub link($$); -sub revcmp($$); -sub fatal($$@); -sub redirect($); -sub safeglob($); -sub search_path($); -sub getMimeTypeFromSuffix($); -sub head($;$); -sub scan_directives(@); -sub openOutputFilter(); -sub doAnnotate($$); -sub doCheckout($$); -sub cvswebMarkup($$$); -sub viewable($); -sub doDiff($$$$$$); -sub getDirLogs($$@); -sub readLog($;$); -sub printLog($;$); -sub doLog($); -sub flush_diff_rows($$$$); -sub human_readable_diff($); -sub navigateHeader($$$$$); -sub plural_write($$); -sub readableTime($$); -sub clickablePath($$); -sub chooseCVSRoot(); -sub chooseMirror(); -sub fileSortCmp(); -sub download_url($$;$); -sub download_link($$$;$); -sub toggleQuery($$); -sub urlencode($); -sub htmlquote($); -sub htmlunquote($); -sub hrefquote($); -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 = '2.0.4'; - -use File::Basename (); - -($mydir) = (File::Basename::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; - } -} - -# == Configuration defaults == -# Defaults for configuration variables that shouldn't need -# to be configured.. -$allow_version_select = 1; -$allow_log_extra = 1; - -##### End of Configuration Area ######## - -######## 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 = $HTML_DOCTYPE = $HTML_META = undef; -$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp"; - -$LOG_FILESEPARATOR = q/^={77}$/; -$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, - }, -); - -@LOGSORTKEYS = qw(cvs date rev); -@LOGSORTKEYS{@LOGSORTKEYS} = ( - { - 'descr' => 'Not sorted', - }, - { - 'descr' => 'Commit date', - }, - { - 'descr' => 'Revision', - }, -); - -$HTML_DOCTYPE = - ''; - -$HTML_META = < - - - -EOM - -##### End of configuration variables ##### - -use Time::Local (); -use IPC::Open2 qw(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; }; -$has_zlib = !$@; - -$verbose = $v; -$checkoutMagic = "~checkout~"; -$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : ''; -$where = $pathinfo; -$doCheckout = ($where =~ m|^/$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$//; -} - -$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} || ''; -$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); - -$nofilelinks = $is_textbased; - -# newer browsers accept gzip content encoding -# and state this in a header -# (netscape did always but didn't state it) -# It has been reported that these -# braindamaged MS-Internet Exploders claim that they -# accept gzip .. but don't in fact and -# 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)); - -# put here the variables we need in order -# to hold our state - they will be added (with -# their current value) to any link/query string -# you construct -@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); -@unsafevars = qw(logsort only_with_tag r1 r2 rev sortby tr1 tr2); - -if (-f $config) { - do "$config" or fatal("500 Internal Error", - 'Error in loading configuration file: %s

%s
', - $config, $@); -} else { - 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 ""); - } else { - $input{$_}++; - } - } -} - -# For backwards compability, set only_with_tag to only_on_branch if set. -$input{only_with_tag} = $input{only_on_branch} - if (defined($input{only_on_branch})); - -# Prevent cross-site scripting -foreach (@unsafevars) { - if (defined($input{$_}) && $input{$_} =~ /[^\w\-.]/) { - fatal("500 Internal Error", - 'Malformed query (%s=%s)', - $_, $input{$_}); - } -} - -if (defined($input{"content-type"})) { - fatal("500 Internal Error", "Unsupported content-type") - if ($input{"content-type"} !~ /^[-0-9A-Za-z]+\/[-0-9A-Za-z]+$/); -} - -$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{$_})); - } 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{$_})); - } -} - -# is there any query ? -if (@barequery) { - $barequery = join ('&', @barequery); - $query = "?$barequery"; - $barequery = "&$barequery"; -} else { - $query = ""; -} -undef @barequery; - -if (defined($input{path})) { - redirect("$scriptname/$input{path}$query"); -} - -# get actual parameters -$sortby = $input{"sortby"}; -$bydate = 0; -$byrev = 0; -$byauthor = 0; -$bylog = 0; -$byfile = 0; -if ($sortby eq "date") { - $bydate = 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'}; - -$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; - } -} - -## Default CVS-Tree -if (!defined($CVSROOT{$cvstreedefault})) { - fatal("500 Internal Error", - '$cvstreedefault points to a repository (%s) not defined in %%CVSROOT (edit your configuration file %s)', - $cvstreedefault, $config); -} - -# alternate CVS-Tree, configured in cvsweb.conf -if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) { - $cvstree = $input{'cvsroot'}; -} else { - $cvstree = $cvstreedefault; -} - -$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; - } -} -undef $k; - -my $config_cvstree = "$config-$cvstree"; - -# Do some special configuration for cvstrees -if (-f $config_cvstree) { - do "$config_cvstree" or - fatal("500 Internal Error", - 'Error in loading configuration file: %s

%s
', - $config_cvstree, $@); -} -undef $config_cvstree; - -$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); -$defaultTextPlain = ($mimetype eq "text/plain"); -$defaultViewable = $allow_markup && viewable($mimetype); - -my $rewrite = 0; - -if ($pathinfo =~ m|//|) { - $pathinfo =~ y|/|/|s; - $rewrite = 1; -} - -if (-d $fullname && $pathinfo !~ m|/$|) { - $pathinfo .= '/'; - $rewrite = 1; -} - -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.'); + &fatal("500 Internal Error",'$CVSROOT not found!'); } -# -# See if the module is in our forbidden list. -# -$where =~ m:([^/]*):; -$module = $1; -if ($module && &forbidden_module($module)) { - fatal("403 Forbidden", - 'Access to %s forbidden.', - $where); -} - -# -# 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,([^/]+)$,); - - if ($basedir eq '' || $module eq '') { - fatal("500 Internal Error", - 'You cannot download the top level directory.'); - } - - my $tmpexportdir = "$tmpdir/.cvsweb.$$." . int(time); - - mkdir($tmpexportdir, 0700) - or fatal("500 Internal Error", - 'Unable to make temporary directory: %s', - $!); - - my @fatal; - - my $tag = - (exists $input{only_with_tag} && length $input{only_with_tag}) ? - $input{only_with_tag} : "HEAD"; - - if ($tag eq 'MAIN') { - $tag = 'HEAD'; - } - - if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', - $tag, '-d', "$tmpexportdir/$basedir", $module) - { - @fatal = ("500 Internal Error", - 'cvs co failure: %s: %s', - $!, $module); +if ($q = $ENV{'QUERY_STRING'}) { + foreach (split(/&/, $q)) { + s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted + if (/(\S+)=(.*)/) { + $input{$1} = $2; } else { - $| = 1; # Essential to get the buffering right. - - if ($ext eq '.tar.gz') { - print "Content-Type: application/x-gzip\r\n\r\n"; - - system - "$CMD{tar} @tar_options -cf - -C $tmpexportdir $basedir | $CMD{gzip} @gzip_options -c" - and @fatal = - ("500 Internal Error", - 'tar zc failure: %s: %s', - $!, $basedir); - } elsif ($ext eq '.zip' && $CMD{zip}) { - print "Content-Type: application/zip\r\n\r\n"; - - system - "cd $tmpexportdir && $CMD{zip} @zip_options -r - $basedir" - and @fatal = - ("500 Internal Error", - 'zip failure: %s: %s', - $!, $basedir); - } else { - @fatal = - ("500 Internal Error", - 'unsupported file type'); - } + $input{$_}++; } - - system $CMD{rm}, '-rf', $tmpexportdir if -d $tmpexportdir; - - &fatal(@fatal) if @fatal; - - exit; + } } - -############################## -# View a directory -############################### if (-d $fullname) { - my $dh = do { local (*DH); }; - opendir($dh, $fullname) or fatal("404 Not Found", - '%s: %s', - $where, $!); - my @dir = readdir($dh); - closedir($dh); - my @subLevelFiles = findLastModifiedSubdirs(@dir) - if ($show_subdir_lastmod); - getDirLogs($cvsroot, $where, @subLevelFiles); - - if ($where eq '/') { - html_header($defaulttitle); - $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g; - print $long_intro; + opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!"); + @dir = readdir(DIR); + closedir(DIR); + if ($where eq '') { + print &html_header("FreeBSD CVS Repository"); + print $intro; } else { - html_header($where); - print $short_instruction; + print &html_header("/$where"); + print $shortinstr; } - - if ($use_descriptions && open(DESC, "<$cvsroot/CVSROOT/descriptions")) - { - while () { - chomp; - my ($dir, $description) = /(\S+)\s+(.*)/; - $descriptions{$dir} = $description; - } - close(DESC); - } - - print "

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

Current directory: ", &clickablePath($where, 0), - "

\n"; - - 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 + print "

Current directory: /$where\n"; + 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) { - print "\n"; - $infocols++; - printf "\n\n"; - - # do not display the other column-headers, if we do not have any files - # with revision information: - if (scalar(%fileinfo)) { - $infocols++; - printf '\n"; - $infocols++; - printf '\n"; - - if ($show_author) { - $infocols++; - printf '\n"; - } - $infocols++; - printf '\n"; - } elsif ($use_descriptions) { - printf '\n"; - $infocols++; - } - print "\n"; - } else { - print "\n"; + print "\n"; + foreach (sort @dir) { + if ($_ eq '.') { + next; + } + if ($_ eq '..') { + next if ($where eq ''); + ($updir = $scriptwhere) =~ s|[^/]+$||; + print " ", + &link("Previous Directory",$updir), "
"; +# print " ", +# &link("Directory-wide diffs", $scriptwhere . '/*'), "
"; + } elsif (-d $fullname . "/" . $_) { + print " ", + &link($_ . "/", $scriptwhere . '/' . $_ . '/'), "
"; + } elsif (s/,v$//) { +# TODO: add date/time? How about sorting? + print " ", + &link($_, $scriptwhere . '/' . $_), "
"; + } } - my $dirrow = 0; - - my $i; - lookingforattic: - for ($i = 0 ; $i <= $#dir ; $i++) { - if ($dir[$i] eq "Attic") { - last lookingforattic; - } + print "
\n"; + print &html_footer; + print "\n"; +} elsif (-f $fullname . ',v') { + if ($input{'rev'} =~ /^[\d\.]+$/) { + &checkout($fullname, $input{'rev'}); + exit; } - - if (!$input{'hideattic'} && ($i <= $#dir) - && opendir($dh, $fullname . "/Attic")) - { - splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), readdir($dh))); - closedir($dh); + if ($input{'r1'} && $input{'r2'}) { + &dodiff($fullname, $input{'r1'}, $input{'tr1'}, + $input{'r2'}, $input{'tr2'}, $input{'f'}); + exit; } - - my $hideAtticToggleLink = - $input{'hideattic'} ? '' : - &link('[Hide]', sprintf('./%s#dirlist', &toggleQuery("hideattic"))); - - # Sort without the Attic/ pathname. - # place directories first - - my $attic; - my $url; - my $fileurl; - my $filesexists; - my $filesfound; - - foreach (sort { &fileSortCmp } @dir) { - if ($_ eq '.') { - next; - } - - # ignore CVS lock and stale NFS files - next if (/^#cvs\.|^,|^\.nfs/); - - # Check whether to show the CVSROOT path - next if ($input{'hidecvsroot'} && ($_ eq 'CVSROOT')); - - # Check whether the module is in the restricted list - next if ($_ && &forbidden_module($_)); - - # Ignore non-readable files - next if ($input{'hidenonreadable'} && !(-r "$fullname/$_")); - - if (s|^Attic/||) { - $attic = " (in the Attic) " . $hideAtticToggleLink; + open(RCS, "rlog '$fullname'|") || &fatal("500 Internal Error", + "Failed to spawn rlog"); + while () { + print if ($verbose); + if ($symnames) { + if (/^\s+([^:]+):\s+([\d\.]+)/) { + $symrev{$1} = $2; + if ($revsym{$2}) { + $revsym{$2} .= ", "; + } + $revsym{$2} .= $1; } else { - $attic = ""; + $symnames = 0; } - - 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\n\n\n\n\n\n\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 "\n\n\n\n\n\n" if ($dirtable); - print(($dirtable) ? "" : "
"); - $dirrow++; - } - print "\n"; + } elsif (/^symbolic names/) { + $symnames = 1; + } elsif (/^-----/) { + last; + } } - print($dirtable ? "
", - $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") - ) - ); - } - 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
", - $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), $allow_dir_extra); - 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); - 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), $allow_dir_extra); - if (length $log > 80) { - print "..."; - } - print ""; - } - print "
\n" : "
\n"); - - if ($filesexists && !$filesfound) { - print - "

NOTE: There are $filesexists files, but none matches the current tag ($input{only_with_tag}).

\n"; + if ($onlyonbranch = $input{'only_on_branch'}) { + ($onlyonbranch = $symrev{$onlyonbranch}) =~ s/\.0\././; + ($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//; } - 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 "
\n"; +# each log entry is of the form: +# ---------------------------- +# revision 3.7.1.1 +# date: 1995/11/29 22:15:52; author: fenner; state: Exp; lines: +5 -3 +# log info +# ---------------------------- + logentry: + while (!/^=========/) { + $_ = ; + print "R:", $_ if ($verbose); + if (/^revision ([\d\.]+)/) { + $rev = $1; + } elsif (/^========/ || /^----------------------------$/) { + next logentry; + } else { + &fatal("500 Internal Error","Error parsing RCS output: $_"); + } + $_ = ; + print "D:", $_ if ($verbose); + if (m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);|) { + $yr = $1; + # damn 2-digit year routines + if ($yr > 100) { + $yr -= 1900; + } + $date{$rev} = &timelocal($6,$5,$4,$3,$2 - 1,$yr); + $author{$rev} = $7; + } else { + &fatal("500 Internal Error", "Error parsing RCS output: $_"); + } + line: + while () { + print "L:", $_ if ($verbose); + next line if (/^branches:\s/); + last line if (/^----------------------------$/ || /^=========/); + $log{$rev} .= $_; + } + print "E:", $_ if ($verbose); } - - if (scalar %tags || $input{only_with_tag}) { - 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"); + close(RCS); + print "Done reading RCS file\n" if ($verbose); +# +# Sort the revisions into commit-date order. + @revorder = sort {$date{$b} <=> $date{$a}} keys %date; + print "Done sorting revisions\n" if ($verbose); +# +# HEAD is an artificial tag which is simply the highest tag number on the main +# branch (I think!). Find it by looking through @revorder; it should at least +# be near the beginning (In fact, it *should* be the first commit listed on +# the main branch.) + revision: + for ($i = 0; $i <= $#revorder; $i++) { + if ($revorder[$i] =~ /^\d+\.\d+$/) { + if ($revsym{$revorder[$i]}) { + $revsym{$revorder[$i]} .= ", "; } - print "

\n"; - print "\n"; - print " \n"; - printf "\n", - htmlquote($where); - print "

\n"; - print "
\n"; + $revsym{$revorder[$i]} .= "HEAD"; + $symrev{"HEAD"} = $revorder[$i]; + last revision; + } } + print "Done finding HEAD\n" if ($verbose); +# +# Now that we know all of the revision numbers, we can associate +# absolute revision numbers with all of the symbolic names, and +# pass them to the form so that the same association doesn't have +# to be built then. +# +# should make this a case-insensitive sort + foreach (sort keys %symrev) { + $rev = $symrev{$_}; + if ($rev =~ /^(\d+(\.\d+)+)\.0\.(\d+)$/) { + push(@branchnames, $_); + # + # A revision number of A.B.0.D really translates into + # "the highest current revision on branch A.B.D". + # + # If there is no branch A.B.D, then it translates into + # the head A.B . + # + # This is pure speculation. + # + $head = $1; + $branch = $3; + $regex = $head . "." . $branch; + $regex =~ s/\./\./g; + # < + # \____/ + $rev = $head; - if ($allow_tar) { - 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"); - } - print "
\n"; + revision: + foreach $r (@revorder) { + if ($r =~ /^${regex}/) { + $rev = $head . "." . $branch; + last revision; + } } + $revsym{$rev} .= ", " if ($revsym{$rev}); + $revsym{$rev} .= $_; + } + $sel .= "