Date: Fri, 23 May 2003 12:05:42 -0500 From: "Jesus Gonzalez Rubio" <jgonzalezr@ultrasist.com.mx> To: <freebsd-questions@FreeBSD.ORG> Subject: cvsweb Message-ID: <000201c3214d$8b9c98c0$42a09384@satellite>
next in thread | raw e-mail | index | archive | help
This is a multi-part message in MIME format. ------=_NextPart_000_0003_01C32123.A2DEFAC0 Content-Type: text/plain; charset="iso-8859-1" Content-Transfer-Encoding: 7bit To whom it may concern: I received the next message tying to acces my repository files. I can see any directories in my repository structure but as there exist any file the program displays this error. How can i see the files in my repositry fiile or what am i doing wrong because i can see the directories. I send you my cvsweb configuration & cgi files. Error Error: Failed to spawn GNU rlog on '/cvs/repositorio/Matra.SCABD/actividades//PlanInicial.doc,v' did you set the $ENV{PATH} in your configuration file correctly ? Ultrasist, S.A. Tel. 5598 4660 5598 1633 --- Outgoing mail is certified Virus Free. Checked by AVG anti-virus system (http://www.grisoft.com). Version: 6.0.478 / Virus Database: 275 - Release Date: 06/05/2003 ------=_NextPart_000_0003_01C32123.A2DEFAC0 Content-Type: application/octet-stream; name="cvsweb.cgi" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="cvsweb.cgi" #!/usr/bin/perl -wsT=0A= #=0A= # cvsweb - a CGI interface to CVS trees.=0A= #=0A= # Written in their spare time by=0A= # Bill Fenner <fenner@FreeBSD.org> (original work)=0A= # extended by Henner Zeller <zeller@think.de>,=0A= # Henrik Nordstr=F6m <hno@hem.passagen.se> =0A= # Ken Coar <coar@Apache.Org>=0A= # Dick Balaska <dick@buckosoft.com>=0A= # Jens-Uwe Mager <jum@helios.de>=0A= #=0A= # Based on:=0A= # * Bill Fenners cvsweb.cgi revision 1.28 available from:=0A= # http://www.FreeBSD.org/cgi/cvsweb.cgi/www/en/cgi/cvsweb.cgi=0A= #=0A= # Copyright (c) 1996-1998 Bill Fenner=0A= # (c) 1998-1999 Henner Zeller=0A= # (c) 1999 Henrik Nordstr=F6m=0A= # All rights reserved.=0A= #=0A= # Redistribution and use in source and binary forms, with or without=0A= # modification, are permitted provided that the following conditions=0A= # are met:=0A= # 1. Redistributions of source code must retain the above copyright=0A= # notice, this list of conditions and the following disclaimer.=0A= # 2. Redistributions in binary form must reproduce the above copyright=0A= # notice, this list of conditions and the following disclaimer in the=0A= # documentation and/or other materials provided with the distribution.=0A= #=0A= # THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND=0A= # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE=0A= # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR = PURPOSE=0A= # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE=0A= # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR = CONSEQUENTIAL=0A= # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS=0A= # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)=0A= # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, = STRICT=0A= # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY = WAY=0A= # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF=0A= # SUCH DAMAGE.=0A= #=0A= # $Id: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $=0A= #=0A= ###=0A= require 5.000;=0A= =0A= use strict;=0A= =0A= use vars qw (=0A= $config $allow_version_select $verbose=0A= %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES=0A= %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted=0A= %symrev %revsym @allrevisions %date %author @revdisplayorder=0A= @revisions %state %difflines %log %branchpoint @revorder=0A= $checkoutMagic $doCheckout $scriptname $scriptwhere=0A= $where $Browser $nofilelinks $maycompress @stickyvars=0A= %input $query $barequery $sortby $bydate $byrev $byauthor=0A= $bylog $byfile $hr_default $logsort $cvstree $cvsroot=0A= $mimetype $defaultTextPlain $defaultViewable $allow_compress=0A= $GZIPBIN $backicon $diricon $fileicon $fullname $newname=0A= $cvstreedefault $body_tag $logo $defaulttitle $address=0A= $backcolor $long_intro $short_instruction $shortLogLen=0A= $show_author $dirtable $tablepadding $columnHeaderColorDefault=0A= $columnHeaderColorSorted $hr_breakable $hr_funout $hr_ignwhite=0A= $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove=0A= $diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface=0A= $difffontsize $inputTextSize $mime_types $allow_annotate=0A= $allow_markup $use_java_script $open_extern_window=0A= $extern_window_width $extern_window_height $edit_option_form=0A= $checkout_magic $show_subdir_lastmod $show_log_in_markup $v=0A= $navigationHeaderColor $tableBorderColor $markupLogColor=0A= $tabstop $state $annTable $sel $curbranch @HideModules @DissallowRead=0A= $module $use_descriptions %descriptions @mytz $dwhere $moddate=0A= $use_moddate $has_zlib $gzip_open=0A= );=0A= =0A= ##### prototype declarations ########=0A= sub printDiffSelect($);=0A= sub findLastModifiedSubdirs(@);=0A= sub htmlify($);=0A= sub spacedHtmlText($);=0A= sub link($$);=0A= sub revcmp($$);=0A= sub fatal($$);=0A= sub redirect($);=0A= sub safeglob($);=0A= sub getMimeTypeFromSuffix($);=0A= sub doAnnotate ($$);=0A= sub doCheckout($$);=0A= sub cvswebMarkup($$$);=0A= sub viewable($);=0A= sub doDiff($$$$$$);=0A= sub getDirLogs($$@);=0A= sub readLog($;$);=0A= sub printLog($;$);=0A= sub doLog($);=0A= sub flush_diff_rows ($$$$);=0A= sub human_readable_diff($);=0A= sub navigateHeader ($$$$$);=0A= sub plural_write ($$);=0A= sub readableTime ($$);=0A= sub clickablePath($$);=0A= sub chooseCVSRoot();=0A= sub chooseMirror();=0A= sub fileSortCmp();=0A= sub download_url($$$);=0A= sub download_link($$$$);=0A= sub toggleQuery($$);=0A= sub urlencode($);=0A= sub http_header(;$);=0A= sub html_header($);=0A= sub html_footer();=0A= sub link_tags($);=0A= sub forbidden_module($);=0A= sub forbidden_file($);=0A= sub checkForbidden($@);=0A= sub gzipclose();=0A= sub MAGIC1();=0A= sub MAGIC2();=0A= sub OSCODE();=0A= =0A= ##### Start of Configuration Area ########=0A= # =3D=3D EDIT this =3D=3D =0A= # User configuration is stored in=0A= $config =3D $ENV{'CVSWEB_CONFIG'} || '/opt/apachessl/conf/cvsweb.conf';=0A= =0A= # =3D=3D Configuration defaults =3D=3D=0A= # Defaults for configuration variables that shouldn't need=0A= # to be configured..=0A= $allow_version_select =3D 1;=0A= =0A= ##### End of Configuration Area ########=0A= =0A= ######## Configuration variables #########=0A= # These are defined to allow checking with perl -cw=0A= %CVSROOT =3D %MIRRORS =3D %DEFAULTVALUE =3D %ICONS =3D %MTYPES =3D=0A= %tags =3D %alltags =3D @tabcolors =3D %fileinfo =3D ();=0A= $cvstreedefault =3D $body_tag =3D $logo =3D $defaulttitle =3D $address =3D=0A= $backcolor =3D $long_intro =3D $short_instruction =3D $shortLogLen =3D=0A= $show_author =3D $dirtable =3D $tablepadding =3D = $columnHeaderColorDefault =3D=0A= $columnHeaderColorSorted =3D $hr_breakable =3D $hr_funout =3D = $hr_ignwhite =3D=0A= $hr_ignkeysubst =3D $diffcolorHeading =3D $diffcolorEmpty =3D = $diffcolorRemove =3D=0A= $diffcolorChange =3D $diffcolorAdd =3D $diffcolorDarkChange =3D = $difffontface =3D=0A= $difffontsize =3D $inputTextSize =3D $mime_types =3D $allow_annotate =3D=0A= $allow_markup =3D $use_java_script =3D $open_extern_window =3D=0A= $extern_window_width =3D $extern_window_height =3D $edit_option_form =3D=0A= $checkout_magic =3D $show_subdir_lastmod =3D $show_log_in_markup =3D $v =3D=0A= $navigationHeaderColor =3D $tableBorderColor =3D $markupLogColor =3D =0A= $tabstop =3D $use_moddate =3D $moddate =3D $gzip_open =3D undef;=0A= =0A= ##### End of configuration variables #####=0A= =0A= use Time::Local;=0A= use IPC::Open2;=0A= =0A= # Check if the zlib C library interface is installed, and if yes=0A= # we can avoid using the extra gzip process.=0A= eval {=0A= require Compress::Zlib;=0A= };=0A= $has_zlib =3D !$@;=0A= =0A= $verbose =3D $v;=0A= $checkoutMagic =3D "~checkout~";=0A= $where =3D defined($ENV{'PATH_INFO'}) ? $ENV{'PATH_INFO'} : "";=0A= $doCheckout =3D ($where =3D~ /^\/$checkoutMagic/);=0A= $where =3D~ s|^/($checkoutMagic)?||;=0A= $where =3D~ s|/+$||;=0A= ($scriptname =3D $ENV{'SCRIPT_NAME'}) =3D~ s|^/?|/|;=0A= $scriptname =3D~ s|/+$||;=0A= if ($where) {=0A= $scriptwhere =3D $scriptname . '/' . urlencode($where);=0A= }=0A= else {=0A= $scriptwhere =3D $scriptname;=0A= }=0A= $scriptwhere =3D~ s|/+$||;=0A= =0A= # in lynx, it it very annoying to have two links=0A= # per file, so disable the link at the icon=0A= # in this case:=0A= $Browser =3D $ENV{'HTTP_USER_AGENT'};=0A= $nofilelinks =3D ($Browser =3D~ m'^Lynx/');=0A= =0A= # newer browsers accept gzip content encoding=0A= # and state this in a header=0A= # (netscape did always but didn't state it)=0A= # It has been reported that these=0A= # braindamaged MS-Internet Exploders claim that they=0A= # accept gzip .. but don't in fact and=0A= # display garbage then :-/=0A= # Turn off gzip if running under mod_perl and no zlib is available,=0A= # piping does not work as expected inside the server.=0A= $maycompress =3D (((defined($ENV{'HTTP_ACCEPT_ENCODING'})=0A= && $ENV{'HTTP_ACCEPT_ENCODING'} =3D~ m|gzip|)=0A= || $Browser =3D~ m%^Mozilla/3%)=0A= && ($Browser !~ m/MSIE/)=0A= && !(defined($ENV{'MOD_PERL'}) && !$has_zlib));=0A= =0A= # put here the variables we need in order=0A= # to hold our state - they will be added (with=0A= # their current value) to any link/query string=0A= # you construct=0A= @stickyvars =3D qw(cvsroot hideattic sortby logsort f only_with_tag);=0A= =0A= if (-f $config) {=0A= do "$config";=0A= }=0A= else {=0A= &fatal("500 Internal Error",=0A= 'Configuration not found. Set the variable <code>$config</code> '=0A= . 'in cvsweb.cgi, or the environment variable '=0A= . '<code>CVSWEB_CONFIG</code>, to your <b>cvsweb.conf</b> '=0A= . 'configuration file first.');=0A= }=0A= =0A= undef %input;=0A= if ($query =3D $ENV{'QUERY_STRING'}) {=0A= foreach (split(/&/, $query)) {=0A= y/+/ /;=0A= s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted=0A= if (/(\S+)=3D(.*)/) {=0A= $input{$1} =3D $2 if ($2 ne "");=0A= }=0A= else {=0A= $input{$_}++;=0A= }=0A= }=0A= }=0A= =0A= # For backwards compability, set only_with_tag to only_on_branch if set. =0A= $input{only_with_tag} =3D $input{only_on_branch}=0A= if (defined($input{only_on_branch}));=0A= =0A= foreach (keys %DEFAULTVALUE)=0A= {=0A= # replace not given parameters with the default parameters=0A= if (!defined($input{$_}) || $input{$_} eq "") {=0A= # Empty Checkboxes in forms return -- nothing. So we define a helper=0A= # variable in these forms (copt) which indicates that we just set=0A= # parameters with a checkbox=0A= if (!defined($input{"copt"})) {=0A= # 'copt' isn't defined --> empty input is not the result=0A= # of empty input checkbox --> set default=0A= $input{$_} =3D $DEFAULTVALUE{$_} if (defined($DEFAULTVALUE{$_}));=0A= }=0A= else {=0A= # 'copt' is defined -> the result of empty input checkbox=0A= # -> set to zero (disable) if default is a boolean (0|1).=0A= $input{$_} =3D 0=0A= if (defined($DEFAULTVALUE{$_})=0A= && ($DEFAULTVALUE{$_} eq "0" || $DEFAULTVALUE{$_} eq "1"));=0A= }=0A= }=0A= }=0A= =0A= $barequery =3D "";=0A= foreach (@stickyvars) {=0A= # construct a query string with the sticky non default parameters set=0A= if (defined($input{$_}) && ($input{$_} ne "") && =0A= (!defined($DEFAULTVALUE{$_}) || $input{$_} ne $DEFAULTVALUE{$_})) {=0A= if ($barequery) {=0A= $barequery =3D $barequery . "&";=0A= }=0A= my $thisval =3D urlencode($_) . "=3D" . urlencode($input{$_});=0A= $barequery .=3D $thisval;=0A= }=0A= }=0A= # is there any query ?=0A= if ($barequery) {=0A= $query =3D "?$barequery";=0A= $barequery =3D "&" . $barequery;=0A= }=0A= else {=0A= $query =3D "";=0A= }=0A= =0A= # get actual parameters=0A= $sortby =3D $input{"sortby"};=0A= $bydate =3D 0;=0A= $byrev =3D 0;=0A= $byauthor =3D 0;=0A= $bylog =3D 0;=0A= $byfile =3D 0;=0A= if ($sortby eq "date") {=0A= $bydate =3D 1;=0A= }=0A= elsif ($sortby eq "rev") {=0A= $byrev =3D 1;=0A= }=0A= elsif ($sortby eq "author") {=0A= $byauthor =3D 1;=0A= }=0A= elsif ($sortby eq "log") {=0A= $bylog =3D 1;=0A= }=0A= else {=0A= $byfile =3D 1;=0A= }=0A= =0A= $hr_default =3D $input{'f'} eq 'h';=0A= =0A= $logsort =3D $input{"logsort"};=0A= =0A= =0A= ## Default CVS-Tree=0A= if (!defined($CVSROOT{$cvstreedefault})) {=0A= &fatal("500 Internal Error",=0A= "<code>\$cvstreedefault</code> points to a repository = ($cvstreedefault)"=0A= . "not defined in <code>%CVSROOT</code> "=0A= . "(edit your configuration file $config)");=0A= }=0A= $cvstree =3D $cvstreedefault;=0A= $cvsroot =3D $CVSROOT{"$cvstree"};=0A= =0A= # alternate CVS-Tree, configured in cvsweb.conf=0A= if ($input{'cvsroot'}) {=0A= if ($CVSROOT{$input{'cvsroot'}}) {=0A= $cvstree =3D $input{'cvsroot'};=0A= $cvsroot =3D $CVSROOT{"$cvstree"};=0A= }=0A= }=0A= =0A= # create icons out of description=0A= foreach my $k (keys %ICONS) {=0A= no strict 'refs';=0A= my ($itxt,$ipath,$iwidth,$iheight) =3D @{$ICONS{$k}};=0A= if ($ipath) {=0A= $ {"${k}icon"} =3D "<IMG SRC=3D\"$ipath\" ALT=3D\"$itxt\" = BORDER=3D\"0\" WIDTH=3D\"$iwidth\" HEIGHT=3D\"$iheight\">";=0A= }=0A= else {=0A= $ {"${k}icon"} =3D $itxt;=0A= }=0A= }=0A= =0A= # Do some special configuration for cvstrees=0A= do "$config-$cvstree" if (-f "$config-$cvstree");=0A= =0A= $fullname =3D $cvsroot . '/' . $where;=0A= $mimetype =3D &getMimeTypeFromSuffix ($fullname);=0A= $defaultTextPlain =3D ($mimetype eq "text/plain");=0A= $defaultViewable =3D $allow_markup && viewable($mimetype);=0A= =0A= # search for GZIP if compression allowed=0A= # We've to find out if the GZIP-binary exists .. otherwise=0A= # ge get an Internal Server Error if we try to pipe the=0A= # output through the nonexistent gzip .. =0A= # any more elegant ways to prevent this are welcome!=0A= if ($allow_compress && $maycompress && !$has_zlib) {=0A= foreach (split(/:/, $ENV{PATH})) {=0A= if (-x "$_/gzip") {=0A= $GZIPBIN =3D "$_/gzip";=0A= last;=0A= }=0A= }=0A= }=0A= =0A= if (-d $fullname) {=0A= #=0A= # ensure, that directories always end with (exactly) one '/'=0A= # to allow relative URL's. If they're not, make a redirect.=0A= ##=0A= my $pathinfo =3D defined($ENV{'PATH_INFO'}) ? $ENV{'PATH_INFO'} : "";=0A= if (!($pathinfo =3D~ m|/$|) || ($pathinfo =3D~ m |/{2,}$|)) {=0A= redirect ($scriptwhere . '/' . $query);=0A= }=0A= else {=0A= $where .=3D '/';=0A= $scriptwhere .=3D '/';=0A= }=0A= }=0A= =0A= if (!-d $cvsroot) {=0A= &fatal("500 Internal Error",'$CVSROOT not found!<P>The server on = which the CVS tree lives is probably down. Please try again in a few = minutes.');=0A= }=0A= =0A= #=0A= # See if the module is in our forbidden list.=0A= #=0A= $where =3D~ m:([^/]*):;=0A= $module =3D $1;=0A= if ($module && &forbidden_module($module)) {=0A= &fatal("403 Forbidden", "Access to $where forbidden.");=0A= }=0A= ##############################=0A= # View a directory=0A= ###############################=0A= elsif (-d $fullname) {=0A= my $dh =3D do {local(*DH);};=0A= opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!");=0A= my @dir =3D readdir($dh);=0A= closedir($dh);=0A= my @subLevelFiles =3D findLastModifiedSubdirs(@dir)=0A= if ($show_subdir_lastmod);=0A= getDirLogs($cvsroot,$where,@subLevelFiles);=0A= =0A= if ($where eq '/') {=0A= html_header("$defaulttitle");=0A= print $long_intro;=0A= }=0A= else {=0A= html_header("$where");=0A= print $short_instruction;=0A= }=0A= =0A= my $descriptions;=0A= if (($use_descriptions) && open (DESC, = "<$cvsroot/CVSROOT/descriptions")) {=0A= while (<DESC>) {=0A= chomp;=0A= my ($dir,$description) =3D /(\S+)\s+(.*)/;=0A= $descriptions{$dir} =3D $description;=0A= }=0A= }=0A= =0A= print "<P><a name=3D\"dirlist\"></a>\n";=0A= # give direct access to dirs=0A= if ($where eq '/') {=0A= chooseMirror();=0A= chooseCVSRoot();=0A= }=0A= else {=0A= print "<p>Current directory: <b>", &clickablePath($where,0), = "</b>\n";=0A= =0A= print "<P>Current tag: <B>", $input{only_with_tag}, "</b>\n" if=0A= $input{only_with_tag};=0A= =0A= }=0A= =0A= =0A= print "<HR NOSHADE>\n";=0A= # Using <MENU> in this manner violates the HTML2.0 spec but=0A= # provides the results that I want in most browsers. Another=0A= # case of layout spooging up HTML.=0A= =0A= my $infocols =3D 0;=0A= if ($dirtable) {=0A= if (defined($tableBorderColor)) {=0A= # Can't this be done by defining the border for the inner table?=0A= print "<table border=3D0 cellpadding=3D0 width=3D\"100%\"><tr><td = bgcolor=3D\"$tableBorderColor\">";=0A= }=0A= print "<table width=3D\"100%\" border=3D0 cellspacing=3D1 = cellpadding=3D$tablepadding>\n";=0A= $infocols++;=0A= print "<tr><th align=3Dleft bgcolor=3D\"" . (($byfile) ? =0A= $columnHeaderColorSorted : =0A= $columnHeaderColorDefault) . "\">";=0A= print "<a href=3D\"./" . &toggleQuery("sortby","file") .=0A= "#dirlist\">" if (!$byfile);=0A= print "File";=0A= print "</a>" if (!$byfile);=0A= print "</th>";=0A= # do not display the other column-headers, if we do not have any = files=0A= # with revision information:=0A= if (scalar(%fileinfo)) {=0A= $infocols++;=0A= print "<th align=3Dleft bgcolor=3D\"" . (($byrev) ? =0A= $columnHeaderColorSorted : =0A= $columnHeaderColorDefault) . "\">";=0A= print "<a href=3D\"./" . &toggleQuery ("sortby","rev") .=0A= "#dirlist\">" if (!$byrev);=0A= print "Rev.";=0A= print "</a>" if (!$byrev);=0A= print "</th>";=0A= $infocols++;=0A= print "<th align=3Dleft bgcolor=3D\"" . (($bydate) ? =0A= $columnHeaderColorSorted : =0A= $columnHeaderColorDefault) . "\">";=0A= print "<a href=3D\"./" . &toggleQuery ("sortby","date") .=0A= "#dirlist\">" if (!$bydate);=0A= print "Age";=0A= print "</a>" if (!$bydate);=0A= print "</th>";=0A= if ($show_author) {=0A= $infocols++;=0A= print "<th align=3Dleft bgcolor=3D\"" . (($byauthor) ? =0A= $columnHeaderColorSorted : =0A= $columnHeaderColorDefault) . "\">";=0A= print "<a href=3D\"./" . &toggleQuery ("sortby","author") .=0A= "#dirlist\">" if (!$byauthor);=0A= print "Author";=0A= print "</a>" if (!$byauthor);=0A= print "</th>";=0A= }=0A= $infocols++;=0A= print "<th align=3Dleft bgcolor=3D\"" . (($bylog) ? =0A= $columnHeaderColorSorted : =0A= $columnHeaderColorDefault) . "\">";=0A= print "<a href=3D\"./", toggleQuery("sortby","log"), "#dirlist\">" if = (!$bylog);=0A= print "Last log entry";=0A= print "</a>" if (!$bylog);=0A= print "</th>";=0A= }=0A= elsif ($use_descriptions) {=0A= print "<th align=3Dleft bgcolor=3D\"". $columnHeaderColorDefault . = "\">";=0A= print "Description";=0A= $infocols++;=0A= }=0A= print "</tr>\n";=0A= }=0A= else {=0A= print "<menu>\n";=0A= }=0A= my $dirrow =3D 0;=0A= =0A= my $i;=0A= lookingforattic:=0A= for ($i =3D 0; $i <=3D $#dir; $i++) {=0A= if ($dir[$i] eq "Attic") {=0A= last lookingforattic;=0A= }=0A= }=0A= if (!$input{'hideattic'} && ($i <=3D $#dir) &&=0A= opendir($dh, $fullname . "/Attic")) {=0A= splice(@dir, $i, 1,=0A= grep((s|^|Attic/|,!m|/\.|), readdir($dh)));=0A= closedir($dh);=0A= }=0A= =0A= my $hideAtticToggleLink =3D "<a href=3D\"./" . =0A= &toggleQuery ("hideattic") .=0A= "#dirlist\">[Hide]</a>" if (!$input{'hideattic'});=0A= =0A= # Sort without the Attic/ pathname.=0A= # place directories first=0A= =0A= my $attic;=0A= my $url;=0A= my $fileurl;=0A= my $filesexists;=0A= my $filesfound;=0A= =0A= foreach (sort { &fileSortCmp } @dir) {=0A= if ($_ eq '.') {=0A= next;=0A= }=0A= # ignore CVS lock and stale NFS files=0A= next if (/^#cvs\.|^,|^\.nfs/);=0A= =0A= # Check whether to show the CVSROOT path=0A= next if ($input{'hidecvsroot'} && ($_ eq 'CVSROOT'));=0A= =0A= # Check whether the module is in the restricted list=0A= next if ($_ && &forbidden_module($_));=0A= =0A= # Ignore non-readable files=0A= next if ($input{'hidenonreadable'} && !(-r "$fullname/$_"));=0A= =0A= if (s|^Attic/||) {=0A= $attic =3D " (in the Attic) " . $hideAtticToggleLink;=0A= }=0A= else {=0A= $attic =3D "";=0A= }=0A= =0A= if ($_ eq '..' || -d "$fullname/$_") {=0A= next if ($_ eq '..' && $where eq '/');=0A= my ($rev,$date,$log,$author,$filename);=0A= ($rev,$date,$log,$author,$filename) =3D @{$fileinfo{$_}}=0A= if (defined($fileinfo{$_}));=0A= print "<tr bgcolor=3D\"" . @tabcolors[$dirrow%2] . "\"><td>" if = ($dirtable);=0A= if ($_ eq '..') {=0A= $url =3D "../" . $query;=0A= if ($nofilelinks) {=0A= print $backicon;=0A= }=0A= else {=0A= print &link($backicon,$url);=0A= }=0A= print " ", &link("Previous Directory",$url);=0A= }=0A= else {=0A= $url =3D urlencode($_) . '/' . $query;=0A= print "<A NAME=3D\"$_\"></A>";=0A= if ($nofilelinks) {=0A= print $diricon;=0A= }=0A= else {=0A= print &link($diricon,$url);=0A= }=0A= print " ", &link($_ . "/", $url), $attic;=0A= if ($_ eq "Attic") {=0A= print " <a href=3D\"./" . =0A= &toggleQuery ("hideattic") .=0A= "#dirlist\">[Don't hide]</a>";=0A= }=0A= } =0A= # Show last change in dir=0A= if ($filename) {=0A= print "</td><td> </td><td> " if ($dirtable);=0A= if ($date) {=0A= print " <i>" . readableTime(time() - $date,0) . "</i>";=0A= }=0A= if ($show_author) {=0A= print "</td><td> " if ($dirtable);=0A= print $author;=0A= }=0A= print "</td><td> " if ($dirtable);=0A= $filename =3D~ s%^[^/]+/%%;=0A= print "$filename/$rev";=0A= print "<BR>" if ($dirtable);=0A= if ($log) {=0A= print " <font size=3D-1>"=0A= . &htmlify(substr($log,0,$shortLogLen));=0A= if (length $log > 80) {=0A= print "...";=0A= }=0A= print "</font>";=0A= }=0A= }=0A= else {=0A= my ($dwhere) =3D ($where ne "/" ? $where : "") . $_;=0A= if ($use_descriptions && defined $descriptions{$dwhere}) {=0A= print "<TD COLSPAN=3D" . ($infocols-1) . "> " if $dirtable;=0A= print $descriptions{$dwhere};=0A= } elsif ($dirtable && $infocols > 1) {=0A= # close the row with the appropriate number of=0A= # columns, so that the vertical seperators are visible=0A= my($cols) =3D $infocols;=0A= while ($cols > 1) {=0A= print "</td><td> ";=0A= $cols--;=0A= }=0A= }=0A= }=0A= if ($dirtable) {=0A= print "</td></tr>\n";=0A= }=0A= else {=0A= print "<br>\n";=0A= }=0A= $dirrow++;=0A= }=0A= elsif (s/,v$//) {=0A= $fileurl =3D ($attic ? "Attic/" : "") . urlencode($_);=0A= $url =3D $fileurl . $query;=0A= my $rev =3D '';=0A= my $date =3D '';=0A= my $log =3D '';=0A= my $author =3D '';=0A= $filesexists++;=0A= next if (!defined($fileinfo{$_}));=0A= ($rev,$date,$log,$author) =3D @{$fileinfo{$_}};=0A= $filesfound++;=0A= print "<tr bgcolor=3D\"" . @tabcolors[$dirrow%2] . "\"><td>" if = ($dirtable);=0A= print "<A NAME=3D\"$_\"></A>";=0A= if ($nofilelinks) {=0A= print $fileicon;=0A= }=0A= else {=0A= print &link($fileicon,$url);=0A= }=0A= print " ", &link($_, $url), $attic;=0A= print "</td><td> " if ($dirtable);=0A= download_link($fileurl,=0A= $rev, $rev, =0A= $defaultViewable ? "text/x-cvsweb-markup" : undef);=0A= print "</td><td> " if ($dirtable);=0A= if ($date) {=0A= print " <i>" . readableTime(time() - $date,0) . "</i>";=0A= }=0A= if ($show_author) {=0A= print "</td><td> " if ($dirtable);=0A= print $author;=0A= }=0A= print "</td><td> " if ($dirtable);=0A= if ($log) {=0A= print " <font size=3D-1>" . &htmlify(substr($log,0,$shortLogLen));=0A= if (length $log > 80) {=0A= print "...";=0A= }=0A= print "</font>";=0A= }=0A= print "</td>" if ($dirtable);=0A= print (($dirtable) ? "</tr>" : "<br>");=0A= $dirrow++;=0A= }=0A= print "\n";=0A= }=0A= if ($dirtable && defined($tableBorderColor)) {=0A= print "</td></tr></table>";=0A= }=0A= print "". ($dirtable =3D=3D 1) ? "</table>" : "</menu>" . "\n";=0A= =0A= if ($filesexists && !$filesfound) {=0A= print "<P><B>NOTE:</B> There are $filesexists files, but none = matches the current tag ($input{only_with_tag})\n";=0A= }=0A= if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) = {=0A= %tags =3D %alltags=0A= }=0A= if (scalar %tags =0A= || $input{only_with_tag} =0A= || $edit_option_form=0A= || defined($input{"options"})) {=0A= print "<hr size=3D1 NOSHADE>";=0A= }=0A= =0A= if (scalar %tags || $input{only_with_tag}) {=0A= print "<FORM METHOD=3D\"GET\" ACTION=3D\"./\">\n";=0A= foreach my $var (@stickyvars) {=0A= print "<INPUT TYPE=3DHIDDEN NAME=3D\"$var\" = VALUE=3D\"$input{$var}\">\n"=0A= if (defined($input{$var})=0A= && (!defined($DEFAULTVALUE{$var})=0A= || $input{$var} ne $DEFAULTVALUE{$var})=0A= && $input{$var} ne ""=0A= && $var ne "only_with_tag");=0A= }=0A= print "Show only files with tag:\n";=0A= print "<SELECT NAME=3Donly_with_tag";=0A= print " onchange=3D\"submit()\"" if ($use_java_script);=0A= print ">";=0A= print "<OPTION VALUE=3D\"\">All tags / default branch\n";=0A= foreach my $tag (reverse sort { lc $a cmp lc $b } keys %tags) {=0A= print "<OPTION",defined($input{only_with_tag}) && =0A= $input{only_with_tag} eq $tag ? " SELECTED":"",=0A= ">$tag\n";=0A= }=0A= print "</SELECT>\n";=0A= print "<INPUT TYPE=3DSUBMIT VALUE=3D\"Go\">\n";=0A= print "</FORM>\n";=0A= }=0A= my $formwhere =3D $scriptwhere;=0A= $formwhere =3D~ s|Attic/?$|| if ($input{'hideattic'});=0A= =0A= if ($edit_option_form || defined($input{"options"})) {=0A= print "<FORM METHOD=3D\"GET\" ACTION=3D\"${formwhere}\">\n";=0A= print "<INPUT TYPE=3DHIDDEN NAME=3D\"copt\" VALUE=3D\"1\">\n";=0A= if ($cvstree ne $cvstreedefault) {=0A= print "<INPUT TYPE=3DHIDDEN NAME=3D\"cvsroot\" = VALUE=3D\"$cvstree\">\n";=0A= }=0A= print "<center><table cellpadding=3D0 cellspacing=3D0>";=0A= print "<tr bgcolor=3D\"$columnHeaderColorDefault\"><th = colspan=3D2>Preferences</th></tr>";=0A= print "<tr><td>Sort files by <SELECT name=3D\"sortby\">";=0A= print "<OPTION VALUE=3D\"\">File";=0A= print "<OPTION",$bydate ? " SELECTED" : ""," VALUE=3Ddate>Age";=0A= print "<OPTION",$byauthor ? " SELECTED" : ""," = VALUE=3Dauthor>Author"=0A= if ($show_author);=0A= print "<OPTION",$byrev ? " SELECTED" : ""," VALUE=3Drev>Revision";=0A= print "<OPTION",$bylog ? " SELECTED" : ""," VALUE=3Dlog>Log = message";=0A= print "</SELECT></td>";=0A= print "<td>revisions by: \n";=0A= print "<SELECT NAME=3Dlogsort>\n";=0A= print "<OPTION VALUE=3Dcvs",$logsort eq "cvs" ? " SELECTED" : "", = ">Not sorted";=0A= print "<OPTION VALUE=3Ddate",$logsort eq "date" ? " SELECTED" : "", = ">Commit date";=0A= print "<OPTION VALUE=3Drev",$logsort eq "rev" ? " SELECTED" : "", = ">Revision";=0A= print "</SELECT></td></tr>";=0A= print "<tr><td>Diff format: ";=0A= printDiffSelect(0);=0A= print "</td>";=0A= print "<td>Show Attic files: ";=0A= print "<INPUT NAME=3Dhideattic TYPE=3DCHECKBOX", = $input{'hideattic'}?" CHECKED":"", =0A= "></td></tr>\n";=0A= print "<tr><td align=3Dcenter colspan=3D2><input type=3Dsubmit = value=3D\"Change Options\">";=0A= print "</td></tr></table></center></FORM>\n";=0A= }=0A= print &html_footer;=0A= print "</BODY></HTML>\n";=0A= } =0A= =0A= ###############################=0A= # View Files=0A= ###############################=0A= elsif (-f $fullname . ',v') {=0A= if (defined($input{'rev'}) || $doCheckout) {=0A= &doCheckout($fullname, $input{'rev'});=0A= gzipclose();=0A= exit;=0A= }=0A= if (defined($input{'annotate'}) && $allow_annotate) {=0A= &doAnnotate($input{'annotate'});=0A= gzipclose();=0A= exit;=0A= }=0A= if (defined($input{'r1'}) && defined($input{'r2'})) {=0A= &doDiff($fullname, $input{'r1'}, $input{'tr1'},=0A= $input{'r2'}, $input{'tr2'}, $input{'f'});=0A= gzipclose();=0A= exit;=0A= }=0A= print("going to dolog($fullname)\n") if ($verbose);=0A= &doLog($fullname);=0A= ##############################=0A= # View Diff=0A= ##############################=0A= }=0A= elsif ($fullname =3D~ s/\.diff$// && -f $fullname . ",v" &&=0A= $input{'r1'} && $input{'r2'}) {=0A= =0A= # $where-diff-removal if 'cvs rdiff' is used=0A= # .. but 'cvs rdiff'doesn't support some options=0A= # rcsdiff does (-w and -p), so it is disabled=0A= # $where =3D~ s/\.diff$//;=0A= =0A= # Allow diffs using the ".diff" extension=0A= # so that browsers that default to the URL=0A= # for a save filename don't save diff's as=0A= # e.g. foo.c=0A= &doDiff($fullname, $input{'r1'}, $input{'tr1'},=0A= $input{'r2'}, $input{'tr2'}, $input{'f'});=0A= gzipclose();=0A= exit;=0A= }=0A= elsif (($newname =3D $fullname) =3D~ s|/([^/]+)$|/Attic/$1| &&=0A= -f $newname . ",v") {=0A= # The file has been removed and is in the Attic.=0A= # Send a redirect pointing to the file in the Attic.=0A= (my $newplace =3D $scriptwhere) =3D~ s|/([^/]+)$|/Attic/$1|;=0A= &redirect($newplace . "?" . $ENV{QUERY_STRING});=0A= exit;=0A= }=0A= elsif (0 && (my @files =3D &safeglob($fullname . ",v"))) {=0A= http_header("text/plain");=0A= print "You matched the following files:\n";=0A= print join("\n", @files);=0A= # Find the tags from each file=0A= # Display a form offering diffs between said tags=0A= }=0A= else {=0A= my $fh =3D do {local(*FH);};=0A= my ($xtra, $module);=0A= # Assume it's a module name with a potential path following it.=0A= $xtra =3D $& if (($module =3D $where) =3D~ s|/.*||);=0A= # Is there an indexed version of modules?=0A= if (open($fh, "$cvsroot/CVSROOT/modules")) {=0A= while (<$fh>) {=0A= if (/^(\S+)\s+(\S+)/o && $module eq $1=0A= && -d "${cvsroot}/$2" && $module ne $2) {=0A= &redirect($scriptname . '/' . $2 . $xtra);=0A= }=0A= }=0A= }=0A= &fatal("404 Not Found","$where: no such file or directory");=0A= }=0A= =0A= gzipclose();=0A= ## End MAIN=0A= =0A= sub printDiffSelect($) {=0A= my ($use_java_script) =3D @_;=0A= $use_java_script =3D 0 if (!defined($use_java_script));=0A= my ($f) =3D $input{'f'};=0A= print "<SELECT NAME=3D\"f\"";=0A= print " onchange=3D\"submit()\"" if ($use_java_script);=0A= print ">\n";=0A= print "<OPTION VALUE=3Dh",$f eq "h" ? " SELECTED" : "", ">Colored = Diff";=0A= print "<OPTION VALUE=3DH",$f eq "H" ? " SELECTED" : "", ">Long = Colored Diff";=0A= print "<OPTION VALUE=3Du",$f eq "u" ? " SELECTED" : "", ">Unidiff";=0A= print "<OPTION VALUE=3Dc",$f eq "c" ? " SELECTED" : "", ">Context = Diff";=0A= #print "<OPTION VALUE=3Ds",$f eq "s" ? " SELECTED" : "", ">Side by = Side";=0A= print "</SELECT>";=0A= }=0A= =0A= sub findLastModifiedSubdirs(@) {=0A= my (@dirs) =3D @_;=0A= my ($dirname, @files);=0A= =0A= foreach $dirname (@dirs) {=0A= next if ($dirname eq ".");=0A= next if ($dirname eq "..");=0A= my ($dir) =3D "$fullname/$dirname";=0A= next if (!-d $dir);=0A= =0A= my ($lastmod) =3D undef;=0A= my ($lastmodtime) =3D undef;=0A= my $dh =3D do {local(*DH);};=0A= =0A= opendir($dh,$dir) || next;=0A= my (@filenames) =3D readdir($dh);=0A= closedir($dh);=0A= =0A= foreach my $filename (@filenames) {=0A= $filename =3D "$dirname/$filename";=0A= my ($file) =3D "$fullname/$filename";=0A= next if ($filename !~ /,v$/ || !-f $file);=0A= $filename =3D~ s/,v$//;=0A= my $modtime =3D -M $file;=0A= if (!defined($lastmod) || $modtime < $lastmodtime) {=0A= $lastmod =3D $filename;=0A= $lastmodtime =3D $modtime;=0A= }=0A= }=0A= push(@files, $lastmod) if (defined($lastmod));=0A= }=0A= return @files;=0A= }=0A= =0A= sub htmlify($) {=0A= my($string) =3D @_;=0A= =0A= # Special Characters; RFC 1866=0A= $string =3D~ s/&/&/g;=0A= $string =3D~ s/\"/"/g; =0A= $string =3D~ s/</</g;=0A= $string =3D~ s/>/>/g;=0A= =0A= # get URL's as link ..=0A= $string =3D~ = s=A7(http|ftp|https)(://[-a-zA-Z0-9%.~:_/]+)([?&]([-a-zA-Z0-9%.~:_]+)=3D(= [-a-zA-Z0-9%.~:_])+)*=A7<A HREF=3D"$1$2$3">$1$2$3</A>=A7;=0A= # get e-mails as link=0A= $string =3D~ s=A7([-a-zA-Z0-9_.]+@([-a-zA-Z0-9]+\.)+[A-Za-z]{2,4})=A7<A = HREF=3D"mailto:$1">$1</A>=A7;=0A= =0A= return $string;=0A= }=0A= =0A= sub spacedHtmlText($) {=0A= my($string) =3D @_;=0A= =0A= # Cut trailing spaces=0A= s/\s+$//;=0A= =0A= # Expand tabs=0A= $string =3D~ s/\t+/' ' x (length($&) * $tabstop - length($`) % = $tabstop)/e=0A= if (defined($tabstop));=0A= =0A= # replace <tab> and <space> (=A7 is to protect us from htmlify)=0A= # gzip can make excellent use of this repeating pattern :-)=0A= $string =3D~ s/=A7/=A7%/g; #protect our & substitute=0A= if ($hr_breakable) {=0A= # make every other space 'breakable'=0A= $string =3D~ s/ / =A7nbsp; =A7nbsp; =A7nbsp; =A7nbsp;/g; # <tab>=0A= $string =3D~ s/ / =A7nbsp;/g; # 2 * = <space>=0A= # leave single space as it is=0A= }=0A= else {=0A= $string =3D~ s/ = /=A7nbsp;=A7nbsp;=A7nbsp;=A7nbsp;=A7nbsp;=A7nbsp;=A7nbsp;=A7nbsp;/g; =0A= $string =3D~ s/ /=A7nbsp;/g;=0A= }=0A= =0A= $string =3D htmlify($string);=0A= =0A= # unescape=0A= $string =3D~ s/=A7([^%])/&$1/g;=0A= $string =3D~ s/=A7%/=A7/g;=0A= =0A= return $string;=0A= }=0A= =0A= sub link($$) {=0A= my($name, $where) =3D @_;=0A= =0A= return "<A HREF=3D\"$where\">$name</A>\n";=0A= }=0A= =0A= sub revcmp($$) {=0A= my($rev1, $rev2) =3D @_;=0A= my(@r1) =3D split(/\./, $rev1);=0A= my(@r2) =3D split(/\./, $rev2);=0A= my($a,$b);=0A= =0A= while (($a =3D shift(@r1)) && ($b =3D shift(@r2))) {=0A= if ($a !=3D $b) {=0A= return $a <=3D> $b;=0A= }=0A= }=0A= if (@r1) { return 1; }=0A= if (@r2) { return -1; }=0A= return 0;=0A= }=0A= =0A= sub fatal($$) {=0A= my($errcode, $errmsg) =3D @_;=0A= if (defined($ENV{'MOD_PERL'})) {=0A= Apache->request->status((split(/ /, $errcode))[0]);=0A= }=0A= else {=0A= print "Status: $errcode\n";=0A= }=0A= html_header("Error");=0A= print "Error: $errmsg\n";=0A= print &html_footer;=0A= exit(1);=0A= }=0A= =0A= sub redirect($) {=0A= my($url) =3D @_;=0A= if (defined($ENV{'MOD_PERL'})) {=0A= Apache->request->status(301);=0A= Apache->request->header_out(Location =3D> $url);=0A= }=0A= else {=0A= print "Status: 301 Moved\r\n";=0A= print "Location: $url\r\n";=0A= }=0A= html_header("Moved");=0A= print "This document is located <A HREF=3D$url>here</A>.\n";=0A= print &html_footer;=0A= exit(1);=0A= }=0A= =0A= sub safeglob($) {=0A= my ($filename) =3D @_;=0A= my ($dirname);=0A= my (@results);=0A= my $dh =3D do {local(*DH);};=0A= =0A= ($dirname =3D $filename) =3D~ s|/[^/]+$||;=0A= $filename =3D~ s|.*/||;=0A= =0A= if (opendir($dh, $dirname)) {=0A= my $glob =3D $filename;=0A= my $t;=0A= # transform filename from glob to regex. Deal with:=0A= # [, {, ?, * as glob chars=0A= # make sure to escape all other regex chars=0A= $glob =3D~ s/([\.\(\)\|\+])/\\$1/g;=0A= $glob =3D~ s/\*/.*/g;=0A= $glob =3D~ s/\?/./g;=0A= $glob =3D~ s/{([^}]+)}/($t =3D $1) =3D~ s-,-|-g; "($t)"/eg;=0A= foreach (readdir($dh)) {=0A= if (/^${glob}$/) {=0A= push(@results, $dirname . "/" .$_);=0A= }=0A= }=0A= closedir($dh);=0A= }=0A= =0A= @results;=0A= }=0A= =0A= sub getMimeTypeFromSuffix($) {=0A= my ($fullname) =3D @_;=0A= my ($mimetype, $suffix);=0A= my $fh =3D do {local(*FH);};=0A= =0A= ($suffix =3D $fullname) =3D~ s/^.*\.([^.]*)$/$1/;=0A= $mimetype =3D $MTYPES{$suffix};=0A= $mimetype =3D $MTYPES{'*'} if (!$mimetype);=0A= =0A= if (!$mimetype && -f $mime_types) {=0A= # okey, this is something special - search the=0A= # mime.types database=0A= open ($fh, "<$mime_types");=0A= while (<$fh>) {=0A= if ($_ =3D~ /^\s*(\S+\/\S+).*\b$suffix\b/) {=0A= $mimetype =3D $1;=0A= last;=0A= }=0A= }=0A= close ($fh);=0A= }=0A= =0A= # okey, didn't find anything useful ..=0A= if (!($mimetype =3D~ /\S\/\S/)) {=0A= $mimetype =3D "text/plain";=0A= }=0A= return $mimetype;=0A= }=0A= =0A= ###############################=0A= # show Annotation=0A= ###############################=0A= sub doAnnotate ($$) {=0A= my ($rev) =3D @_;=0A= my ($pid);=0A= my ($pathname, $filename);=0A= my $reader =3D do {local(*FH);};=0A= my $writer =3D do {local(*FH);};=0A= =0A= # make sure the revisions are wellformed, for security=0A= # reasons ..=0A= if (!($rev =3D~ /^[\d\.]+$/)) {=0A= &fatal("404 Not Found",=0A= "Malformed query \"$ENV{'QUERY_STRING'}\"");=0A= }=0A= =0A= if (&forbidden_file($fullname)) {=0A= &fatal("403 Forbidden", "Access forbidden. This file is mentioned in = \@DissallowRead");=0A= return;=0A= }=0A= =0A= ($pathname =3D $where) =3D~ s/(Attic\/)?[^\/]*$//;=0A= ($filename =3D $where) =3D~ s/^.*\///;=0A= =0A= http_header();=0A= =0A= navigateHeader ($scriptwhere,$pathname,$filename,$rev, "annotate");=0A= print "<h3 align=3Dcenter>Annotation of $pathname$filename, Revision = $rev</h3>\n";=0A= =0A= # this seems to be necessary=0A= $| =3D 1; $| =3D 0; # Flush=0A= =0A= # this annotate version is based on the=0A= # cvs annotate-demo Perl script by Cyclic Software=0A= # It was written by Cyclic Software, http://www.cyclic.com/, and is = in=0A= # the public domain.=0A= # we could abandon the use of rlog, rcsdiff and co using=0A= # the cvsserver in a similiar way one day (..after rewrite)=0A= $pid =3D open2($reader, $writer, "cvs server") || fatal ("500 = Internal Error", =0A= "Fatal Error - unable to open cvs for annotation");=0A= =0A= # OK, first send the request to the server. A simplified example is:=0A= # Root /home/kingdon/zwork/cvsroot=0A= # Argument foo/xx=0A= # Directory foo=0A= # /home/kingdon/zwork/cvsroot/foo=0A= # Directory .=0A= # /home/kingdon/zwork/cvsroot=0A= # annotate=0A= # although as you can see there are a few more details.=0A= =0A= print $writer "Root $cvsroot\n";=0A= print $writer "Valid-responses ok error Valid-requests Checked-in = Updated Merged Removed M E\n";=0A= # Don't worry about sending valid-requests, the server just needs to=0A= # support "annotate" and if it doesn't, there isn't anything to be = done.=0A= print $writer "UseUnchanged\n";=0A= print $writer "Argument -r\n";=0A= print $writer "Argument $rev\n";=0A= print $writer "Argument $where\n";=0A= =0A= # The protocol requires us to fully fake a working directory (at=0A= # least to the point of including the directories down to the one=0A= # containing the file in question).=0A= # So if $where is "dir/sdir/file", then @dirs will be = ("dir","sdir","file")=0A= my @dirs =3D split('/', $where);=0A= my $path =3D "";=0A= foreach (@dirs) {=0A= if ($path eq "") {=0A= # In our example, $_ is "dir".=0A= $path =3D $_;=0A= }=0A= else {=0A= print $writer "Directory $path\n";=0A= print $writer "$cvsroot/$path\n";=0A= # In our example, $_ is "sdir" and $path becomes "dir/sdir"=0A= # And the next time, "file" and "dir/sdir/file" (which then gets=0A= # ignored, because we don't need to send Directory for the file).=0A= $path .=3D "/$_";=0A= }=0A= }=0A= # And the last "Directory" before "annotate" is the top level.=0A= print $writer "Directory .\n";=0A= print $writer "$cvsroot\n";=0A= =0A= print $writer "annotate\n";=0A= # OK, we've sent our command to the server. Thing to do is to=0A= # close the writer side and get all the responses. If "cvs server"=0A= # were nicer about buffering, then we could just leave it open, I = think.=0A= close ($writer) || die "cannot close: $!";=0A= =0A= # Ready to get the responses from the server.=0A= # For example:=0A= # E Annotations for foo/xx=0A= # E ***************=0A= # M 1.3 (kingdon 06-Sep-97): hello =0A= # ok=0A= my ($lineNr) =3D 0;=0A= my ($oldLrev, $oldLusr) =3D ("", "");=0A= my ($revprint, $usrprint);=0A= if ($annTable) {=0A= print "<table border=3D0 cellspacing=3D0 cellpadding=3D0>\n";=0A= }=0A= else {=0A= print "<pre>";=0A= }=0A= while (<$reader>) {=0A= my @words =3D split;=0A= # Adding one is for the (single) space which follows $words[0].=0A= my $rest =3D substr ($_, length ($words[0]) + 1);=0A= if ($words[0] eq "E") {=0A= next;=0A= }=0A= elsif ($words[0] eq "M") {=0A= $lineNr++;=0A= my $lrev =3D substr ($_, 2, 13);=0A= my $lusr =3D substr ($_, 16, 9);=0A= my $line =3D substr ($_, 36);=0A= # we should parse the date here ..=0A= if ($lrev eq $oldLrev) {=0A= $revprint =3D " ";=0A= }=0A= else {=0A= $revprint =3D $lrev; $oldLusr =3D "";=0A= }=0A= if ($lusr eq $oldLusr) {=0A= $usrprint =3D " ";=0A= }=0A= else {=0A= $usrprint =3D $lusr;=0A= }=0A= $oldLrev =3D $lrev;=0A= $oldLusr =3D $lusr;=0A= # is there a less timeconsuming way to strip spaces ?=0A= ($lrev =3D $lrev) =3D~ s/\s+//g;=0A= my $isCurrentRev =3D ("$rev" eq "$lrev");=0A= =0A= print "<b>" if ($isCurrentRev);=0A= printf ("%8s%s%8s %4d:", $revprint, ($isCurrentRev ? "|" : " "), = $usrprint, $lineNr);=0A= print spacedHtmlText($line);=0A= print "</b>" if ($isCurrentRev);=0A= }=0A= elsif ($words[0] eq "ok") {=0A= # We could complain about any text received after this, like the=0A= # CVS command line client. But for simplicity, we don't.=0A= }=0A= elsif ($words[0] eq "error") {=0A= fatal ("500 Internal Error", "Error occured during annotate: = <b>$_</b>");=0A= }=0A= }=0A= if ($annTable) {=0A= print "</table>";=0A= }=0A= else {=0A= print "</pre>";=0A= }=0A= close ($reader) || warn "cannot close: $!";=0A= wait;=0A= }=0A= =0A= ###############################=0A= # make Checkout=0A= ###############################=0A= sub doCheckout($$) {=0A= my ($fullname, $rev) =3D @_;=0A= my ($mimetype,$revopt);=0A= my $fh =3D do {local(*FH);};=0A= =0A= if ($rev eq 'HEAD' || $rev eq '.') {=0A= $rev =3D undef;=0A= }=0A= =0A= # make sure the revisions a wellformed, for security=0A= # reasons ..=0A= if (defined($rev) && !($rev =3D~ /^[\d\.]+$/)) {=0A= &fatal("404 Not Found",=0A= "Malformed query \"$ENV{'QUERY_STRING'}\"");=0A= }=0A= =0A= if (&forbidden_file($fullname)) {=0A= &fatal("403 Forbidden", "Access forbidden. This file is mentioned in = \@DissallowRead");=0A= return;=0A= }=0A= =0A= # get mimetype=0A= if (defined($input{"content-type"}) && ($input{"content-type"} =3D~ = /\S\/\S/)) {=0A= $mimetype =3D $input{"content-type"}=0A= }=0A= else {=0A= $mimetype =3D &getMimeTypeFromSuffix($fullname);=0A= }=0A= =0A= if (defined($rev)) {=0A= $revopt =3D "-r$rev";=0A= if ($use_moddate) {=0A= readLog($fullname,$rev);=0A= $moddate=3D$date{$rev};=0A= }=0A= }=0A= else {=0A= $revopt =3D "-rHEAD";=0A= if ($use_moddate) {=0A= readLog($fullname);=0A= $moddate=3D$date{$symrev{HEAD}};=0A= }=0A= }=0A= =0A= ### just for the record:=0A= ### 'cvs co' seems to have a bug regarding single checkout of=0A= ### directories/files having spaces in it;=0A= ### this is an issue that should be resolved on cvs's side=0A= #=0A= # Safely for a child process to read from.=0A= if (! open($fh, "-|")) { # child=0A= open(STDERR, ">&STDOUT"); # Redirect stderr to stdout=0A= exec("cvs", "-d", "$cvsroot", "co", "-p", "$revopt", "$where");=0A= } =0A= #=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=0A= #Checking out squid/src/ftp.c=0A= #RCS: /usr/src/CVS/squid/src/ftp.c,v=0A= #VERS: 1.1.1.28.6.2=0A= #***************=0A= =0A= # Parse CVS header=0A= my ($revision, $filename, $cvsheader);=0A= $filename =3D "";=0A= while(<$fh>) {=0A= last if (/^\*\*\*\*/);=0A= $revision =3D $1 if (/^VERS: (.*)$/);=0A= if (/^Checking out (.*)$/) {=0A= $filename =3D $1;=0A= $filename =3D~ s/^\.\/*//;=0A= }=0A= $cvsheader .=3D $_;=0A= }=0A= if ($filename ne $where) {=0A= &fatal("500 Internal Error",=0A= "Unexpected output from cvs co: $cvsheader"=0A= . "<p><b>Check whether the directory $cvsroot/CVSROOT exists "=0A= . "and the script has write-access to the CVSROOT/history "=0A= . "file if it exists."=0A= . "<br>The script needs to place lock files in the "=0A= . "directory the file is in as well.</b>");=0A= }=0A= $| =3D 1;=0A= =0A= if ($mimetype eq "text/x-cvsweb-markup") {=0A= &cvswebMarkup($fh,$fullname,$revision);=0A= }=0A= else {=0A= http_header($mimetype);=0A= print <$fh>;=0A= }=0A= close($fh);=0A= }=0A= =0A= sub cvswebMarkup($$$) {=0A= my ($filehandle,$fullname,$revision) =3D @_;=0A= my ($pathname, $filename);=0A= =0A= ($pathname =3D $where) =3D~ s/(Attic\/)?[^\/]*$//;=0A= ($filename =3D $where) =3D~ s/^.*\///;=0A= my ($fileurl) =3D urlencode($filename);=0A= =0A= http_header();=0A= =0A= navigateHeader ($scriptwhere, $pathname, $filename, $revision, = "view");=0A= print "<HR noshade>";=0A= print "<table width=3D\"100%\"><tr><td = bgcolor=3D\"$markupLogColor\">";=0A= print "File: ", &clickablePath($where, 1);=0A= print " ";=0A= &download_link(urlencode($fileurl), $revision, "(download)");=0A= if (!$defaultTextPlain) {=0A= print " ";=0A= &download_link(urlencode($fileurl), $revision, "(as text)", =0A= "text/plain");=0A= }=0A= print "<BR>\n";=0A= if ($show_log_in_markup) {=0A= readLog($fullname); #,$revision);=0A= printLog($revision,0);=0A= }=0A= else {=0A= print "Version: <B>$revision</B><BR>\n";=0A= print "Tag: <B>", $input{only_with_tag}, "</b><br>\n" if=0A= $input{only_with_tag};=0A= }=0A= print "</td></tr></table>";=0A= my @content =3D <$filehandle>;=0A= my $url =3D download_url($fileurl, $revision, $mimetype);=0A= print "<HR noshade>";=0A= if ($mimetype =3D~ /^image/) {=0A= print "<IMG SRC=3D\"$url$barequery\"><BR>";=0A= }=0A= elsif ($mimetype =3D~ m%^application/pdf%) {=0A= print "<EMBED SRC=3D\"$url$barequery\" WIDTH=3D\"100%\"><BR>";=0A= }=0A= else {=0A= print "<PRE>";=0A= foreach (@content) {=0A= print spacedHtmlText($_);=0A= }=0A= print "</PRE>";=0A= }=0A= }=0A= =0A= sub viewable($) {=0A= my ($mimetype) =3D @_;=0A= =0A= $mimetype =3D~ m%^text/% ||=0A= $mimetype =3D~ m%^image/% ||=0A= $mimetype =3D~ m%^application/pdf% ||=0A= 0;=0A= }=0A= =0A= ###############################=0A= # Show Colored Diff=0A= ###############################=0A= sub doDiff($$$$$$) {=0A= my($fullname, $r1, $tr1, $r2, $tr2, $f) =3D @_;=0A= my $fh =3D do {local(*FH);};=0A= my ($rev1, $rev2, $sym1, $sym2, @difftype, $diffname, $f1, $f2);=0A= =0A= if (&forbidden_file($fullname)) {=0A= &fatal("403 Forbidden", "Access forbidden. This file is mentioned = in \@DissallowRead");=0A= return;=0A= }=0A= =0A= if ($r1 =3D~ /([^:]+)(:(.+))?/) {=0A= $rev1 =3D $1;=0A= $sym1 =3D $3;=0A= }=0A= if ($r1 eq 'text') {=0A= $rev1 =3D $tr1;=0A= $sym1 =3D "";=0A= }=0A= if ($r2 =3D~ /([^:]+)(:(.+))?/) {=0A= $rev2 =3D $1;=0A= $sym2 =3D $3;=0A= }=0A= if ($r2 eq 'text') {=0A= $rev2 =3D $tr2;=0A= $sym2 =3D "";=0A= }=0A= # make sure the revisions a wellformed, for security=0A= # reasons ..=0A= if (!($rev1 =3D~ /^[\d\.]+$/) || !($rev2 =3D~ /^[\d\.]+$/)) {=0A= &fatal("404 Not Found",=0A= "Malformed query \"$ENV{'QUERY_STRING'}\"");=0A= }=0A= #=0A= # rev1 and rev2 are now both numeric revisions.=0A= # Thus we do a DWIM here and swap them if rev1 is after rev2.=0A= # XXX should we warn about the fact that we do this?=0A= if (&revcmp($rev1,$rev2) > 0) {=0A= my ($tmp1, $tmp2) =3D ($rev1, $sym1);=0A= ($rev1, $sym1) =3D ($rev2, $sym2);=0A= ($rev2, $sym2) =3D ($tmp1, $tmp2);=0A= }=0A= my $human_readable =3D 0;=0A= if ($f eq 'c') {=0A= @difftype =3D qw{-c};=0A= $diffname =3D "Context diff";=0A= }=0A= elsif ($f eq 's') {=0A= @difftype =3D qw{--side-by-side --width=3D164};=0A= $diffname =3D "Side by Side";=0A= }=0A= elsif ($f eq 'H') {=0A= $human_readable =3D 1;=0A= @difftype =3D qw{--unified=3D15};=0A= $diffname =3D "Long Human readable";=0A= }=0A= elsif ($f eq 'h') {=0A= @difftype =3Dqw{-u};=0A= $human_readable =3D 1;=0A= $diffname =3D "Human readable";=0A= }=0A= elsif ($f eq 'u') {=0A= @difftype =3D qw{-u};=0A= $diffname =3D "Unidiff";=0A= }=0A= else {=0A= fatal ("400 Bad arguments", "Diff format $f not understood");=0A= }=0A= =0A= # apply special options=0A= if ($human_readable) {=0A= if ($hr_funout) {=0A= push @difftype, '-p';=0A= }=0A= if ($hr_ignwhite) {=0A= push @difftype, '-w';=0A= }=0A= if ($hr_ignkeysubst) {=0A= push @difftype, '-kk';=0A= }=0A= }=0A= if (! open($fh, "-|")) { # child=0A= open(STDERR, ">&STDOUT"); # Redirect stderr to stdout=0A= exec("rcsdiff",@difftype,"-r$rev1","-r$rev2",$fullname);=0A= }=0A= if ($human_readable) {=0A= http_header();=0A= &human_readable_diff($fh, $rev2);=0A= gzipclose();=0A= exit;=0A= }=0A= else {=0A= http_header("text/plain");=0A= }=0A= #=0A= #=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=0A= #RCS file: /home/ncvs/src/sys/netinet/tcp_output.c,v=0A= #retrieving revision 1.16=0A= #retrieving revision 1.17=0A= #diff -c -r1.16 -r1.17=0A= #*** /home/ncvs/src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 = 1.16=0A= #--- /home/ncvs/src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 = 1.17=0A= #=0A= # Ideas:=0A= # - nuke the stderr output if it's what we expect it to be=0A= # - Add "no differences found" if the diff command supplied no output.=0A= #=0A= #*** src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 1.16=0A= #--- src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 1.17 = RELENG_2_1_0=0A= # (bogus example, but...)=0A= #=0A= if (grep { $_ eq '-u'} @difftype) {=0A= $f1 =3D '---';=0A= $f2 =3D '\+\+\+';=0A= }=0A= else {=0A= $f1 =3D '\*\*\*';=0A= $f2 =3D '---';=0A= }=0A= while (<$fh>) {=0A= if (m|^$f1 $cvsroot|o) {=0A= s|$cvsroot/||o;=0A= if ($sym1) {=0A= chop;=0A= $_ .=3D " $sym1\n";=0A= }=0A= }=0A= elsif (m|^$f2 $cvsroot|o) {=0A= s|$cvsroot/||o;=0A= if ($sym2) {=0A= chop;=0A= $_ .=3D " $sym2\n";=0A= }=0A= }=0A= print $_;=0A= }=0A= close($fh);=0A= }=0A= =0A= ###############################=0A= # Show Logs ..=0A= ###############################=0A= sub getDirLogs($$@) {=0A= my ($cvsroot,$dirname,@otherFiles) =3D @_;=0A= my ($state,$otherFiles,$tag, $file, $date, $branchpoint, $branch, = $log);=0A= my ($rev, $revision, $revwanted, $filename, $head, $author);=0A= =0A= $tag =3D $input{only_with_tag};=0A= =0A= my ($DirName) =3D "$cvsroot/$where";=0A= my (@files, @filetags);=0A= my $fh =3D do {local(*FH);};=0A= =0A= push(@files, &safeglob("$DirName/*,v"));=0A= push(@files, &safeglob("$DirName/Attic/*,v")) if = (!$input{'hideattic'});=0A= foreach $file (@otherFiles) {=0A= push(@files, "$DirName/$file");=0A= }=0A= =0A= # just execute rlog if there are any files=0A= if ($#files < 0) { =0A= return;=0A= }=0A= =0A= if (defined($tag)) {=0A= #can't use -r<tag> as - is allowed in tagnames, but misinterpreated by = rlog..=0A= if (! open($fh, "-|")) {=0A= open(STDERR, "> /dev/null"); # rlog may complain; ignore.=0A= exec("rlog",@files);=0A= }=0A= }=0A= else {=0A= my $kidpid =3D open($fh, "-|");=0A= if (! $kidpid) {=0A= open(STDERR, "> /dev/null"); # rlog may complain; ignore.=0A= exec("rlog","-r",@files);=0A= }=0A= }=0A= $state =3D "start";=0A= while (<$fh>) {=0A= if ($state eq "start") {=0A= #Next file. Initialize file variables=0A= $rev =3D undef;=0A= $revwanted =3D undef;=0A= $branch =3D undef;=0A= $branchpoint =3D undef;=0A= $filename =3D undef;=0A= $log =3D undef;=0A= $revision =3D undef;=0A= $branch =3D undef;=0A= %symrev =3D ();=0A= @filetags =3D ();=0A= #jump to head state=0A= $state =3D "head";=0A= }=0A= print "$state:$_" if ($verbose);=0A= again:=0A= if ($state eq "head") {=0A= #$rcsfile =3D $1 if (/^RCS file: (.+)$/); #not used (yet)=0A= $filename =3D $1 if (/^Working file: (.+)$/);=0A= $head =3D $1 if (/^head: (.+)$/);=0A= $branch =3D $1 if (/^branch: (.+)$/);=0A= }=0A= if ($state eq "head" && /^symbolic names/) {=0A= $state =3D "tags";=0A= ($branch =3D $head) =3D~ s/\.\d+$// if (!defined($branch)); =0A= $branch =3D~ s/(\.?)(\d+)$/${1}0.$2/;=0A= $symrev{MAIN} =3D $branch;=0A= $symrev{HEAD} =3D $branch;=0A= $alltags{MAIN} =3D 1;=0A= $alltags{HEAD} =3D 1;=0A= push (@filetags, "MAIN", "HEAD");=0A= next;=0A= }=0A= if ($state eq "tags" &&=0A= /^\s+(.+):\s+([\d\.]+)\s+$/) {=0A= push (@filetags, $1);=0A= $symrev{$1} =3D $2;=0A= $alltags{$1} =3D 1;=0A= next;=0A= }=0A= if ($state eq "tags" && /^\S/) {=0A= if (defined($tag) && (defined($symrev{$tag}) || $tag eq "HEAD")) {=0A= $revwanted =3D $tag eq "HEAD" ? $symrev{"MAIN"} : $symrev{$tag};=0A= ($branch =3D $revwanted) =3D~ s/\.0\././;=0A= ($branchpoint =3D $branch) =3D~ s/\.?\d+$//;=0A= $revwanted =3D undef if ($revwanted ne $branch);=0A= }=0A= elsif (defined($tag) && $tag ne "HEAD") {=0A= print "Tag not found, skip this file" if ($verbose);=0A= $state =3D "skip";=0A= next;=0A= }=0A= foreach my $tagfound (@filetags) {=0A= $tags{$tagfound} =3D 1;=0A= }=0A= $state =3D "head";=0A= goto again;=0A= }=0A= if ($state eq "head" && /^----------------------------$/) {=0A= $state =3D "log";=0A= $rev =3D undef;=0A= $date =3D undef;=0A= $log =3D "";=0A= # Try to reconstruct the relative filename if RCS spits out a full = path=0A= $filename =3D~ s%^\Q$DirName\E/%%;=0A= next;=0A= }=0A= if ($state eq "log") {=0A= if (/^----------------------------$/=0A= || = /^=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D= =3D=3D=3D=3D=3D/) {=0A= # End of a log entry.=0A= my $revbranch;=0A= ($revbranch =3D $rev) =3D~ s/\.\d+$//;=0A= print "$filename $rev Wanted: $revwanted "=0A= . "Revbranch: $revbranch Branch: $branch "=0A= . "Branchpoint: $branchpoint\n" if ($verbose);=0A= if (!defined($revwanted) && defined($branch)=0A= && $branch eq $revbranch || !defined($tag)) {=0A= print "File revision $rev found for branch $branch\n"=0A= if ($verbose);=0A= $revwanted =3D $rev;=0A= }=0A= if (defined($revwanted) ? $rev eq $revwanted :=0A= defined($branchpoint) ? $rev eq $branchpoint :=0A= 0 && ($rev eq $head)) { # Don't think head is needed here..=0A= print "File info $rev found for $filename\n" if ($verbose);=0A= my @finfo =3D ($rev,$date,$log,$author,$filename);=0A= my ($name);=0A= ($name =3D $filename) =3D~ s%/.*%%;=0A= $fileinfo{$name} =3D [ @finfo ];=0A= $state =3D "done" if (defined($revwanted) && $rev eq $revwanted);=0A= }=0A= $rev =3D undef;=0A= $date =3D undef;=0A= $log =3D "";=0A= }=0A= elsif (!defined($date) && = m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) {=0A= my $yr =3D $1;=0A= # damn 2-digit year routines :-)=0A= if ($yr > 100) {=0A= $yr -=3D 1900;=0A= }=0A= $date =3D &Time::Local::timegm($6,$5,$4,$3,$2 - 1,$yr);=0A= ($author) =3D /author: ([^;]+)/;=0A= $state =3D "log";=0A= $log =3D '';=0A= next;=0A= }=0A= elsif (!defined($rev) && m/^revision (.*)$/) {=0A= $rev =3D $1;=0A= next;=0A= }=0A= else {=0A= $log =3D $log . $_;=0A= }=0A= }=0A= if (/^=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D/) {=0A= $state =3D "start";=0A= next;=0A= }=0A= }=0A= if ($. =3D=3D 0) {=0A= fatal("500 Internal Error", =0A= "Failed to spawn GNU rlog on <em>'".join(", ", = @files)."'</em><p>did you set the <b>\$ENV{PATH}</b> in your = configuration file correctly ?");=0A= }=0A= close($fh);=0A= }=0A= =0A= sub readLog($;$) {=0A= my($fullname,$revision) =3D @_;=0A= my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev);=0A= my $fh =3D do {local(*FH);};=0A= =0A= if (defined($revision)) {=0A= $revision =3D "-r$revision";=0A= }=0A= else {=0A= $revision =3D "";=0A= }=0A= =0A= undef %symrev;=0A= undef %revsym;=0A= undef @allrevisions;=0A= undef %date;=0A= undef %author;=0A= undef %state;=0A= undef %difflines;=0A= undef %log;=0A= =0A= print("Going to rlog '$fullname'\n") if ($verbose);=0A= if (! open($fh, "-|")) { # child=0A= if ($revision ne '') {=0A= exec("rlog",$revision,$fullname);=0A= }=0A= else {=0A= exec("rlog",$fullname);=0A= }=0A= }=0A= while (<$fh>) {=0A= print if ($verbose);=0A= if ($symnames) {=0A= if (/^\s+([^:]+):\s+([\d\.]+)/) {=0A= $symrev{$1} =3D $2;=0A= }=0A= else {=0A= $symnames =3D 0;=0A= }=0A= }=0A= elsif (/^head:\s+([\d\.]+)/) {=0A= $head =3D $1;=0A= }=0A= elsif (/^branch:\s+([\d\.]+)/) {=0A= $curbranch =3D $1;=0A= }=0A= elsif (/^symbolic names/) {=0A= $symnames =3D 1;=0A= }=0A= elsif (/^-----/) {=0A= last;=0A= }=0A= }=0A= ($curbranch =3D $head) =3D~ s/\.\d+$// if (!defined($curbranch));=0A= =0A= # each log entry is of the form:=0A= # ----------------------------=0A= # revision 3.7.1.1=0A= # date: 1995/11/29 22:15:52; author: fenner; state: Exp; lines: +5 -3=0A= # log info=0A= # ----------------------------=0A= logentry:=0A= while (!/^=3D=3D=3D=3D=3D=3D=3D=3D=3D/) {=0A= $_ =3D <$fh>;=0A= last logentry if (!defined($_)); # EOF=0A= print "R:", $_ if ($verbose);=0A= if (/^revision ([\d\.]+)/) {=0A= $rev =3D $1;=0A= unshift(@allrevisions,$rev);=0A= }=0A= elsif (/^=3D=3D=3D=3D=3D=3D=3D=3D/ || = /^----------------------------$/) {=0A= next logentry;=0A= }=0A= else {=0A= # The rlog output is syntactically ambiguous. We must=0A= # have guessed wrong about where the end of the last log=0A= # message was.=0A= # Since this is likely to happen when people put rlog output=0A= # in their commit messages, don't even bother keeping=0A= # these lines since we don't know what revision they go with=0A= # any more.=0A= next logentry;=0A= # &fatal("500 Internal Error","Error parsing RCS output: $_");=0A= }=0A= $_ =3D <$fh>;=0A= print "D:", $_ if ($verbose);=0A= if = (m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);\s+s= tate:\s+(\S+);\s+(lines:\s+([0-9\s+-]+))?|) {=0A= my $yr =3D $1;=0A= # damn 2-digit year routines :-)=0A= if ($yr > 100) {=0A= $yr -=3D 1900;=0A= }=0A= $date{$rev} =3D &Time::Local::timegm($6,$5,$4,$3,$2 - 1,$yr);=0A= $author{$rev} =3D $7;=0A= $state{$rev} =3D $8;=0A= $difflines{$rev} =3D $10;=0A= }=0A= else {=0A= &fatal("500 Internal Error", "Error parsing RCS output: $_");=0A= }=0A= line:=0A= while (<$fh>) {=0A= print "L:", $_ if ($verbose);=0A= next line if (/^branches:\s/);=0A= last line if (/^----------------------------$/ || = /^=3D=3D=3D=3D=3D=3D=3D=3D=3D/);=0A= $log{$rev} .=3D $_;=0A= }=0A= print "E:", $_ if ($verbose);=0A= }=0A= close($fh);=0A= print "Done reading RCS file\n" if ($verbose);=0A= =0A= @revorder =3D reverse sort {revcmp($a,$b)} @allrevisions;=0A= print "Done sorting revisions",join(" ",@revorder),"\n" if ($verbose);=0A= =0A= #=0A= # HEAD is an artificial tag which is simply the highest tag number on = the main=0A= # branch, unless there is a branch tag in the RCS file in which case = it's the=0A= # highest revision on that branch. Find it by looking through = @revorder; it=0A= # is the first commit listed on the appropriate branch.=0A= # This is not neccesary the same revision as marked as head in the RCS = file.=0A= my $headrev =3D $curbranch || "1";=0A= ($symrev{"MAIN"} =3D $headrev) =3D~ s/(\.?)(\d+)$/${1}0.$2/;=0A= revision:=0A= foreach $rev (@revorder) {=0A= if ($rev =3D~ /^(\S*)\.\d+$/ && $headrev eq $1) {=0A= $symrev{"HEAD"} =3D $rev;=0A= last revision;=0A= }=0A= }=0A= ($symrev{"HEAD"} =3D $headrev) =3D~ s/\.\d+$//=0A= if (!defined($symrev{"HEAD"}));=0A= print "Done finding HEAD\n" if ($verbose);=0A= #=0A= # Now that we know all of the revision numbers, we can associate=0A= # absolute revision numbers with all of the symbolic names, and=0A= # pass them to the form so that the same association doesn't have=0A= # to be built then.=0A= #=0A= undef @branchnames;=0A= undef %branchpoint;=0A= undef $sel;=0A= =0A= foreach (reverse sort keys %symrev) {=0A= $rev =3D $symrev{$_};=0A= if ($rev =3D~ /^((.*)\.)0\.(\d+)$/) {=0A= push(@branchnames, $_);=0A= #=0A= # A revision number of A.B.0.D really translates into=0A= # "the highest current revision on branch A.B.D".=0A= #=0A= # If there is no branch A.B.D, then it translates into=0A= # the head A.B .=0A= #=0A= # This reasoning also applies to the main branch A.B,=0A= # with the branch number 0.A, with the exception that=0A= # it has no head to translate to if there is nothing on=0A= # the branch, but I guess this can never happen?=0A= #=0A= # Since some stupid people actually import/check in=0A= # files with version 0.X we assume that the above cannot=0A= # happen, and regard 0.X(.*) as a revision and not a branch.=0A= #=0A= $head =3D defined($2) ? $2 : "";=0A= $branch =3D $3;=0A= $branchrev =3D $head . ($head ne "" ? "." : "") . $branch;=0A= my $regex;=0A= ($regex =3D $branchrev) =3D~ s/\./\\./g;=0A= $rev =3D $head;=0A= =0A= revision:=0A= foreach my $r (@revorder) {=0A= if ($r =3D~ /^${regex}\b/) {=0A= $rev =3D $branchrev;=0A= last revision;=0A= }=0A= }=0A= next if ($rev eq "");=0A= if ($rev ne $head && $head ne "") {=0A= $branchpoint{$head} .=3D ", " if ($branchpoint{$head});=0A= $branchpoint{$head} .=3D $_;=0A= }=0A= }=0A= $revsym{$rev} .=3D ", " if ($revsym{$rev});=0A= $revsym{$rev} .=3D $_;=0A= $sel .=3D "<OPTION VALUE=3D\"${rev}:${_}\">$_\n";=0A= }=0A= print "Done associating revisions with branches\n" if ($verbose);=0A= =0A= my ($onlyonbranch, $onlybranchpoint);=0A= if ($onlyonbranch =3D $input{'only_with_tag'}) {=0A= $onlyonbranch =3D $symrev{$onlyonbranch};=0A= if ($onlyonbranch =3D~ s/\.0\././) {=0A= ($onlybranchpoint =3D $onlyonbranch) =3D~ s/\.\d+$//;=0A= }=0A= else {=0A= $onlybranchpoint =3D $onlyonbranch;=0A= }=0A= if (!defined($onlyonbranch) || $onlybranchpoint eq "") {=0A= fatal("404 Tag not found","Tag $input{'only_with_tag'} not defined");=0A= }=0A= }=0A= =0A= undef @revisions;=0A= =0A= foreach (@allrevisions) {=0A= ($br =3D $_) =3D~ s/\.\d+$//;=0A= ($brp =3D $br) =3D~ s/\.\d+$//;=0A= next if ($onlyonbranch && $br ne $onlyonbranch &&=0A= $_ ne $onlybranchpoint);=0A= unshift(@revisions,$_);=0A= }=0A= =0A= if ($logsort eq "date") {=0A= # Sort the revisions in commit order an secondary sort on revision=0A= # (secondary sort needed for imported sources, or the first main=0A= # revision gets before the same revision on the 1.1.1 branch)=0A= @revdisplayorder =3D sort {$date{$b} <=3D> $date{$a} || -revcmp($a, = $b)} @revisions;=0A= }=0A= elsif ($logsort eq "rev") {=0A= # Sort the revisions in revision order, highest first=0A= @revdisplayorder =3D reverse sort {revcmp($a,$b)} @revisions;=0A= }=0A= else {=0A= # No sorting. Present in the same order as rlog / cvs log=0A= @revdisplayorder =3D @revisions;=0A= }=0A= =0A= }=0A= =0A= sub printLog($;$) {=0A= my ($link, $br, $brp);=0A= ($_,$link) =3D @_;=0A= ($br =3D $_) =3D~ s/\.\d+$//;=0A= ($brp =3D $br) =3D~ s/\.?\d+$//;=0A= my ($isDead, $prev);=0A= =0A= $link =3D 1 if (!defined($link));=0A= $isDead =3D ($state{$_} eq "dead");=0A= =0A= if ($link && !$isDead) {=0A= my ($filename);=0A= ($filename =3D $where) =3D~ s/^.*\///;=0A= my ($fileurl) =3D urlencode($filename);=0A= print "<a NAME=3D\"rev$_\"></a>";=0A= if (defined($revsym{$_})) {=0A= foreach my $sym (split(", ", $revsym{$_})) {=0A= print "<a NAME=3D\"$sym\"></a>";=0A= }=0A= }=0A= if (defined($revsym{$br}) && $revsym{$br} && = !defined($nameprinted{$br})) {=0A= foreach my $sym (split(", ", $revsym{$br})) {=0A= print "<a NAME=3D\"$sym\"></a>";=0A= }=0A= $nameprinted{$br} =3D 1;=0A= }=0A= print "\n Revision ";=0A= &download_link($fileurl, $_, $_,=0A= $defaultViewable ? "text/x-cvsweb-markup" : undef);=0A= if ($defaultViewable) {=0A= print " / ";=0A= &download_link($fileurl, $_, "(download)", $mimetype);=0A= }=0A= if (not $defaultTextPlain) {=0A= print " / ";=0A= &download_link($fileurl, $_, "(as text)", =0A= "text/plain");=0A= }=0A= if (!$defaultViewable) {=0A= print " / ";=0A= &download_link($fileurl, $_, "(view)", "text/x-cvsweb-markup");=0A= }=0A= if ($allow_annotate) {=0A= print " - <a href=3D\"" . $scriptname . "/" . urlencode($where) . = "?annotate=3D$_$barequery\">";=0A= print "annotate</a>";=0A= }=0A= # Plus a select link if enabled, and this version isn't selected=0A= if ($allow_version_select) {=0A= if ((!defined($input{"r1"}) || $input{"r1"} ne $_)) {=0A= print " - <A HREF=3D\"${scriptwhere}?r1=3D$_$barequery" .=0A= "\">[select for diffs]</A>\n";=0A= }=0A= else {=0A= print " - <b>[selected]</b>";=0A= }=0A= }=0A= }=0A= else {=0A= print "Revision <B>$_</B>";=0A= }=0A= if (/^1\.1\.1\.\d+$/) {=0A= print " <i>(vendor branch)</i>";=0A= }=0A= if (defined @mytz) {=0A= my ($est) =3D $mytz[(localtime($date{$_}))[8]];=0A= print ", <i>" . scalar localtime($date{$_}) . " $est</i> (";=0A= } else {=0A= print ", <i>" . scalar gmtime($date{$_}) . " UTC</i> (";=0A= }=0A= print readableTime(time() - $date{$_},1) . " ago)";=0A= print " by ";=0A= print "<i>" . $author{$_} . "</i>\n";=0A= print "<BR>Branch: = <b>",$link?link_tags($revsym{$br}):$revsym{$br},"</b>\n"=0A= if ($revsym{$br});=0A= print "<BR>CVS Tags: = <b>",$link?link_tags($revsym{$_}):$revsym{$_},"</b>"=0A= if ($revsym{$_});=0A= print "<BR>Branch point for: = <b>",$link?link_tags($branchpoint{$_}):$branchpoint{$_},"</b>\n"=0A= if ($branchpoint{$_});=0A= # Find the previous revision=0A= my @prevrev =3D split(/\./, $_);=0A= do {=0A= if (--$prevrev[$#prevrev] <=3D 0) {=0A= # If it was X.Y.Z.1, just make it X.Y=0A= pop(@prevrev);=0A= pop(@prevrev);=0A= }=0A= $prev =3D join(".", @prevrev);=0A= } until (defined($date{$prev}) || $prev eq "");=0A= if ($prev ne "") {=0A= if ($difflines{$_}) {=0A= print "<BR>Changes since <b>$prev: $difflines{$_} lines</b>";=0A= }=0A= }=0A= if ($isDead) {=0A= print "<BR><B><I>FILE REMOVED</I></B>\n";=0A= }=0A= elsif ($link) {=0A= my %diffrev =3D ();=0A= $diffrev{$_} =3D 1;=0A= $diffrev{""} =3D 1;=0A= print "<BR>Diff";=0A= #=0A= # Offer diff to previous revision=0A= if ($prev) {=0A= $diffrev{$prev} =3D 1;=0A= print " to previous <A HREF=3D\"${scriptwhere}.diff?r1=3D$prev";=0A= print "&r2=3D$_" . $barequery . "\">$prev</A>\n";=0A= if (!$hr_default) { # offer a human readable version if not default=0A= print "(<A HREF=3D\"${scriptwhere}.diff?r1=3D$prev";=0A= print "&r2=3D$_" . $barequery . "&f=3Dh\">colored</A>)\n";=0A= }=0A= }=0A= #=0A= # Plus, if it's on a branch, and it's not a vendor branch,=0A= # offer a diff with the branch point.=0A= if ($revsym{$brp} && !/^1\.1\.1\.\d+$/ && !defined($diffrev{$brp})) = {=0A= print " to branchpoint <A HREF=3D\"${scriptwhere}.diff?r1=3D$brp";=0A= print "&r2=3D$_" . $barequery . "\">$brp</A>\n";=0A= if (!$hr_default) { # offer a human readable version if not default=0A= print "(<A HREF=3D\"${scriptwhere}.diff?r1=3D$brp";=0A= print "&r2=3D$_" . $barequery . "&f=3Dh\">colored</A>)\n";=0A= }=0A= }=0A= #=0A= # Plus, if it's on a branch, and it's not a vendor branch,=0A= # offer to diff with the next revision of the higher branch.=0A= # (e.g. change gets committed and then brought=0A= # over to -stable)=0A= if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) {=0A= my ($i,$nextmain);=0A= for ($i =3D 0; $i < $#revorder && $revorder[$i] ne $_; $i++){}=0A= my (@tmp2) =3D split(/\./, $_);=0A= for ($nextmain =3D ""; $i > 0; $i--) {=0A= my ($next) =3D $revorder[$i-1];=0A= my (@tmp1) =3D split(/\./, $next);=0A= if ($#tmp1 < $#tmp2) {=0A= $nextmain =3D $next;=0A= last;=0A= }=0A= # Only the highest version on a branch should have=0A= # a diff for the "next main".=0A= last if ($#tmp1 =3D=3D $#tmp2 && join(".",@tmp1[0..$#tmp1-1])=0A= eq join(".",@tmp2[0..$#tmp1-1]));=0A= }=0A= if (!defined($diffrev{$nextmain})) {=0A= $diffrev{$nextmain} =3D 1;=0A= print " next main <A HREF=3D\"${scriptwhere}.diff?r1=3D$nextmain";=0A= print "&r2=3D$_" . $barequery .=0A= "\">$nextmain</A>\n";=0A= if (!$hr_default) { # offer a human readable version if not default=0A= print "(<A HREF=3D\"${scriptwhere}.diff?r1=3D$nextmain";=0A= print "&r2=3D$_" . $barequery .=0A= "&f=3Dh\">colored</A>)\n";=0A= }=0A= }=0A= }=0A= # Plus if user has selected only r1, then present a link=0A= # to make a diff to that revision=0A= if (defined($input{"r1"}) && !defined($diffrev{$input{"r1"}})) {=0A= $diffrev{$input{"r1"}} =3D 1;=0A= print " to selected <A HREF=3D\"${scriptwhere}.diff?"=0A= . "r1=3D$input{'r1'}&r2=3D$_" . $barequery=0A= . "\">$input{'r1'}</A>\n";=0A= if (!$hr_default) { # offer a human readable version if not default=0A= print "(<A HREF=3D\"${scriptwhere}.diff?r1=3D$input{'r1'}";=0A= print "&r2=3D$_" . $barequery .=0A= "&f=3Dh\">colored</A>)\n";=0A= =0A= }=0A= }=0A= }=0A= print "<PRE>\n";=0A= print &htmlify($log{$_});=0A= print "</PRE>\n";=0A= }=0A= =0A= sub doLog($) {=0A= my($fullname) =3D @_;=0A= my ($diffrev, $upwhere, $filename, $backurl);=0A= =0A= readLog($fullname);=0A= =0A= html_header("CVS log for $where");=0A= ($upwhere =3D $where) =3D~ s|(Attic/)?[^/]+$||;=0A= ($filename =3D $where) =3D~ s|^.*/||;=0A= $backurl =3D $scriptname . "/" . urlencode($upwhere) . $query;=0A= print &link($backicon, "$backurl#$filename"),=0A= " <b>Up to ", &clickablePath($upwhere, 1), "</b><p>\n";=0A= print "<A HREF=3D\"#diff\">Request diff between arbitrary = revisions</A>\n";=0A= print "<HR NOSHADE>\n";=0A= if ($curbranch) {=0A= print "Default branch: ";=0A= print ($revsym{$curbranch} || $curbranch);=0A= }=0A= else {=0A= print "No default branch";=0A= }=0A= print "<BR>\n";=0A= if ($input{only_with_tag}) {=0A= print "Current tag: $input{only_with_tag}<BR>\n";=0A= }=0A= =0A= undef %nameprinted;=0A= =0A= for (my $i =3D 0; $i <=3D $#revdisplayorder; $i++) {=0A= print "<HR size=3D1 NOSHADE>";=0A= printLog($revdisplayorder[$i]);=0A= }=0A= =0A= print "<HR NOSHADE>";=0A= print "<A NAME=3Ddiff>\n";=0A= print "This form allows you to request diff's between any two\n";=0A= print "revisions of a file. You may select a symbolic revision\n";=0A= print "name using the selection box or you may type in a numeric\n";=0A= print "name using the type-in text box.\n";=0A= print "</A><P>\n";=0A= print "<FORM METHOD=3D\"GET\" ACTION=3D\"${scriptwhere}.diff\" = NAME=3D\"diff_select\">\n";=0A= foreach (@stickyvars) {=0A= print "<INPUT TYPE=3DHIDDEN NAME=3D\"$_\" VALUE=3D\"$input{$_}\">\n"=0A= if (defined($input{$_})=0A= && ((!defined($DEFAULTVALUE{$_})=0A= || $input{$_} ne $DEFAULTVALUE{$_})=0A= && $input{$_} ne ""));=0A= }=0A= print "Diffs between \n";=0A= print "<SELECT NAME=3D\"r1\">\n";=0A= print "<OPTION VALUE=3D\"text\" SELECTED>Use Text Field\n";=0A= print $sel;=0A= print "</SELECT>\n";=0A= $diffrev =3D $revdisplayorder[$#revdisplayorder];=0A= $diffrev =3D $input{"r1"} if (defined($input{"r1"}));=0A= print "<INPUT TYPE=3D\"TEXT\" SIZE=3D\"$inputTextSize\" NAME=3D\"tr1\" = VALUE=3D\"$diffrev\" = onChange=3D'document.diff_select.r1.selectedIndex=3D0'>\n";=0A= print " and \n";=0A= print "<SELECT NAME=3D\"r2\">\n";=0A= print "<OPTION VALUE=3D\"text\" SELECTED>Use Text Field\n";=0A= print $sel;=0A= print "</SELECT>\n";=0A= $diffrev =3D $revdisplayorder[0];=0A= $diffrev =3D $input{"r2"} if (defined($input{"r2"}));=0A= print "<INPUT TYPE=3D\"TEXT\" SIZE=3D\"$inputTextSize\" NAME=3D\"tr2\" = VALUE=3D\"$diffrev\" = onChange=3D'document.diff_select.r2.selectedIndex=3D0'>\n";=0A= print "<BR>Type of Diff should be a ";=0A= printDiffSelect(0);=0A= print "<INPUT TYPE=3DSUBMIT VALUE=3D\" Get Diffs \">\n";=0A= print "</FORM>\n";=0A= print "<HR noshade>\n";=0A= if (@branchnames) {=0A= print "<A name=3Dbranch></A>\n";=0A= print "<FORM METHOD=3D\"GET\" ACTION=3D\"$scriptwhere\">\n";=0A= foreach (@stickyvars) {=0A= next if ($_ eq "only_with_tag");=0A= next if ($_ eq "logsort");=0A= print "<INPUT TYPE=3DHIDDEN NAME=3D\"$_\" VALUE=3D\"$input{$_}\">\n"=0A= if (defined($input{$_})=0A= && (!defined($DEFAULTVALUE{$_})=0A= || $input{$_} ne $DEFAULTVALUE{$_})=0A= && $input{$_} ne "");=0A= }=0A= print "View only Branch: \n";=0A= print "<SELECT NAME=3D\"only_with_tag\"";=0A= print " onchange=3D\"submit()\"" if ($use_java_script);=0A= print ">\n";=0A= print "<OPTION VALUE=3D\"\"";=0A= print " SELECTED" if (defined($input{"only_with_tag"}) &&=0A= $input{"only_with_tag"} eq "");=0A= print ">Show all branches\n";=0A= foreach (reverse sort @branchnames) {=0A= print "<OPTION";=0A= print " SELECTED" if (defined($input{"only_with_tag"})=0A= && $input{"only_with_tag"} eq $_);=0A= print ">${_}\n";=0A= }=0A= print "</SELECT>\n";=0A= print "<INPUT TYPE=3DSUBMIT VALUE=3D\" View Branch \">\n";=0A= print "</FORM>\n";=0A= }=0A= print "<A name=3Dlogsort></A>\n";=0A= print "<FORM METHOD=3D\"GET\" ACTION=3D\"$scriptwhere\">\n";=0A= foreach (@stickyvars) {=0A= next if ($_ eq "only_with_tag");=0A= next if ($_ eq "logsort");=0A= print "<INPUT TYPE=3DHIDDEN NAME=3D\"$_\" VALUE=3D\"$input{$_}\">\n"=0A= if (defined($input{$_})=0A= && (!defined($DEFAULTVALUE{$_})=0A= || $input{$_} ne $DEFAULTVALUE{$_})=0A= && $input{$_} ne "");=0A= }=0A= print "Sort log by: \n";=0A= print "<SELECT NAME=3D\"logsort\"";=0A= print " onchange=3D\"submit()\"" if ($use_java_script);=0A= print ">\n";=0A= print "<OPTION VALUE=3Dcvs",$logsort eq "cvs" ? " SELECTED" : "", ">Not = sorted";=0A= print "<OPTION VALUE=3Ddate",$logsort eq "date" ? " SELECTED" : "", = ">Commit date";=0A= print "<OPTION VALUE=3Drev",$logsort eq "rev" ? " SELECTED" : "", = ">Revision";=0A= print "</SELECT>\n";=0A= print "<INPUT TYPE=3DSUBMIT VALUE=3D\" Sort \">\n";=0A= print "</FORM>\n";=0A= print &html_footer;=0A= print "</BODY></HTML>\n";=0A= }=0A= =0A= sub flush_diff_rows ($$$$)=0A= {=0A= my $j;=0A= my ($leftColRef,$rightColRef,$leftRow,$rightRow) =3D @_;=0A= =0A= if (!defined($state)) {=0A= return;=0A= }=0A= =0A= if ($state eq "PreChangeRemove") { # we just got = remove-lines before=0A= for ($j =3D 0 ; $j < $leftRow; $j++) {=0A= print "<tr><td = bgcolor=3D\"$diffcolorRemove\">@$leftColRef[$j]</td>";=0A= print "<td bgcolor=3D\"$diffcolorEmpty\"> </td></tr>\n";=0A= }=0A= }=0A= elsif ($state eq "PreChange") { # state eq "PreChange"=0A= # we got removes with subsequent adds=0A= for ($j =3D 0; $j < $leftRow || $j < $rightRow ; $j++) { # dump = out both cols=0A= print "<tr>";=0A= if ($j < $leftRow) {=0A= print "<td bgcolor=3D\"$diffcolorChange\">@$leftColRef[$j]</td>";=0A= }=0A= else {=0A= print "<td bgcolor=3D\"$diffcolorDarkChange\"> </td>";=0A= }=0A= if ($j < $rightRow) {=0A= print "<td = bgcolor=3D\"$diffcolorChange\">@$rightColRef[$j]</td>";=0A= }=0A= else {=0A= print "<td bgcolor=3D\"$diffcolorDarkChange\"> </td>";=0A= }=0A= print "</tr>\n";=0A= }=0A= }=0A= }=0A= =0A= ##=0A= # Function to generate Human readable diff-files=0A= # human_readable_diff(String revision_to_return_to);=0A= ##=0A= sub human_readable_diff($){=0A= my ($i,$difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd);=0A= my ($fh, $rev) =3D @_;=0A= my ($date1, $date2, $r1d, $r2d, $r1r, $r2r, $rev1, $rev2, $sym1, = $sym2);=0A= my (@rightCol, @leftCol);=0A= =0A= ($where_nd =3D $where) =3D~ s/.diff$//;=0A= ($filename =3D $where_nd) =3D~ s/^.*\///;=0A= ($pathname =3D $where_nd) =3D~ s/(Attic\/)?[^\/]*$//;=0A= ($scriptwhere_nd =3D $scriptwhere) =3D~ s/.diff$//;=0A= =0A= navigateHeader ($scriptwhere_nd, $pathname, $filename, $rev, "diff");=0A= =0A= # Read header to pick up read revision and date, if possible=0A= while (<$fh>) {=0A= ($r1d,$r1r) =3D /\t(.*)\t(.*)$/ if (/^--- /);=0A= ($r2d,$r2r) =3D /\t(.*)\t(.*)$/ if (/^\+\+\+ /);=0A= last if (/^\+\+\+ /);=0A= }=0A= if (defined($r1r) && $r1r =3D~ /^(\d+\.)+\d+$/) {=0A= $rev1 =3D $r1r;=0A= $date1 =3D $r1d;=0A= }=0A= if (defined($r2r) && $r2r =3D~ /^(\d+\.)+\d+$/) {=0A= $rev2 =3D $r2r;=0A= $date2 =3D $r2d;=0A= }=0A= =0A= print "<h3 align=3Dcenter>Diff for /$where_nd between version $rev1 = and $rev2</h3>\n";=0A= =0A= print "<table border=3D0 cellspacing=3D0 cellpadding=3D0 = width=3D\"100%\">\n";=0A= print "<tr bgcolor=3D\"#ffffff\">\n";=0A= print "<th width=3D\"50%\" valign=3DTOP>";=0A= print "version $rev1";=0A= print ", $date1" if (defined($date1));=0A= print "<br>Tag: $sym1\n" if ($sym1);=0A= print "</th>\n";=0A= print "<th width=3D\"50%\" valign=3DTOP>";=0A= print "version $rev2";=0A= print ", $date2" if (defined($date2));=0A= print "<br>Tag: $sym2\n" if ($sym1);=0A= print "</th>\n";=0A= =0A= my $fs =3D "<font face=3D\"$difffontface\" size=3D\"$difffontsize\">";=0A= my $fe =3D "</font>";=0A= =0A= my $leftRow =3D 0;=0A= my $rightRow =3D 0;=0A= my ($oldline, $newline, $funname, $diffcode, $rest);=0A= =0A= # Process diff text=0A= # The diffrows are could make excellent use of=0A= # cascading style sheets because we've to set the=0A= # font and color for each row. anyone ...?=0A= ####=0A= while (<$fh>) {=0A= $difftxt =3D $_;=0A= =0A= if ($difftxt =3D~ /^@@/) {=0A= ($oldline,$newline,$funname) =3D $difftxt =3D~ /@@ = \-([0-9]+).*\+([0-9]+).*@@(.*)/;=0A= print "<tr bgcolor=3D\"$diffcolorHeading\"><td = width=3D\"50%\">";=0A= print "<table width=3D\"100%\" border=3D1 = cellpadding=3D5><tr><td><b>Line $oldline</b>";=0A= print " <font size=3D-1>$funname</font></td></tr></table>";=0A= print "</td><td width=3D\"50%\">";=0A= print "<table width=3D\"100%\" border=3D1 = cellpadding=3D5><tr><td><b>Line $newline</b>";=0A= print " <font size=3D-1>$funname</font></td></tr></table>";=0A= print "</td>\n";=0A= $state =3D "dump";=0A= $leftRow =3D 0;=0A= $rightRow =3D 0;=0A= }=0A= else {=0A= ($diffcode,$rest) =3D $difftxt =3D~ /^([-+ ])(.*)/;=0A= $_ =3D spacedHtmlText ($rest);=0A= =0A= # Add fontface, size=0A= $_ =3D "$fs $_$fe";=0A= =0A= #########=0A= # little state machine to parse unified-diff output (Hen, = zeller@think.de)=0A= # in order to get some nice 'ediff'-mode output=0A= # states:=0A= # "dump" - just dump the value=0A= # "PreChangeRemove" - we began with '-' .. so this could be the = start of a 'change' area or just remove=0A= # "PreChange" - okey, we got several '-' lines and moved to = '+' lines -> this is a change block=0A= ##########=0A= =0A= if ($diffcode eq '+') {=0A= if ($state eq "dump") { # 'change' never begins with '+': just = dump out value=0A= print "<tr><td bgcolor=3D\"$diffcolorEmpty\"> </td><td = bgcolor=3D\"$diffcolorAdd\">$_</td></tr>\n";=0A= }=0A= else { # we got minus before=0A= $state =3D "PreChange";=0A= $rightCol[$rightRow++] =3D $_;=0A= }=0A= } =0A= elsif ($diffcode eq '-') {=0A= $state =3D "PreChangeRemove";=0A= $leftCol[$leftRow++] =3D $_;=0A= }=0A= else { # empty diffcode=0A= flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;=0A= print "<tr><td>$_</td><td>$_</td></tr>\n";=0A= $state =3D "dump";=0A= $leftRow =3D 0;=0A= $rightRow =3D 0;=0A= }=0A= }=0A= }=0A= flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;=0A= =0A= # state is empty if we didn't have any change=0A= if (!$state) {=0A= print "<tr><td colspan=3D2> </td></tr>";=0A= print "<tr bgcolor=3D\"$diffcolorEmpty\" >";=0A= print "<td colspan=3D2 align=3Dcenter><b>- No viewable Change = -</b></td></tr>";=0A= }=0A= print "</table>";=0A= close($fh);=0A= =0A= print "<br><hr noshade width=3D\"100%\">\n";=0A= =0A= print "<table border=3D0>";=0A= =0A= print "<tr><td>";=0A= # print legend=0A= print "<table border=3D1><tr><td>";=0A= print "Legend:<br><table border=3D0 cellspacing=3D0 = cellpadding=3D1>\n";=0A= print "<tr><td align=3Dcenter bgcolor=3D\"$diffcolorRemove\">Removed = from v.$rev1</td><td bgcolor=3D\"$diffcolorEmpty\"> </td></tr>";=0A= print "<tr bgcolor=3D\"$diffcolorChange\"><td align=3Dcenter = colspan=3D2>changed lines</td></tr>";=0A= print "<tr><td bgcolor=3D\"$diffcolorEmpty\"> </td><td = align=3Dcenter bgcolor=3D\"$diffcolorAdd\">Added in v.$rev2</td></tr>";=0A= print "</table></td></tr></table>\n";=0A= =0A= print "<td>";=0A= # Print format selector=0A= print "<FORM METHOD=3D\"GET\" ACTION=3D\"${scriptwhere}\">\n";=0A= foreach my $var (keys %input) {=0A= next if ($var eq "f");=0A= next if (defined($DEFAULTVALUE{$var})=0A= && $DEFAULTVALUE{$var} eq $input{$var});=0A= print "<INPUT TYPE=3DHIDDEN NAME=3D\"",urlencode($var),"\" = VALUE=3D\"",=0A= urlencode($input{$var}),"\">\n";=0A= }=0A= printDiffSelect($use_java_script);=0A= print "<INPUT TYPE=3DSUBMIT VALUE=3D\"Show\">\n";=0A= print "</FORM>\n";=0A= print "</td>";=0A= =0A= print "</tr></table>";=0A= }=0A= =0A= sub navigateHeader ($$$$$) {=0A= my ($swhere,$path,$filename,$rev,$title) =3D @_;=0A= $swhere =3D "" if ($swhere eq $scriptwhere);=0A= $swhere =3D urlencode($filename) if ($swhere eq "");=0A= print "<\!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 = Transitional//EN\">";=0A= print "<HTML>\n<HEAD>\n";=0A= print '<!-- hennerik CVSweb $Revision: 1.112 $ -->';=0A= print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";=0A= print "<BODY BGCOLOR=3D\"$backcolor\">\n";=0A= print "<table width=3D\"100%\" border=3D0 cellspacing=3D0 = cellpadding=3D1 bgcolor=3D\"$navigationHeaderColor\">";=0A= print "<tr valign=3Dbottom><td>";=0A= print "<a href=3D\"$swhere$query#rev$rev\">$backicon";=0A= print "</a> <b>Return to ", = &link("$filename","$swhere$query#rev$rev")," CVS log";=0A= print "</b> $fileicon</td>";=0A= =0A= print "<td align=3Dright>$diricon <b>Up to ", &clickablePath($path, = 1), "</b></td>";=0A= print "</tr></table>";=0A= }=0A= =0A= sub plural_write ($$)=0A= {=0A= my ($num,$text) =3D @_;=0A= if ($num !=3D 1) {=0A= $text =3D $text . "s";=0A= }=0A= if ($num > 0) {=0A= return $num . " " . $text;=0A= }=0A= else {=0A= return "";=0A= }=0A= }=0A= =0A= ##=0A= # print readable timestamp in terms of=0A= # '..time ago'=0A= # H. Zeller <zeller@think.de>=0A= ##=0A= sub readableTime($$) {=0A= my ($i, $break, $retval);=0A= my ($secs,$long) =3D @_;=0A= =0A= # this function works correct for time >=3D 2 seconds=0A= if ($secs < 2) {=0A= return "very little time";=0A= }=0A= =0A= my %desc =3D (1 , 'second',=0A= 60, 'minute',=0A= 3600, 'hour',=0A= 86400, 'day',=0A= 604800, 'week',=0A= 2628000, 'month',=0A= 31536000, 'year');=0A= my @breaks =3D sort {$a <=3D> $b} keys %desc;=0A= $i =3D 0;=0A= while ($i <=3D $#breaks && $secs >=3D 2 * $breaks[$i]) { =0A= $i++;=0A= }=0A= $i--;=0A= $break =3D $breaks[$i];=0A= $retval =3D plural_write(int ($secs / $break), $desc{"$break"});=0A= =0A= if ($long =3D=3D 1 && $i > 0) {=0A= my $rest =3D $secs % $break;=0A= $i--;=0A= $break =3D $breaks[$i];=0A= my $resttime =3D plural_write(int ($rest / $break), =0A= $desc{"$break"});=0A= if ($resttime) {=0A= $retval =3D $retval . ", " . $resttime;=0A= }=0A= }=0A= =0A= return $retval;=0A= }=0A= =0A= ##=0A= # clickablePath(String pathname, boolean last_item_clickable)=0A= #=0A= # returns a html-ified path whereas each directory is a link for=0A= # faster navigation. last_item_clickable controls whether the=0A= # basename (last directory/file) is a link as well=0A= ##=0A= sub clickablePath($$) {=0A= my ($pathname,$clickLast) =3D @_; =0A= my $retval =3D '';=0A= =0A= if ($pathname eq '/') {=0A= # this should never happen - chooseCVSRoot() is=0A= # intended to do this=0A= $retval =3D "[$cvstree]";=0A= }=0A= else {=0A= $retval =3D $retval . " <a = href=3D\"${scriptname}/${query}#dirlist\">[$cvstree]</a>";=0A= my $wherepath =3D '';=0A= my ($lastslash) =3D $pathname =3D~ m|/$|;=0A= foreach (split(/\//, $pathname)) {=0A= $retval =3D $retval . " / ";=0A= $wherepath =3D $wherepath . '/' . $_;=0A= my ($last) =3D "$wherepath/" eq "/$pathname"=0A= || "$wherepath" eq "/$pathname";=0A= if ($clickLast || !$last) {=0A= $retval =3D $retval . "<a href=3D\"${scriptname}"=0A= . urlencode($wherepath)=0A= . (!$last || $lastslash ? '/' : '')=0A= . ${query}=0A= . (!$last || $lastslash ? "#dirlist" : "")=0A= . "\">$_</a>";=0A= }=0A= else { # do not make a link to the current dir=0A= $retval =3D $retval . $_;=0A= }=0A= }=0A= }=0A= return $retval;=0A= }=0A= =0A= sub chooseCVSRoot() {=0A= my @foo;=0A= foreach (sort keys %CVSROOT) {=0A= if (-d $CVSROOT{$_}) {=0A= push(@foo, $_);=0A= }=0A= }=0A= if (@foo > 1) {=0A= my ($k);=0A= print "<form method=3D\"GET\" action=3D\"${scriptwhere}\">\n";=0A= foreach $k (keys %input) {=0A= print "<input type=3Dhidden NAME=3D$k VALUE=3D$input{$k}>\n" =0A= if ($input{$k}) && ($k ne "cvsroot");=0A= }=0A= # Form-Elements look wierd in Netscape if the background=0A= # isn't gray and the form elements are not placed=0A= # within a table ...=0A= print "<table><tr>";=0A= print "<td>CVS Root:</td>";=0A= print "<td>\n<select name=3D\"cvsroot\"";=0A= print " onchange=3D\"submit()\"" if ($use_java_script);=0A= print ">\n";=0A= foreach $k (@foo) {=0A= print "<option value=3D\"$k\"";=0A= print " selected" if ("$k" eq "$cvstree");=0A= print ">" . ($CVSROOTdescr{"$k"} ? $CVSROOTdescr{"$k"} :=0A= $k). "</option>\n";=0A= }=0A= print "</select>\n</td>";=0A= print "<td><input type=3Dsubmit value=3D\"Go\"></td>";=0A= print "</tr></table></form>";=0A= }=0A= else {=0A= # no choice ..=0A= print "CVS Root: <b>[$cvstree]</b>";=0A= }=0A= }=0A= =0A= sub chooseMirror() {=0A= my ($mirror,$moremirrors);=0A= $moremirrors =3D 0;=0A= # This code comes from the original BSD-cvsweb=0A= # and may not be useful for your site; If you don't=0A= # set %MIRRORS this won't show up, anyway=0A= #=0A= # Should perhaps exlude the current site somehow.. =0A= if (keys %MIRRORS) {=0A= print "\nThis cvsweb is mirrored in:\n";=0A= foreach $mirror (keys %MIRRORS) {=0A= print ", " if ($moremirrors);=0A= print qq(<a href=3D"$MIRRORS{$mirror}">$mirror</A>\n);=0A= $moremirrors =3D 1;=0A= }=0A= print "<p>\n";=0A= }=0A= }=0A= =0A= sub fileSortCmp() {=0A= my ($comp) =3D 0;=0A= my ($c,$d,$af,$bf);=0A= =0A= ($af =3D $a) =3D~ s/,v$//;=0A= ($bf =3D $b) =3D~ s/,v$//;=0A= my ($rev1,$date1,$log1,$author1,$filename1) =3D @{$fileinfo{$af}}=0A= if (defined($fileinfo{$af}));=0A= my ($rev2,$date2,$log2,$author2,$filename2) =3D @{$fileinfo{$bf}}=0A= if (defined($fileinfo{$bf}));=0A= =0A= if (defined($filename1) && defined($filename2) && $af eq $filename1 = && $bf eq $filename2) {=0A= # Two files=0A= $comp =3D -revcmp($rev1, $rev2) if ($byrev && $rev1 && $rev2);=0A= $comp =3D ($date2 <=3D> $date1) if ($bydate && $date1 && $date2);=0A= $comp =3D ($log1 cmp $log2) if ($bylog && $log1 && $log2);=0A= $comp =3D ($author1 cmp $author2) if ($byauthor && $author1 && = $author2);=0A= }=0A= if ($comp =3D=3D 0) {=0A= # Directories first, then sorted on name if no other sort critera=0A= # available.=0A= my $ad =3D ((-d "$fullname/$a")?"D":"F");=0A= my $bd =3D ((-d "$fullname/$b")?"D":"F");=0A= ($c=3D$a) =3D~ s|.*/||;=0A= ($d=3D$b) =3D~ s|.*/||;=0A= $comp =3D ("$ad$c" cmp "$bd$d");=0A= }=0A= return $comp;=0A= }=0A= =0A= # make A url for downloading=0A= sub download_url($$$) {=0A= my ($url,$revision,$mimetype) =3D @_;=0A= =0A= $revision =3D~ s/\.0\././;=0A= =0A= if (defined($checkout_magic)=0A= && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) {=0A= my ($path);=0A= ($path =3D $where) =3D~ s|/[^/]*$|/|;=0A= $url =3D "$scriptname/$checkoutMagic/${path}$url";=0A= }=0A= $url .=3D "?rev=3D$revision";=0A= $url .=3D "&content-type=3D$mimetype" if (defined($mimetype));=0A= =0A= return $url;=0A= }=0A= =0A= # Presents a link to download the =0A= # selected revision=0A= sub download_link($$$$) {=0A= my ($url,$revision,$textlink,$mimetype) =3D @_;=0A= my ($fullurl) =3D download_url($url,$revision,$mimetype);=0A= my ($paren) =3D $textlink =3D~ /^\(/;=0A= $textlink =3D~ s/^\(// if ($paren);=0A= $textlink =3D~ s/\)$// if ($paren);=0A= print "(" if ($paren);=0A= print "<A HREF=3D\"$fullurl";=0A= print $barequery;=0A= print "\"";=0A= if ($open_extern_window && (!defined($mimetype) || $mimetype ne = "text/x-cvsweb-markup")) {=0A= print " target=3D\"cvs_checkout\"";=0A= # we should have=0A= # 'if (document.cvswin=3D=3Dnull) document.cvswin=3Dwindow.open(...'=0A= # in order to allow the user to resize the window; otherwise=0A= # the user may resize the window, but on next checkout - zap -=0A= # its original (configured s. cvsweb.conf) size is back again=0A= # .. annoying (if $extern_window_(width|height) is defined)=0A= # but this if (..) solution is far from perfect=0A= # what we need to do as well is=0A= # 1) save cvswin in an invisible frame that always exists=0A= # (document.cvswin will be void on next load)=0A= # 2) on close of the cvs_checkout - window set the cvswin=0A= # variable to 'null' again - so that it will be=0A= # reopenend with the configured size=0A= # anyone a JavaScript programmer ?=0A= # .. so here without if (..):=0A= # currently, the best way is to comment out the size parameters=0A= # ($extern_window...) in cvsweb.conf.=0A= if ($use_java_script) {=0A= print " onClick=3D\"window.open('$fullurl','cvs_checkout',";=0A= print "'resizeable,scrollbars";=0A= print ",status,toolbar" if (defined($mimetype)=0A= && $mimetype eq "text/html");=0A= print ",width=3D$extern_window_width" if = (defined($extern_window_width));=0A= print ",height=3D$extern_window_height" if = (defined($extern_window_height));=0A= print"');\"";=0A= }=0A= }=0A= print "><b>$textlink</b></A>";=0A= print ")" if ($paren);=0A= }=0A= =0A= # Returns a Query string with the=0A= # specified parameter toggled=0A= sub toggleQuery($$) {=0A= my ($toggle,$value) =3D @_;=0A= my ($newquery,$var);=0A= my (%vars);=0A= %vars =3D %input;=0A= if (defined($value)) {=0A= $vars{$toggle} =3D $value;=0A= }=0A= else {=0A= $vars{$toggle} =3D $vars{$toggle} ? 0 : 1;=0A= }=0A= # Build a new query of non-default paramenters=0A= $newquery =3D "";=0A= foreach $var (@stickyvars) {=0A= my ($value) =3D defined($vars{$var}) ? $vars{$var} : "";=0A= my ($default) =3D defined($DEFAULTVALUE{$var}) ? $DEFAULTVALUE{$var} : = "";=0A= if ($value ne $default) {=0A= $newquery .=3D "&" if ($newquery ne "");=0A= $newquery .=3D urlencode($var) . "=3D" . urlencode($value);=0A= }=0A= }=0A= if ($newquery) {=0A= return '?' . $newquery;=0A= }=0A= return "";=0A= }=0A= =0A= sub urlencode($) {=0A= my ($in) =3D @_;=0A= my ($out);=0A= ($out =3D $in) =3D~ s/([\000-+{-\377])/sprintf("%%%02x", ord($1))/ge;=0A= return $out;=0A= }=0A= =0A= sub http_header(;$) {=0A= my $content_type =3D shift || "text/html";=0A= my $is_mod_perl =3D defined($ENV{'MOD_PERL'});=0A= if (defined($moddate)) {=0A= if ($is_mod_perl) {=0A= Apache->request->header_out("Last-Modified" =3D> scalar = gmtime($moddate) . " GMT");=0A= }=0A= else {=0A= print "Last-Modified: " . scalar gmtime($moddate) . " GMT\r\n";=0A= }=0A= }=0A= if ($is_mod_perl) {=0A= Apache->request->content_type($content_type);=0A= }=0A= else {=0A= print "Content-type: $content_type\r\n";=0A= }=0A= if ($allow_compress && $maycompress) {=0A= if ($has_zlib || (defined($GZIPBIN) && open(GZIP, "|$GZIPBIN -1 -c"))) {=0A= if ($is_mod_perl) {=0A= Apache->request->content_encoding("x-gzip");=0A= Apache->request->header_out(Vary =3D> "Accept-Encoding");=0A= Apache->request->send_http_header;=0A= }=0A= else {=0A= print "Content-encoding: x-gzip\r\n";=0A= print "Vary: Accept-Encoding\r\n"; #RFC 2068, 14.43=0A= print "\r\n"; # Close headers=0A= }=0A= $| =3D 1; $| =3D 0; # Flush header output=0A= if ($has_zlib) {=0A= tie *GZIP, __PACKAGE__, \*STDOUT;=0A= }=0A= select(GZIP);=0A= $gzip_open =3D 1;=0A= # print "<!-- gzipped -->" if ($content_type eq "text/html");=0A= }=0A= else {=0A= if ($is_mod_perl) {=0A= Apache->request->send_http_header;=0A= }=0A= else {=0A= print "\r\n"; # Close headers=0A= }=0A= print "<font size=3D-1>Unable to find gzip binary in the \$PATH to = compress output</font><br>";=0A= }=0A= }=0A= else {=0A= if ($is_mod_perl) {=0A= Apache->request->send_http_header;=0A= }=0A= else {=0A= print "\r\n"; # Close headers=0A= }=0A= }=0A= }=0A= =0A= sub html_header($) {=0A= my ($title) =3D @_;=0A= my $version =3D '$Revision: 1.112 $';=0A= http_header();=0A= print <<EOH;=0A= <!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"=0A= "http://www.w3.org/TR/REC-html40/loose.dtd">=0A= <html>=0A= <title>$title</title>=0A= <!-- hennerik CVSweb $version -->=0A= </head>=0A= $body_tag=0A= $logo <h1 align=3D"center">$title</h1>=0A= EOH=0A= }=0A= =0A= sub html_footer() {=0A= return "<hr noshade><address>$address</address></body></html>\n";=0A= }=0A= =0A= sub link_tags($)=0A= {=0A= my ($tags) =3D @_;=0A= my ($ret) =3D "";=0A= my ($fileurl,$filename);=0A= =0A= ($filename =3D $where) =3D~ s/^.*\///;=0A= $fileurl =3D urlencode($filename);=0A= =0A= foreach my $sym (split(", ", $tags)) {=0A= $ret .=3D ",\n" if ($ret ne "");=0A= $ret .=3D "<A HREF=3D\"$fileurl"=0A= . toggleQuery('only_with_tag',$sym) . "\">$sym</A>";=0A= }=0A= return $ret."\n";=0A= }=0A= =0A= #=0A= # See if a module is listed in the config file's @HideModule list.=0A= #=0A= sub forbidden_module($) {=0A= my($module) =3D @_;=0A= return checkForbidden($module, @HideModules);=0A= }=0A= =0A= sub forbidden_file($) {=0A= my($file) =3D @_;=0A= $file =3D~ s|^.*/||;=0A= return checkForbidden($file, @DissallowRead);=0A= }=0A= =0A= sub checkForbidden($@) {=0A= my($item, @list) =3D @_;=0A= for (my $i=3D0; $i < @list; $i++) {=0A= return 1 if $item =3D~ $list[$i];=0A= }=0A= return 0;=0A= }=0A= =0A= # Close the GZIP handle remove the tie.=0A= =0A= sub gzipclose() {=0A= if ($gzip_open) {=0A= select(STDOUT);=0A= close(GZIP);=0A= untie *GZIP;=0A= $gzip_open =3D 0;=0A= }=0A= }=0A= =0A= # implement a gzipped file handle via the Compress:Zlib compression=0A= # library.=0A= =0A= sub MAGIC1() { 0x1f }=0A= sub MAGIC2() { 0x8b }=0A= sub OSCODE() { 3 }=0A= =0A= sub TIEHANDLE {=0A= my ($class, $out) =3D @_;=0A= my ($d) =3D Compress::Zlib::deflateInit(-Level =3D> = Compress::Zlib::Z_BEST_COMPRESSION(),=0A= -WindowBits =3D> -Compress::Zlib::MAX_WBITS()) or return undef;=0A= my ($o) =3D {=0A= handle =3D> $out,=0A= dh =3D> $d,=0A= crc =3D> 0,=0A= len =3D> 0,=0A= };=0A= my ($header) =3D pack("c10", MAGIC1, MAGIC2, = Compress::Zlib::Z_DEFLATED(), 0,0,0,0,0,0, OSCODE);=0A= print {$o->{handle}} $header;=0A= return bless($o, $class);=0A= }=0A= =0A= sub PRINT {=0A= my ($o) =3D shift;=0A= my ($buf) =3D join(defined $, ? $, : "",@_);=0A= my ($len) =3D length($buf);=0A= my ($compressed, $status) =3D $o->{dh}->deflate($buf);=0A= print {$o->{handle}} $compressed if defined($compressed);=0A= $o->{crc} =3D Compress::Zlib::crc32($buf, $o->{crc});=0A= $o->{len} +=3D $len;=0A= return $len;=0A= }=0A= =0A= sub PRINTF {=0A= my ($o) =3D shift;=0A= my ($fmt) =3D shift;=0A= my ($buf) =3D sprintf($fmt, @_);=0A= my ($len) =3D length($buf);=0A= my ($compressed, $status) =3D $o->{dh}->deflate($buf);=0A= print {$o->{handle}} $compressed if defined($compressed);=0A= $o->{crc} =3D Compress::Zlib::crc32($buf, $o->{crc});=0A= $o->{len} +=3D $len;=0A= return $len;=0A= }=0A= =0A= sub WRITE {=0A= my ($o, $buf, $len, $off) =3D @_;=0A= my ($compressed, $status) =3D $o->{dh}->deflate(substr($buf, 0, $len));=0A= print {$o->{handle}} $compressed if defined($compressed);=0A= $o->{crc} =3D Compress::Zlib::crc32(substr($buf, 0, $len), $o->{crc});=0A= $o->{len} +=3D $len;=0A= return $len;=0A= }=0A= =0A= sub CLOSE {=0A= my ($o) =3D @_;=0A= return if !defined( $o->{dh});=0A= my ($buf) =3D $o->{dh}->flush();=0A= $buf .=3D pack("V V", $o->{crc}, $o->{len});=0A= print {$o->{handle}} $buf;=0A= undef $o->{dh};=0A= }=0A= =0A= sub DESTROY {=0A= my ($o) =3D @_;=0A= CLOSE($o);=0A= }=0A= ------=_NextPart_000_0003_01C32123.A2DEFAC0 Content-Type: application/octet-stream; name="cvsweb.conf" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="cvsweb.conf" # -*-perl-*-=0A= # Configuration of cvsweb.cgi, the=0A= # CGI interface to CVS Repositories.=0A= #=0A= # (c) 1998-1999 H. Zeller <zeller@think.de>=0A= # 1999 H. Nordstr=F6m <hno@hem.passagen.se>=0A= # based on work by Bill Fenner <fenner@freebsd.org>=0A= # $Id: cvsweb.conf,v 1.29 2001/07/23 09:14:52 hzeller Exp $=0A= #=0A= ###=0A= =0A= ##############=0A= # CVS Root=0A= ##############=0A= # CVSweb can handle several CVS-Repositories=0A= # at once. Enter a short symbolic names and the=0A= # full path of these repositories here.=0A= # NOTE that the symbolic names may not contain=0A= # whitespaces.=0A= # Note, that cvsweb.cgi currently needs to have physical access=0A= # to the CVS repository so :pserver:someone@xyz.com:/data/cvsroot=0A= # won't work!=0A= =0A= # 'symbolic_name' 'path_to_the_actual_repository'=0A= %CVSROOT =3D (=0A= 'Configuracion' =3D> '/cvs/repositorio',=0A= 'Desarrollo' =3D> '/tmp/cvsroot/conf'=0A= # 'HTML-files' =3D> '/tmp/upload'=0A= );=0A= =0A= # This tree is enabled by default when=0A= # you enter the page=0A= # $cvstreedefault =3D 'Development';=0A= $cvstreedefault =3D 'Configuracion';=0A= =0A= ##############=0A= # Defaults for UserSettings=0A= ##############=0A= %DEFAULTVALUE =3D (=0A= # sortby: File sort order=0A= # file Sort by filename=0A= # rev Sort by revision number=0A= # date Sort by commit date=0A= # author Sort by author=0A= # log Sort by log message=0A= =0A= "sortby" =3D> "file",=0A= =0A= # hideattic: Hide or show files in Attic=0A= # 1 Hide files in Attic=0A= # 0 Show files in Attic=0A= =0A= "hideattic" =3D> "0",=0A= =0A= # logsort: Sort order for CVS logs=0A= # date Sort revisions by date=0A= # rev Sort revision by revision number=0A= # cvs Don't sort them. Same order as CVS/RCS shows them.=0A= =0A= "logsort" =3D> "date",=0A= =0A= # f: Default diff format=0A= # h Human readable=0A= # u Unified diff=0A= # c Context diff=0A= # s Side by side=0A= "f" =3D> "h", =0A= =0A= # hidecvsroot: Don't show the CVSROOT directory=0A= # 1 Hide CVSROOT directory=0A= # 0 Show CVSROOT directory=0A= "hidecvsroot" =3D> "0",=0A= =0A= # hidenonreadable: Don't show entries which cannot be read=0A= # 1 Hide non-readable entries=0A= # 0 Show non-readable entries=0A= "hidenonreadable" =3D> "1",=0A= );=0A= =0A= ##############=0A= # some layout stuff=0A= ##############=0A= =0A= # color settings in the body-tag=0A= $body_tag =3D '<body text=3D"#000000" bgcolor=3D"#ffffff">';=0A= =0A= # Wanna have a logo on the page ?=0A= $logo =3D '<img src=3D"/icons/apache_pb.gif">';=0A= =0A= # The title of the Page on startup=0A= $defaulttitle =3D "CVS Repository";=0A= =0A= # The address is shown on the footer=0A= $address =3D "<font size=3D-1>CVSweb by <zeller\@think.de></font>";=0A= =0A= # Default page background color for the diffs=0A= # and annotations=0A= $backcolor =3D "#eeeeee";=0A= =0A= # color of navigation Header for=0A= # diffs and annotations=0A= $navigationHeaderColor =3D '#9999ee';=0A= =0A= $long_intro =3D <<EOT;=0A= <p>=0A= This is a WWW interface for CVS Repositories.=0A= You can browse the file hierarchy by picking directories=0A= (which have slashes after them, <i>e.g.</i>, <b>src/</b>).=0A= If you pick a file, you will see the revision history=0A= for that file.=0A= Selecting a revision number will download that revision of=0A= the file. There is a link at each revision to display=0A= diffs between that revision and the previous one, and=0A= a form at the bottom of the page that allows you to=0A= display diffs between arbitrary revisions.=0A= </p>=0A= <p>=0A= This script has been written by Bill Fenner=0A= <<a href=3D"mailto:fenner\@freebsd.org">fenner\@freebsd.org</a>>=0A= and improved by Henner Zeller=0A= <<a href=3D"mailto:zeller\@think.de">zeller\@think.de</a>>,=0A= Henrik Nordström=0A= <<a = href=3D"mailto:hno\@hem.passagen.se">hno\@hem.passagen.se</a>>, and=0A= Ken Coar=0A= <<a href=3D"mailto:Ken.Coar\@Golux.Com">Ken.Coar\@Golux.Com</a>>;=0A= it is covered by the=0A= <a = href=3D"http://www.opensource.org/licenses/bsd-license.html">BSD-Licence<= /a>.=0A= </p>=0A= <p>=0A= If you would like to use this CGI script on your own web server and=0A= CVS tree, see Zeller's=0A= <a href=3D"http://linux.fh-heilbronn.de/~zeller/cgi/cvsweb.cgi"=0A= >CVSweb distribution site</a>. Bill's original script can be found=0A= <a href=3D"http://www.freebsd.org/~fenner/cvsweb/">here</a>.=0A= </p>=0A= <p>=0A= Please send any suggestions, comments, etc. to=0A= <a href=3D"mailto:fenner\@freebsd.org">Bill Fenner</a> or, regarding the=0A= modifications, to=0A= <a href=3D"mailto:zeller\@think.de">Henner Zeller</a>,=0A= <a href=3D"mailto:hno\@hem.passagen.se">Henrik Nordström</a>, or=0A= <a href=3D"mailto:Ken.Coar\@Golux.Com">Ken Coar</a>.=0A= </p>=0A= EOT=0A= =0A= $short_instruction =3D <<EOT;=0A= <p>=0A= Click on a directory to enter that directory. Click on a file to display=0A= its revision history and to get a chance to display diffs between = revisions. =0A= </p>=0A= EOT=0A= =0A= # used icons; if icon-url is empty, the text representation is used; if=0A= # you do not want to have an ugly tooltip for the icon, remove the=0A= # text-representation.=0A= # The width and height of the icon allow the browser to correcly display=0A= # the table while still loading the icons.=0A= # These default icons are coming with apache.=0A= # If these icons are too large, check out the miniicons in the=0A= # icons/ directory; they have a width/height of 16/16=0A= # format: TEXT ICON-URL width height=0A= %ICONS =3D (=0A= back =3D> [ ("[BACK]", "/icons/back.gif", 20, 22) ],=0A= dir =3D> [ ("[DIR]", "/icons/dir.gif", 20, 22) ],=0A= file =3D> [ ("[TXT]", "/icons/text.gif", 20, 22) ],=0A= );=0A= =0A= # the length to which the last logentry should=0A= # be truncated when shown in the directory view=0A= $shortLogLen =3D 80;=0A= =0A= # Show author of last change=0A= $show_author =3D 1;=0A= =0A= ##############=0A= # table view for directories=0A= ##############=0A= =0A= # Show directory as table=0A= # this is much more readable but has one=0A= # drawback: the whole table has to be loaded=0A= # before common browsers display it which may=0A= # be annoying if you have a slow link - and a=0A= # large directory ..=0A= $dirtable =3D 1;=0A= =0A= # show different colors for even/odd rows=0A= @tabcolors =3D ('#ccccee', '#ffffff');=0A= $tablepadding =3D 2;=0A= =0A= # Color of Header=0A= $columnHeaderColorDefault =3D '#cccccc';=0A= $columnHeaderColorSorted =3D '#88ff88';=0A= =0A= # =0A= # If you want to have colored borders =0A= # around each row, uncomment this=0A= # $tableBorderColor =3D '#999999';=0A= =0A= #=0A= # Modules in the repository that should not be displayed, either by = default=0A= # nor by explicit path specification. Usually, you don't want to display=0A= # CVSROOT.=0A= #=0A= @HideModules =3D ( =0A= "CVSROOT",=0A= );=0A= =0A= #=0A= # Files matching this name shouldn't be checked out with cvsweb, since=0A= # they may contain sensitive information. Simple file name based=0A= # filter. Often, the CVSROOT/passwd is exposed and some people tend=0A= # to check in their .cvspass, though this is a bad idea. These files = shouldn't=0A= # be readable by default. Thanks to Damian Gryski to point this out.=0A= @DissallowRead =3D ( "\^.cvspass\$", "^passwd\$");=0A= =0A= #=0A= # Use CVSROOT/CVSROOT/descriptions for describing the directories/modules=0A= # See INSTALL section 8=0A= #=0A= $use_descriptions =3D 0;=0A= =0A= ##############=0A= # Human Readable Diff=0A= ##############=0A= =0A= # (c) 1998 H. Zeller <zeller@think.de>=0A= #=0A= # Generates two columns of color encoded=0A= # diff; much like xdiff or emacs-ediff mode.=0A= #=0A= # The diff-stuff is a piece of code I once made for=0A= # cvs2html which is under GPL,=0A= # see http://www.sslug.dk/cvs2html=0A= # (c) 1997/98 Peter Toft <pto@sslug.imm.dtu.dk>=0A= #=0A= # some parameters to screw:=0A= ##=0A= =0A= # make lines breakable so that the columns do not=0A= # exceed the width of the browser=0A= $hr_breakable =3D 1;=0A= =0A= # give out function names in human readable diffs=0A= # this just makes sense if we have C-files, otherwise=0A= # diff's heuristic doesn't work well ..=0A= # ( '-p' option to diff)=0A= $hr_funout =3D 0;=0A= =0A= # ignore whitespaces for human readable diffs=0A= # (indendation and stuff ..)=0A= # ( '-w' option to diff)=0A= $hr_ignwhite =3D 1;=0A= =0A= # ignore diffs which are caused by=0A= # keyword-substitution like $Id - Stuff=0A= # ( '-kk' option to rcsdiff)=0A= $hr_ignkeysubst =3D 1;=0A= =0A= # Colors and font to show the diff type of code changes=0A= $diffcolorHeading =3D '#99cccc'; # color of 'Line'-head of each = diffed file=0A= $diffcolorEmpty =3D '#cccccc'; # color of 'empty' lines=0A= $diffcolorRemove =3D '#ff9999'; # Removed line(s) (left) ( - )=0A= $diffcolorChange =3D '#99ff99'; # Changed line(s) ( both )=0A= $diffcolorAdd =3D '#ccccff'; # Added line(s) ( - ) (right)=0A= $diffcolorDarkChange =3D '#99cc99'; # lines, which are empty in change=0A= $difffontface =3D "Helvetica,Arial";=0A= $difffontsize =3D "-1";=0A= =0A= # the width of the textinput of the=0A= # request-diff-form=0A= $inputTextSize =3D 12;=0A= =0A= ##############=0A= # Mime Types=0A= ##############=0A= =0A= # mapping to mimetypes to help=0A= # cvsweb to guess the correct mime-type on=0A= # checkout; you can use the mime.types from=0A= # apache here:=0A= $mime_types =3D '/usr/local/web/apache/conf/mime.types';=0A= =0A= # quick mime-type lookup; maps file-suffices to=0A= # mime-types for displaying checkouts in the browser.=0A= # Further MimeTypes will be found in the =0A= # file $mime_types (apache style mime.types - file)=0A= # - add common mappings here for faster lookup=0A= %MTYPES =3D (=0A= "html" =3D> "text/html",=0A= "shtml" =3D> "text/html",=0A= "gif" =3D> "image/gif",=0A= "jpeg" =3D> "image/jpeg",=0A= "jpg" =3D> "image/jpeg", =0A= "*" =3D> "text/plain",=0A= );=0A= =0A= ##############=0A= # Misc=0A= ##############=0A= # allow annotation of files=0A= # this requires rw-access to the=0A= # CVSROOT/history - file and rw-access=0A= # to the subdirectory to place the lock=0A= # so you maybe don't want it=0A= $allow_annotate =3D 1;=0A= =0A= # allow pretty-printed version of files=0A= $allow_markup =3D 1;=0A= =0A= # allow compression with gzip=0A= # of output if the Browser accepts=0A= # it (HTTP_ACCEPT_ENCODING=3Dgzip)=0A= # [make sure to have gzip in the path]=0A= $allow_compress =3D 1;=0A= =0A= # Make use of javascript functions.=0A= # This way you can select one of your CVSroot=0A= # without pressing 'Go' (.. if you do have more=0A= # than one CVSROOT defined)=0A= $use_java_script =3D 1;=0A= =0A= # open Download-Links in another window=0A= $open_extern_window =3D 1;=0A= =0A= # The size of this extern window; this size option=0A= # needs use_java_script to be defined=0A= # just comment them if you don't want to have a fixed=0A= # size=0A= #$extern_window_width =3D 600;=0A= #$extern_window_height =3D 440;=0A= =0A= # Edit Options=0A= # Enable form to edit your options (hideattic,sortbydate)=0A= # this isn't necessary if you've $dirtable defined 'cause=0A= # this allows editing of all your options more intuitive=0A= $edit_option_form =3D (not $dirtable);=0A= =0A= # remember to set the path to your=0A= # rcsutils: rlog, rcsdiff (gzip if you use compression)=0A= #$ENV{'PATH'} =3D '/usr/local/bin';=0A= =0A= # If you have files which automatically refers to other files=0A= # (such as HTML) then this allows you to browse the checked=0A= # out files as if outside CVS.=0A= $checkout_magic =3D 1;=0A= =0A= # Show last changelog message for sub directories=0A= # The current implementation makes many assumptions and may show the=0A= # incorrect file at some times. The main assumption is that the last=0A= # modified file has the newest filedate. But some CVS operations=0A= # touches the file without even when a new version is't checked in,=0A= # and TAG based browsing essientially puts this out of order, unless=0A= # the last checkin was on the same tag as you are viewing.=0A= # Enable this if you like the feature, but don't rely on correct results.=0A= $show_subdir_lastmod =3D 0;=0A= =0A= # Background color of logentry in markup=0A= $markupLogColor =3D "#ffffff";=0A= =0A= # Show CVS log when viewing file contents=0A= $show_log_in_markup =3D 1;=0A= =0A= # Tabstop used to expand tabs in colored diffs. If undefined then=0A= # tabs are always expanded to 8 spaces.=0A= $tabstop =3D 8;=0A= =0A= # if you wish to display absolute times in your local timezone,=0A= # then define mytz and fill in the strings for your standard and=0A= # daylight time. Note that you must also make sure the system=0A= # timezone is correctly set.=0A= # @mytz=3D("EST", "EDT");=0A= =0A= # cvsweb is friendly to caches by indicating a suitable=0A= # last-modified timestamp. Doing this uses slightly more=0A= # CPU so you might want to disable it if you have a slow=0A= # server=0A= $use_moddate =3D 1;=0A= =0A= #EOF=0A= ------=_NextPart_000_0003_01C32123.A2DEFAC0--
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?000201c3214d$8b9c98c0$42a09384>