=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.15 retrieving revision 1.1.1.18 diff -u -p -r1.1.1.15 -r1.1.1.18 --- cvsweb/cvsweb.cgi 2000/12/18 04:35:54 1.1.1.15 +++ cvsweb/cvsweb.cgi 2001/01/01 23:55:44 1.1.1.18 @@ -43,7 +43,7 @@ # SUCH DAMAGE. # # $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $ -# $kId: cvsweb.cgi,v 1.45 2000/12/18 04:25:30 knu Exp $ +# $kId: cvsweb.cgi,v 1.54 2001/01/01 23:15:02 knu Exp $ # ### @@ -56,7 +56,7 @@ use vars qw ( %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted %symrev %revsym @allrevisions %date %author @revdisplayorder @revisions %state %difflines %log %branchpoint @revorder - $prcgi @prcategories $prcategories $mancgi + $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi $checkoutMagic $doCheckout $scriptname $scriptwhere $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars %funcline_regexp $is_mod_perl @@ -75,11 +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 $v + $show_subdir_lastmod $show_log_in_markup $preformat_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 + $use_moddate $has_zlib $gzip_open $allow_tar @tar_options @cvs_options $LOG_FILESEPARATOR $LOG_REVSEPARATOR ); @@ -122,6 +122,7 @@ sub toggleQuery($$); sub urlencode($); sub htmlquote($); sub htmlunquote($); +sub hrefquote($); sub http_header(;$); sub html_header($); sub html_footer(); @@ -228,9 +229,10 @@ $verbose = $v; $checkoutMagic = "~checkout~"; $pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : ''; $where = $pathinfo; +$where =~ tr|/|/|s; $doCheckout = ($where =~ /^\/$checkoutMagic/); $where =~ s|^/($checkoutMagic)?||; -$where =~ s|/+$||; +$where =~ s|/$||; $scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : ''; $scriptname =~ s|^/?|/|; $scriptname =~ s|/+$||; @@ -277,7 +279,7 @@ $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING}) @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); if (-f $config) { - do $config + require $config || &fatal("500 Internal Error", sprintf('Error in loading configuration file: %s

%s
', $config, &htmlify($@))); @@ -294,6 +296,7 @@ $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 ""); @@ -404,7 +407,7 @@ foreach $k (keys %ICONS) { my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}}; if ($ipath) { ${"${k}icon"} = sprintf('%s', - htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight) + hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight) } else { ${"${k}icon"} = $itxt; @@ -416,17 +419,18 @@ my $config_cvstree = "$config-$cvstree"; # Do some special configuration for cvstrees if (-f $config_cvstree) { - do $config_cvstree + require $config_cvstree || &fatal("500 Internal Error", sprintf('Error in loading configuration file: %s

%s
', $config_cvstree, &htmlify($@))); } undef $config_cvstree; -$prcategories = '(?:' . join('|', @prcategories) . ')'; +$re_prcategories = '(?:' . join('|', @prcategories) . ')' if @prcategories; +$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword); $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); @@ -471,10 +475,68 @@ $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; + $where =~ s,/[^/]*$,,; + $where =~ s,^/,,; + my($basedir) = ($where =~ m,([^/]+)$,); + + if ($basedir eq '' || $where 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 = ''; + + do { + chdir $tmpdir + or $fatal = "500 Internal Error", "Unable to cd to temporary directory: $!" + && last; + + my $tag = (exists $input{only_with_tag} && length $input{only_with_tag}) + ? $input{only_with_tag} : "HEAD"; + + system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, $where + and $fatal = "500 Internal Error","cvs co failure: $!: $where" + && last; + + chdir "$where/.." + or $fatal = "500 Internal Error","Cannot find expected directory in checkout" + && last; + + $| = 1; # Essential to get the buffering right. + + print "Content-type: application/x-gzip\r\n\r\n"; + + system "tar", "-zcf", "-", $basedir, @tar_options + and $fatal = "500 Internal Error","tar zc failure: $!: $basedir" + && last; + + chdir $tmpdir + or $fatal = "500 Internal Error","Unable to cd to temporary directory: $!" + && last; + } while (0); + + system "rm", "-rf", $tmpdir if -d $tmpdir; + + &fatal($fatal) if $fatal; + + exit; +} + ############################## # View a directory ############################### -elsif (-d $fullname) { +if (-d $fullname) { my $dh = do {local(*DH);}; opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!"); my @dir = readdir($dh); @@ -812,6 +874,22 @@ elsif (-d $fullname) { print "\n"; print "\n"; } + + if ($allow_tar) { + my($basefile) = ($where =~ m,(?:.*/)?([^/]+),); + + if ($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'}); @@ -1036,7 +1114,7 @@ sub htmlify($;$) { if ($extra) { # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn" - if (defined($prcgi)) { + if (defined($prcgi) && defined($re_prcategories) && defined($re_prkeyword)) { my $prev; do { @@ -1044,7 +1122,7 @@ sub htmlify($;$) { $_ = htmlify_sub { s{ - (\bPR[:\#]?\s* + (\b$re_prkeyword[:\#]?\s* (?: \#? \d+[,\s]\s* @@ -1059,7 +1137,7 @@ sub htmlify($;$) { $_ = htmlify_sub { s{ - (\b$prcategories/(\d+)\b) + (\b$re_prcategories/(\d+)\b) }{ &link($1, sprintf($prcgi, $2)) }egox; @@ -1070,7 +1148,7 @@ sub htmlify($;$) { if (defined($mancgi)) { $_ = htmlify_sub { s{ - (\b([a-zA-Z][\w_.]+) + (\b([a-zA-Z][\w.]+) (?: \( ([0-9n]) \)\B | @@ -1078,7 +1156,7 @@ sub htmlify($;$) { ) ) }{ - &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2)) + &link($1, sprintf($mancgi, defined($3) ? $3 : $4, $2)) }egx; } $_; } @@ -1120,7 +1198,7 @@ sub spacedHtmlText($;$) { sub link($$) { my($name, $where) = @_; - sprintf '%s', htmlquote($where), $name; + sprintf '%s', hrefquote($where), $name; } sub revcmp($$) { @@ -1294,7 +1372,7 @@ 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, "cvs -Rl server") || fatal ("500 Internal Error", + $pid = open2($reader, $writer, "cvs @cvs_options -l 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: @@ -1487,7 +1565,7 @@ sub doCheckout($$) { # Safely for a child process to read from. if (! open($fh, "-|")) { # child open(STDERR, ">&STDOUT"); # Redirect stderr to stdout - exec("cvs", "-Rld", $cvsroot, "co", "-p", $revopt, $where); + exec("cvs", @cvs_options, "-d", $cvsroot, "co", "-p", $revopt, $where); } if (eof($fh)) { @@ -1564,12 +1642,12 @@ sub cvswebMarkup($$$) { my $url = download_url($fileurl, $revision, $mimetype); print "
"; if ($mimetype =~ /^image/) { - printf '
', htmlquote("$url$barequery"); + printf '
', hrefquote("$url$barequery"); } elsif ($mimetype =~ m%^application/pdf%) { - printf '
', htmlquote("$url$barequery"); + printf '
', hrefquote("$url$barequery"); } - else { + elsif ($preformat_in_markup) { print "
";
 
 	# prefetch several lines
@@ -1584,6 +1662,9 @@ sub cvswebMarkup($$$) {
 	}
 	print "
"; } + else { + print "\n", <$filehandle>; + } } sub viewable($) { @@ -1745,7 +1826,7 @@ sub getDirLogs($$@) { return; } - if ($tag) { + if (defined($tag)) { #can't use -r<tag> as - is allowed in tagnames, but misinterpreated by rlog.. if (! open($fh, "-|")) { open(STDERR, '>/dev/null'); # rlog may complain; ignore. @@ -1763,14 +1844,13 @@ sub getDirLogs($$@) { while (<$fh>) { if ($state eq "start") { #Next file. Initialize file variables - $rev = undef; - $revwanted = undef; - $branch = undef; - $branchpoint = undef; - $filename = undef; - $log = undef; - $revision = undef; - $branch = undef; + $rev = ''; + $revwanted = ''; + $branch = ''; + $branchpoint = ''; + $filename = ''; + $log = ''; + $revision = ''; %symrev = (); @filetags = (); #jump to head state @@ -1789,7 +1869,7 @@ again: $branch = $1 } elsif (/^symbolic names:/) { $state = "tags"; - ($branch = $head) =~ s/\.\d+$// if (!defined($branch)); + ($branch = $head) =~ s/\.\d+$// if $branch eq ''; $branch =~ s/(\d+)$/0.$1/; $symrev{MAIN} = $branch; $symrev{HEAD} = $branch; @@ -1798,9 +1878,9 @@ again: push (@filetags, "MAIN", "HEAD"); } elsif (/$LOG_REVSEPARATOR/o) { $state = "log"; - $rev = undef; - $date = undef; - $log = ""; + $rev = ''; + $date = ''; + $log = ''; # Try to reconstruct the relative filename if RCS spits out a full path $filename =~ s%^\Q$DirName\E/%%; } @@ -1818,7 +1898,7 @@ again: $revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag}; ($branch = $revwanted) =~ s/\b0\.//; ($branchpoint = $branch) =~ s/\.?\d+$//; - $revwanted = undef if ($revwanted ne $branch); + $revwanted = '' if ($revwanted ne $branch); } elsif ($tag ne "HEAD") { print "Tag not found, skip this file" if ($verbose); $state = "skip"; @@ -1835,19 +1915,19 @@ again: if ($state eq "log") { if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) { # End of a log entry. - my $revbranch; - ($revbranch = $rev) =~ s/\.\d+$//; + my $revbranch = $rev; + $revbranch =~ s/\.\d+$//; print "$filename $rev Wanted: $revwanted ", "Revbranch: $revbranch Branch: $branch ", "Branchpoint: $branchpoint\n" if ($verbose); - if (!defined($revwanted) && defined($branch) + if ($revwanted eq '' && $branch ne '' && $branch eq $revbranch || !defined($tag)) { print "File revision $rev found for branch $branch\n" if ($verbose); $revwanted = $rev; } - if (defined($revwanted) ? $rev eq $revwanted : - defined($branchpoint) ? $rev eq $branchpoint : + if ($revwanted ne '' ? $rev eq $revwanted : + $branchpoint ne '' ? $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); @@ -1856,11 +1936,11 @@ again: $fileinfo{$name} = [ @finfo ]; $state = "done" if ($rev eq $revwanted); } - $rev = undef; - $date = undef; - $log = ""; + $rev = ''; + $date = ''; + $log = ''; } - elsif (!defined($date) && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) { + elsif ($date eq '' && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) { my $yr = $1; # damn 2-digit year routines :-) if ($yr > 100) { @@ -1872,7 +1952,7 @@ again: $log = ''; next; } - elsif (!defined($rev) && m/^revision (.*)$/) { + elsif ($rev eq '' && /^revision (.*)$/) { $rev = $1; next; } @@ -2280,18 +2360,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 (join(".",@tmp1[0..$#tmp1-1]) - eq join(".",@tmp2[0..$#tmp1-1])); + last if (@tmp1 - 1 <= @tmp2 && + join(".",@tmp1[0..$#tmp1-1]) eq join(".",@tmp2[0..$#tmp1-1])); } if (!defined($diffrev{$nextmain})) { $diffrev{$nextmain} = 1; @@ -2641,7 +2721,7 @@ sub navigateHeader($$$$$) { print qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`; print "<HTML>\n<HEAD>\n"; print qq`<META name="robots" content="nofollow">\n`; - print '<!-- CVSweb $zRevision: 1.104 $ $kRevision: 1.45 $ -->'; + print '<!-- CVSweb $zRevision: 1.104 $ $kRevision: 1.54 $ -->'; print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n"; print "$body_tag_for_src\n"; print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">"; @@ -2864,7 +2944,7 @@ sub download_link($$$;$) { my ($url, $revision, $textlink, $mimetype) = @_; my ($fullurl) = download_url($url, $revision, $mimetype); - printf '<A HREF="%s"', htmlquote("$fullurl$barequery"); + printf '<A HREF="%s"', hrefquote("$fullurl$barequery"); if ($open_extern_window && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) { print ' target="cvs_checkout"'; @@ -2898,7 +2978,7 @@ sub download_link($$$;$) { if (defined($extern_window_height)); printf q` onClick="window.open('%s','cvs_checkout','%s');"`, - htmlquote($fullurl), join(',', @attr); + hrefquote($fullurl), join(',', @attr); } } print "><b>$textlink</b></A>"; @@ -2938,8 +3018,7 @@ sub urlencode($) { s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge; - - $_; + $_; } sub htmlquote($) { @@ -2966,8 +3045,20 @@ 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"); @@ -3024,8 +3115,8 @@ sub http_header(;$) { sub html_header($) { my ($title) = @_; - my $version = '$zRevision: 1.104 $ $kRevision: 1.45 $'; #' - http_header(defined($charset) ? "text/html; charset=$charset" : "text/html"); + my $version = '$zRevision: 1.104 $ $kRevision: 1.54 $'; #' + http_header("text/html"); print <<EOH; <!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">