=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.4 retrieving revision 3.2 diff -u -p -r1.1.1.4 -r3.2 --- cvsweb/cvsweb.cgi 2000/09/03 18:41:30 1.1.1.4 +++ cvsweb/cvsweb.cgi 2000/07/20 11:52:05 3.2 @@ -1,18 +1,18 @@ -#!/usr/bin/perl5 -ws +#!/usr/bin/perl -ws # # cvsweb - a CGI interface to CVS trees. # -# Written in their spare time by +# Written in their spare time by # Bill Fenner (original work) # extended by Henner Zeller , -# Henrik Nordstrom +# Henrik Nordstrom # Ken Coar # Dick Balaska # Akinori MUSHA # # Based on: # * Bill Fenners cvsweb.cgi revision 1.28 available from: -# http://www.FreeBSD.org/cgi/cvsweb.cgi/www/en/cgi/cvsweb.cgi +# http://www.freebsd.org/cgi/cvsweb.cgi/www/en/cgi/cvsweb.cgi # # Copyright (c) 1996-1998 Bill Fenner # (c) 1998-1999 Henner Zeller @@ -41,8 +41,7 @@ # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # -# $zId: cvsweb.cgi,v 1.94 2000/08/24 06:41:22 hnordstrom Exp $ -# $kId: cvsweb.cgi,v 1.17 2000/09/03 18:25:47 knu Exp $ +# $Id: cvsweb.cgi,v 3.2 2000/07/20 11:52:05 knu Exp $ # ### @@ -53,12 +52,11 @@ use vars qw ( %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted %symrev %revsym @allrevisions %date %author @revdisplayorder - @revisions %state %difflines %log %branchpoint @revorder - $prcgi @prcategories $prcategories $mancgi + @revisions %state %difflines %log %branchpoint @revorder $prcgi + @prcategories $prcategories $checkoutMagic $doCheckout $scriptname $scriptwhere - $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars - %funcline_regexp $is_mod_perl - $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased + $where $Browser $nofilelinks $maycompress @stickyvars + %functionlineregexp %input $query $barequery $sortby $bydate $byrev $byauthor $bylog $byfile $hr_default $logsort $cvstree $cvsroot $mimetype $defaultTextPlain $defaultViewable $allow_compress @@ -66,7 +64,7 @@ use vars qw ( $cvstreedefault $body_tag $logo $defaulttitle $address $backcolor $long_intro $short_instruction $shortLogLen $show_author $dirtable $tablepadding $columnHeaderColorDefault - $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite + $columnHeaderColorSorted $hr_breakable $hr_funout $hr_ignwhite $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove $diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface $difffontsize $inputTextSize $mime_types $allow_annotate @@ -79,58 +77,11 @@ use vars qw ( $use_moddate ); -sub printDiffSelect($); -sub findLastModifiedSubdirs(@); -sub htmlify($;$); -sub spacedHtmlText($); -sub link($$); -sub revcmp($$); -sub fatal($$); -sub redirect($); -sub safeglob($); -sub getMimeTypeFromSuffix($); -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 http_header(;$); -sub html_header($); -sub html_footer(); -sub link_tags($); -sub forbidden_module($); - ##### Start of Configuration Area ######## -use Cwd; - -# == EDIT this == +# == EDIT this == # User configuration is stored in -$config = undef; +$config = $ENV{'CVSWEB_CONFIG'} || '/usr/local/etc/cvsweb.conf'; -for ($ENV{CVSWEB_CONFIG}, -# '/home/knu/etc/cvsweb.conf', - '/usr/local/etc/cvsweb.conf', - getcwd . '/cvsweb.conf') { - $config = $_ if defined($_) && -r $_; -} - # == Configuration defaults == # Defaults for configuration variables that shouldn't need # to be configured.. @@ -145,14 +96,14 @@ $allow_version_select = 1; $cvstreedefault = $body_tag = $logo = $defaulttitle = $address = $backcolor = $long_intro = $short_instruction = $shortLogLen = $show_author = $dirtable = $tablepadding = $columnHeaderColorDefault = -$columnHeaderColorSorted = $hr_breakable = $showfunc = $hr_ignwhite = +$columnHeaderColorSorted = $hr_breakable = $hr_funout = $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 = $checkout_magic = $show_subdir_lastmod = $show_log_in_markup = $v = -$navigationHeaderColor = $tableBorderColor = $markupLogColor = +$navigationHeaderColor = $tableBorderColor = $markupLogColor = $tabstop = $use_moddate = $moddate = undef; ##### End of configuration variables ##### @@ -162,34 +113,26 @@ use IPC::Open2; $verbose = $v; $checkoutMagic = "~checkout~"; -$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : ''; -$where = $pathinfo; +$where = defined($ENV{'PATH_INFO'}) ? $ENV{'PATH_INFO'} : ""; $doCheckout = ($where =~ /^\/$checkoutMagic/); $where =~ s|^/($checkoutMagic)?||; $where =~ s|/+$||; -$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : ''; -$scriptname =~ s|^/?|/|; +($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|; $scriptname =~ s|/+$||; -$scriptwhere = $scriptname; if ($where) { - $scriptwhere .= '/' . urlencode($where); + $scriptwhere = $scriptname . '/' . urlencode($where); } +else { + $scriptwhere = $scriptname; +} +$scriptwhere =~ s|/+$||; -$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_lynx = ($Browser =~ m`^Lynx/`i); -$is_w3m = ($Browser =~ m`^w3m/`i); -$is_msie = ($Browser =~ m`MSIE`); -$is_mozilla3 = ($Browser =~ m`^Mozilla/[3-9]`); +$Browser = $ENV{'HTTP_USER_AGENT'}; +$nofilelinks = ($Browser =~ m'^Lynx/'); -$is_textbased = ($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) @@ -200,19 +143,19 @@ $nofilelinks = $is_textbased; # Turn off gzip if running under mod_perl. piping does # not work as expected inside the server. One can probably # achieve the same result using Apache::GZIPFilter. -$maycompress = (($ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip` - || $is_mozilla3) - && !$is_msie - && !$is_mod_perl); +$maycompress =(($ENV{'HTTP_ACCEPT_ENCODING'} =~ m|gzip| + || $Browser =~ m%^Mozilla/3%) + && ($Browser !~ m/MSIE/) + && !defined($ENV{'MOD_PERL'})); # 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 +# their current value) to any link/query string # you construct -@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); +@stickyvars = ('cvsroot','hideattic','sortby','logsort','f','only_with_tag'); if (-f $config) { - do $config; + do "$config"; } else { &fatal("500 Internal Error", @@ -223,9 +166,7 @@ else { } undef %input; -$query = $ENV{QUERY_STRING}; - -if (defined($query) && $query ne '') { +if ($query = $ENV{'QUERY_STRING'}) { foreach (split(/&/, $query)) { s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted if (/(\S+)=(.*)/) { @@ -237,7 +178,7 @@ if (defined($query) && $query ne '') { } } -# For backwards compability, set only_with_tag to only_on_branch if set. +# 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})); @@ -264,13 +205,12 @@ foreach (keys %DEFAULTVALUE) } } } - + $barequery = ""; foreach (@stickyvars) { # construct a query string with the sticky non default parameters set - if (defined($input{$_}) && $input{$_} ne '' && - !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) { - if ($barequery) { + if (defined($input{$_}) && $input{$_} ne "" && $input{$_} ne $DEFAULTVALUE{$_}) { + if ($barequery) { $barequery = $barequery . "&"; } my $thisval = urlencode($_) . "=" . urlencode($input{$_}); @@ -311,7 +251,7 @@ else { $hr_default = $input{'f'} eq 'h'; -$logsort = $input{'logsort'}; +$logsort = $input{"logsort"}; ## Default CVS-Tree @@ -336,10 +276,10 @@ foreach my $k (keys %ICONS) { no strict 'refs'; my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}}; if ($ipath) { - ${"${k}icon"} = "\"$itxt\""; + $ {"${k}icon"} = "\"$itxt\""; } else { - ${"${k}icon"} = $itxt; + $ {"${k}icon"} = $itxt; } } @@ -347,7 +287,6 @@ foreach my $k (keys %ICONS) { do "$config-$cvstree" if (-f "$config-$cvstree"); $prcategories = '(?:' . join('|', @prcategories) . ')'; -$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/; $fullname = $cvsroot . '/' . $where; $mimetype = &getMimeTypeFromSuffix ($fullname); @@ -357,7 +296,7 @@ $defaultViewable = $allow_markup && viewable($mimetype # 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 .. +# output through the nonexistent gzip .. # any more elegant ways to prevent this are welcome! if ($allow_compress && $maycompress) { foreach (split(/:/, $ENV{PATH})) { @@ -373,6 +312,7 @@ if (-d $fullname) { # ensure, that directories always end with (exactly) one '/' # to allow relative URL's. If they're not, make a redirect. ## + my $pathinfo = defined($ENV{'PATH_INFO'}) ? $ENV{'PATH_INFO'} : ""; if (!($pathinfo =~ m|/$|) || ($pathinfo =~ m |/{2,}$|)) { redirect ($scriptwhere . '/' . $query); } @@ -407,12 +347,12 @@ elsif (-d $fullname) { getDirLogs($cvsroot,$where,@subLevelFiles); if ($where eq '/') { - html_header($defaulttitle); + html_header("$defaulttitle"); $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g; print $long_intro; } else { - html_header($where); + html_header("$where"); print $short_instruction; } @@ -438,13 +378,13 @@ elsif (-d $fullname) { $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)) { @@ -453,8 +393,8 @@ elsif (-d $fullname) { } print "\n"; $infocols++; - print ""; $infocols++; - print ""; if ($show_author) { $infocols++; - print ""; } $infocols++; - print "
"; print "" if (!$byfile); @@ -465,8 +405,8 @@ elsif (-d $fullname) { # with revision information: if (scalar(%fileinfo)) { $infocols++; - print ""; print "" if (!$byrev); @@ -474,8 +414,8 @@ elsif (-d $fullname) { print "" if (!$byrev); print ""; print "" if (!$bydate); @@ -484,8 +424,8 @@ elsif (-d $fullname) { print ""; print "" if (!$byauthor); @@ -494,8 +434,8 @@ elsif (-d $fullname) { print ""; print "" if (!$bylog); print "Last log entry"; @@ -513,7 +453,7 @@ elsif (-d $fullname) { print "\n"; } my $dirrow = 0; - + my $i; lookingforattic: for ($i = 0; $i <= $#dir; $i++) { @@ -528,7 +468,7 @@ elsif (-d $fullname) { closedir($dh); } - my $hideAtticToggleLink = "[Hide]" if (!$input{'hideattic'}); @@ -590,11 +530,11 @@ elsif (-d $fullname) { } print " ", &link($_ . "/", $url), $attic; if ($_ eq "Attic") { - print "  [Don't hide]"; } - } + } # Show last change in dir if ($filename) { print "  " if ($dirtable); @@ -663,7 +603,7 @@ elsif (-d $fullname) { print " ", &link($_, $url), $attic; print " " if ($dirtable); download_link($fileurl, - $rev, $rev, + $rev, $rev, $defaultViewable ? "text/x-cvsweb-markup" : undef); print " " if ($dirtable); if ($date) { @@ -691,15 +631,15 @@ elsif (-d $fullname) { print "
"; } print "". ($dirtable == 1) ? "" : "" . "\n"; - + if ($filesexists && !$filesfound) { 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 (scalar %tags - || $input{only_with_tag} + if (scalar %tags + || $input{only_with_tag} || $edit_option_form || defined($input{"options"})) { print "

"; @@ -720,8 +660,8 @@ elsif (-d $fullname) { print ">"; print "