Date: Fri, 23 May 2003 16:54:32 -0500 From: "Jesus Gonzalez Rubio" <jgonzalezr@ultrasist.com.mx> To: <freebsd-questions@FreeBSD.ORG> Subject: FW: cvsweb Message-ID: <001301c32175$e64b7160$42a09384@satellite>
next in thread | raw e-mail | index | archive | help
This is a multi-part message in MIME format.
------=_NextPart_000_0014_01C3214B.FD756960
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.#! /usr/bin/perl -wsT
instruction has beeing removed from cgi file.
I'm working under Red-Hat 8.0.
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
---
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_0014_01C3214B.FD756960
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_0014_01C3214B.FD756960
Content-Type: application/octet-stream;
name="cvsweb.cgi"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="cvsweb.cgi"
#=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_0014_01C3214B.FD756960--
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?001301c32175$e64b7160$42a09384>