From owner-freebsd-questions@FreeBSD.ORG Fri May 23 14:51:47 2003 Return-Path: Delivered-To: freebsd-questions@freebsd.org Received: from mx1.FreeBSD.org (mx1.freebsd.org [216.136.204.125]) by hub.freebsd.org (Postfix) with ESMTP id 40CA437B401 for ; Fri, 23 May 2003 14:51:47 -0700 (PDT) Received: from apk01fe4.mail1.triara.com (apk01fe4.mail1.triara.com [200.57.129.20]) by mx1.FreeBSD.org (Postfix) with ESMTP id 75B3643F85 for ; Fri, 23 May 2003 14:51:43 -0700 (PDT) (envelope-from jgonzalezr@ultrasist.com.mx) Received: from satellite ([200.95.40.167]) by apk01fe4.mail1.triara.com with ESMTP id <20030523215133.UVII10317.apk01fe4@satellite> for ; Fri, 23 May 2003 16:51:33 -0500 From: "Jesus Gonzalez Rubio" To: Date: Fri, 23 May 2003 16:54:32 -0500 Message-ID: <001301c32175$e64b7160$42a09384@satellite> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_NextPart_000_0014_01C3214B.FD756960" X-Priority: 3 (Normal) X-MSMail-Priority: Normal X-Mailer: Microsoft Outlook CWS, Build 9.0.2416 (9.0.2910.0) X-MIMEOLE: Produced By Microsoft MimeOLE V6.00.2600.0000 Importance: Normal Subject: FW: cvsweb X-BeenThere: freebsd-questions@freebsd.org X-Mailman-Version: 2.1.1 Precedence: list List-Id: User questions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 23 May 2003 21:51:47 -0000 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 =0A= # 1999 H. Nordstr=F6m =0A= # based on work by Bill Fenner =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 '';=0A= =0A= # Wanna have a logo on the page ?=0A= $logo =3D '';=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 "CVSweb by <zeller\@think.de>";=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 <=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, e.g., src/).=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=

=0A=

=0A= This script has been written by Bill Fenner=0A= <fenner\@freebsd.org>=0A= and improved by Henner Zeller=0A= <zeller\@think.de>,=0A= Henrik Nordström=0A= <hno\@hem.passagen.se>, and=0A= Ken Coar=0A= <Ken.Coar\@Golux.Com>;=0A= it is covered by the=0A= BSD-Licence<= /a>.=0A=

=0A=

=0A= If you would like to use this CGI script on your own web server and=0A= CVS tree, see Zeller's=0A= CVSweb distribution site. Bill's original script can be found=0A= here.=0A=

=0A=

=0A= Please send any suggestions, comments, etc. to=0A= Bill Fenner or, regarding the=0A= modifications, to=0A= Henner Zeller,=0A= Henrik Nordström, or=0A= Ken Coar.=0A=

=0A= EOT=0A= =0A= $short_instruction =3D <=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=

=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 =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 =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 (original work)=0A= # extended by Henner Zeller ,=0A= # Henrik Nordstr=F6m =0A= # Ken Coar =0A= # Dick Balaska =0A= # Jens-Uwe Mager =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 $config '=0A= . 'in cvsweb.cgi, or the environment variable '=0A= . 'CVSWEB_CONFIG, to your cvsweb.conf '=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= "\$cvstreedefault points to a repository = ($cvstreedefault)"=0A= . "not defined in %CVSROOT "=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 "3D\"$itxt\"";=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!

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 () {=0A= chomp;=0A= my ($dir,$description) =3D /(\S+)\s+(.*)/;=0A= $descriptions{$dir} =3D $description;=0A= }=0A= }=0A= =0A= print "

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

Current directory: ", &clickablePath($where,0), = "\n";=0A= =0A= print "

Current tag: ", $input{only_with_tag}, "\n" if=0A= $input{only_with_tag};=0A= =0A= }=0A= =0A= =0A= print "

\n";=0A= # Using 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 "
";=0A= }=0A= print "\n";=0A= $infocols++;=0A= print "";=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 "";=0A= $infocols++;=0A= print "";=0A= if ($show_author) {=0A= $infocols++;=0A= print "";=0A= }=0A= $infocols++;=0A= print "";=0A= }=0A= elsif ($use_descriptions) {=0A= print "\n";=0A= }=0A= else {=0A= print "\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 "[Hide]" 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 "\n";=0A= }=0A= else {=0A= print "
\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 "" if ($dirtable);=0A= print (($dirtable) ? "" : "
");=0A= $dirrow++;=0A= }=0A= print "\n";=0A= }=0A= if ($dirtable && defined($tableBorderColor)) {=0A= print "
";=0A= print "" if (!$byfile);=0A= print "File";=0A= print "" if (!$byfile);=0A= print "";=0A= print "" if (!$byrev);=0A= print "Rev.";=0A= print "" if (!$byrev);=0A= print "";=0A= print "" if (!$bydate);=0A= print "Age";=0A= print "" if (!$bydate);=0A= print "";=0A= print "" if (!$byauthor);=0A= print "Author";=0A= print "" if (!$byauthor);=0A= print "";=0A= print "" if = (!$bylog);=0A= print "Last log entry";=0A= print "" if (!$bylog);=0A= print "";=0A= print "Description";=0A= $infocols++;=0A= }=0A= print "
" 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 "";=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 "  [Don't hide]";=0A= }=0A= } =0A= # Show last change in dir=0A= if ($filename) {=0A= print "  " if ($dirtable);=0A= if ($date) {=0A= print " " . readableTime(time() - $date,0) . "";=0A= }=0A= if ($show_author) {=0A= print " " if ($dirtable);=0A= print $author;=0A= }=0A= print " " if ($dirtable);=0A= $filename =3D~ s%^[^/]+/%%;=0A= print "$filename/$rev";=0A= print "
" if ($dirtable);=0A= if ($log) {=0A= print " "=0A= . &htmlify(substr($log,0,$shortLogLen));=0A= if (length $log > 80) {=0A= print "...";=0A= }=0A= print "";=0A= }=0A= }=0A= else {=0A= my ($dwhere) =3D ($where ne "/" ? $where : "") . $_;=0A= if ($use_descriptions && defined $descriptions{$dwhere}) {=0A= print "		 " 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 " ";=0A= $cols--;=0A= }=0A= }=0A= }=0A= if ($dirtable) {=0A= print "
" if = ($dirtable);=0A= print "";=0A= if ($nofilelinks) {=0A= print $fileicon;=0A= }=0A= else {=0A= print &link($fileicon,$url);=0A= }=0A= print " ", &link($_, $url), $attic;=0A= print " " if ($dirtable);=0A= download_link($fileurl,=0A= $rev, $rev, =0A= $defaultViewable ? "text/x-cvsweb-markup" : undef);=0A= print " " if ($dirtable);=0A= if ($date) {=0A= print " " . readableTime(time() - $date,0) . "";=0A= }=0A= if ($show_author) {=0A= print " " if ($dirtable);=0A= print $author;=0A= }=0A= print " " if ($dirtable);=0A= if ($log) {=0A= print " " . &htmlify(substr($log,0,$shortLogLen));=0A= if (length $log > 80) {=0A= print "...";=0A= }=0A= print "";=0A= }=0A= print "
";=0A= }=0A= print "". ($dirtable =3D=3D 1) ? "
" : "" . "\n";=0A= =0A= if ($filesexists && !$filesfound) {=0A= print "

NOTE: 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 "

";=0A= }=0A= =0A= if (scalar %tags || $input{only_with_tag}) {=0A= print "
\n";=0A= foreach my $var (@stickyvars) {=0A= print "\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 "\n";=0A= print "\n";=0A= print "
\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 "
\n";=0A= print "\n";=0A= if ($cvstree ne $cvstreedefault) {=0A= print "\n";=0A= }=0A= print "
";=0A= print "";=0A= print "";=0A= print "";=0A= print "";=0A= print "\n";=0A= print "
Preferences
Sort files by revisions by: \n";=0A= print "
Diff format: ";=0A= printDiffSelect(0);=0A= print "Show Attic files: ";=0A= print "
";=0A= print "
\n";=0A= }=0A= print &html_footer;=0A= print "\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 "";=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= =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$1$2$3=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$1=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 and (=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; # =0A= $string =3D~ s/ / =A7nbsp;/g; # 2 * = =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 "$name\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 here.\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 "

Annotation of $pathname$filename, Revision = $rev

\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 "\n";=0A= }=0A= else {=0A= print "
";=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 "" if ($isCurrentRev);=0A=
	    printf ("%8s%s%8s %4d:", $revprint, ($isCurrentRev ? "|" : " "), =
$usrprint, $lineNr);=0A=
	    print spacedHtmlText($line);=0A=
	    print "" 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: =
$_");=0A=
	}=0A=
    }=0A=
    if ($annTable) {=0A=
	print "
";=0A= }=0A= else {=0A= print "";=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= . "

Check whether the directory $cvsroot/CVSROOT exists "=0A= . "and the script has write-access to the CVSROOT/history "=0A= . "file if it exists."=0A= . "
The script needs to place lock files in the "=0A= . "directory the file is in as well.");=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 "

";=0A= print "
";=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 "
\n";=0A= if ($show_log_in_markup) {=0A= readLog($fullname); #,$revision);=0A= printLog($revision,0);=0A= }=0A= else {=0A= print "Version: $revision
\n";=0A= print "Tag: ", $input{only_with_tag}, "
\n" if=0A= $input{only_with_tag};=0A= }=0A= print "
";=0A= my @content =3D <$filehandle>;=0A= my $url =3D download_url($fileurl, $revision, $mimetype);=0A= print "
";=0A= if ($mimetype =3D~ /^image/) {=0A= print "
";=0A= }=0A= elsif ($mimetype =3D~ m%^application/pdf%) {=0A= print "
";=0A= }=0A= else {=0A= print "
";=0A=
	foreach (@content) {=0A=
	    print spacedHtmlText($_);=0A=
	}=0A=
	print "
";=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 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 '".join(", ", = @files)."'

did you set the \$ENV{PATH} 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 "

\n";=0A=
	print &htmlify($log{$_});=0A=
	print "
\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= " Up to ", &clickablePath($upwhere, 1), "

\n";=0A= print "Request diff between arbitrary = revisions\n";=0A= print "

\n";=0A= if ($curbranch) {=0A= print "Default branch: ";=0A= print ($revsym{$curbranch} || $curbranch);=0A= }=0A= else {=0A= print "No default branch";=0A= }=0A= print "
\n";=0A= if ($input{only_with_tag}) {=0A= print "Current tag: $input{only_with_tag}
\n";=0A= }=0A= =0A= undef %nameprinted;=0A= =0A= for (my $i =3D 0; $i <=3D $#revdisplayorder; $i++) {=0A= print "
";=0A= printLog($revdisplayorder[$i]);=0A= }=0A= =0A= print "
";=0A= print "\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 "

\n";=0A= print "

\n";=0A= foreach (@stickyvars) {=0A= print "\n"=0A= if (defined($input{$_})=0A= && ((!defined($DEFAULTVALUE{$_})=0A= || $input{$_} ne $DEFAULTVALUE{$_})=0A= && $input{$_} ne ""));=0A= }=0A= print "Diffs between \n";=0A= print "\n";=0A= $diffrev =3D $revdisplayorder[$#revdisplayorder];=0A= $diffrev =3D $input{"r1"} if (defined($input{"r1"}));=0A= print "\n";=0A= print " and \n";=0A= print "\n";=0A= $diffrev =3D $revdisplayorder[0];=0A= $diffrev =3D $input{"r2"} if (defined($input{"r2"}));=0A= print "\n";=0A= print "
Type of Diff should be a ";=0A= printDiffSelect(0);=0A= print "\n";=0A= print "
\n";=0A= print "
\n";=0A= if (@branchnames) {=0A= print "\n";=0A= print "
\n";=0A= foreach (@stickyvars) {=0A= next if ($_ eq "only_with_tag");=0A= next if ($_ eq "logsort");=0A= print "\n"=0A= if (defined($input{$_})=0A= && (!defined($DEFAULTVALUE{$_})=0A= || $input{$_} ne $DEFAULTVALUE{$_})=0A= && $input{$_} ne "");=0A= }=0A= print "View only Branch: \n";=0A= print "\n";=0A= print "\n";=0A= print "
\n";=0A= }=0A= print "\n";=0A= print "
\n";=0A= foreach (@stickyvars) {=0A= next if ($_ eq "only_with_tag");=0A= next if ($_ eq "logsort");=0A= print "\n"=0A= if (defined($input{$_})=0A= && (!defined($DEFAULTVALUE{$_})=0A= || $input{$_} ne $DEFAULTVALUE{$_})=0A= && $input{$_} ne "");=0A= }=0A= print "Sort log by: \n";=0A= print "\n";=0A= print "
\n";=0A= print &html_footer;=0A= print "\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 "@$leftColRef[$j]";=0A= print " \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 "";=0A= if ($j < $leftRow) {=0A= print "@$leftColRef[$j]";=0A= }=0A= else {=0A= print " ";=0A= }=0A= if ($j < $rightRow) {=0A= print "@$rightColRef[$j]";=0A= }=0A= else {=0A= print " ";=0A= }=0A= print "\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 "

Diff for /$where_nd between version $rev1 = and $rev2

\n";=0A= =0A= print "\n";=0A= print "\n";=0A= print "\n";=0A= print "\n";=0A= =0A= my $fs =3D "";=0A= my $fe =3D "";=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 "\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 "\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 "\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 "";=0A= print "";=0A= print "";=0A= }=0A= print "
";=0A= print "version $rev1";=0A= print ", $date1" if (defined($date1));=0A= print "
Tag: $sym1\n" if ($sym1);=0A= print "		";=0A= print "version $rev2";=0A= print ", $date2" if (defined($date2));=0A= print "
Tag: $sym2\n" if ($sym1);=0A= print "
";=0A= print "
Line $oldline";=0A= print " $funname
";=0A= print "		";=0A= print "
Line $newline";=0A= print " $funname
";=0A= print "
 $_
$_$_
 
- No viewable Change = -
";=0A= close($fh);=0A= =0A= print "
\n";=0A= =0A= print "";=0A= =0A= print "";=0A= =0A= print "
";=0A= # print legend=0A= print "
";=0A= print "Legend:
\n";=0A= print "";=0A= print "";=0A= print "";=0A= print "
Removed = from v.$rev1 
changed lines
 Added in v.$rev2
\n";=0A= =0A= print "		";=0A= # Print format selector=0A= print "
\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 "\n";=0A= }=0A= printDiffSelect($use_java_script);=0A= print "\n";=0A= print "
\n";=0A= print "
";=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 "\n\n";=0A= print '';=0A= print "\n$path$filename - $title - $rev\n";=0A= print "\n";=0A= print "";=0A= print "";=0A= =0A= print "";=0A= print "
";=0A= print "$backicon";=0A= print " Return to ", = &link("$filename","$swhere$query#rev$rev")," CVS log";=0A= print " $fileicon$diricon Up to ", &clickablePath($path, = 1), "
";=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 =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 . " [$cvstree]";=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 . "$_";=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 "
\n";=0A= foreach $k (keys %input) {=0A= print "\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 "";=0A= print "";=0A= print "";=0A= print "";=0A= print "
CVS Root:\n\n
";=0A= }=0A= else {=0A= # no choice ..=0A= print "CVS Root: [$cvstree]";=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($mirror\n);=0A= $moremirrors =3D 1;=0A= }=0A= print "

\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 "$textlink";=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 "" 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 "Unable to find gzip binary in the \$PATH to = compress output
";=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 <=0A= =0A= $title=0A= =0A= =0A= $body_tag=0A= $logo

$title

=0A= EOH=0A= }=0A= =0A= sub html_footer() {=0A= return "
$address
\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 "$sym";=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--